Small refactoring to `org-cycle'

* lisp/org.el (org-cycle): Integrate new folding functions for
drawers.  Small refactoring, in particular to minimize the number of
calls to `org-element-at-point'.
This commit is contained in:
Nicolas Goaziou 2020-04-18 12:36:08 +02:00
parent 692f191f84
commit 43956c693b
1 changed files with 75 additions and 88 deletions

View File

@ -6137,11 +6137,11 @@ When point is not at the beginning of a headline, execute the global
binding for `TAB', which is re-indenting the line. See the option binding for `TAB', which is re-indenting the line. See the option
`org-cycle-emulate-tab' for details. `org-cycle-emulate-tab' for details.
As a special case, if point is at the beginning of the buffer and there is As a special case, if point is at the very beginning of the buffer, if
no headline in line 1, this function will act as if called with prefix arg there is no headline there, and if the variable `org-cycle-global-at-bob'
\(`\\[universal-argument] TAB', same as `S-TAB') also when called without \ is non-nil, this function acts as if called with prefix argument \
prefix arg, but only \(`\\[universal-argument] TAB',
if the variable `org-cycle-global-at-bob' is t." same as `S-TAB') also when called without prefix argument."
(interactive "P") (interactive "P")
(org-load-modules-maybe) (org-load-modules-maybe)
(unless (or (run-hook-with-args-until-success 'org-tab-first-hook) (unless (or (run-hook-with-args-until-success 'org-tab-first-hook)
@ -6153,63 +6153,22 @@ if the variable `org-cycle-global-at-bob' is t."
(and (boundp 'org-inlinetask-min-level) (and (boundp 'org-inlinetask-min-level)
org-inlinetask-min-level org-inlinetask-min-level
(1- org-inlinetask-min-level)))) (1- org-inlinetask-min-level))))
(nstars (and limit-level (nstars
(if org-odd-levels-only (and limit-level
(and limit-level (1- (* limit-level 2))) (if org-odd-levels-only
limit-level))) (1- (* 2 limit-level))
limit-level)))
(org-outline-regexp (org-outline-regexp
(if (not (derived-mode-p 'org-mode)) (format "\\*%s " (if nstars (format "\\{1,%d\\}" nstars) "+"))))
outline-regexp
(concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))))
(bob-special (and org-cycle-global-at-bob (not arg) (bobp)
(not (looking-at org-outline-regexp))))
(org-cycle-hook
(if bob-special
(delq 'org-optimize-window-after-visibility-change
(copy-sequence org-cycle-hook))
org-cycle-hook))
(pos (point)))
(cond (cond
((equal arg '(16)) ((equal arg '(16))
(setq last-command 'dummy) (setq last-command 'dummy)
(org-set-startup-visibility) (org-set-startup-visibility)
(org-unlogged-message "Startup visibility, plus VISIBILITY properties")) (org-unlogged-message "Startup visibility, plus VISIBILITY properties"))
((equal arg '(64)) ((equal arg '(64))
(org-show-all) (org-show-all)
(org-unlogged-message "Entire buffer visible, including drawers")) (org-unlogged-message "Entire buffer visible, including drawers"))
((equal arg '(4)) (org-cycle-internal-global)) ((equal arg '(4)) (org-cycle-internal-global))
;; Try hiding block at point.
((org-hide-block-toggle-maybe))
;; Try cdlatex TAB completion
((org-try-cdlatex-tab))
;; Table: enter it or move to the next field.
((org-at-table-p 'any)
(if (org-at-table.el-p)
(message "%s" (substitute-command-keys "\\<org-mode-map>\
Use `\\[org-edit-special]' to edit table.el tables"))
(if arg (org-table-edit-field t)
(org-table-justify-field-maybe)
(call-interactively 'org-table-next-field))))
((run-hook-with-args-until-success 'org-tab-after-check-for-table-hook))
;; Global cycling: delegate to `org-cycle-internal-global'.
(bob-special (org-cycle-internal-global))
;; Drawers: delegate to `org-flag-drawer'.
((save-excursion
(beginning-of-line 1)
(looking-at org-drawer-regexp))
(org-flag-drawer ; toggle block visibility
(not (get-char-property (match-end 0) 'invisible))))
;; Show-subtree, ARG levels up from here. ;; Show-subtree, ARG levels up from here.
((integerp arg) ((integerp arg)
(save-excursion (save-excursion
@ -6217,47 +6176,75 @@ Use `\\[org-edit-special]' to edit table.el tables"))
(outline-up-heading (if (< arg 0) (- arg) (outline-up-heading (if (< arg 0) (- arg)
(- (funcall outline-level) arg))) (- (funcall outline-level) arg)))
(org-show-subtree))) (org-show-subtree)))
;; Global cycling at BOB: delegate to `org-cycle-internal-global'.
((and org-cycle-global-at-bob
(bobp)
(not (looking-at org-outline-regexp)))
(let ((org-cycle-hook
(remq 'org-optimize-window-after-visibility-change
org-cycle-hook)))
(org-cycle-internal-global)))
;; Try CDLaTeX TAB completion.
((org-try-cdlatex-tab))
;; Inline task: delegate to `org-inlinetask-toggle-visibility'. ;; Inline task: delegate to `org-inlinetask-toggle-visibility'.
((and (featurep 'org-inlinetask) ((and (featurep 'org-inlinetask)
(org-inlinetask-at-task-p) (org-inlinetask-at-task-p)
(or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
(org-inlinetask-toggle-visibility)) (org-inlinetask-toggle-visibility))
(t
;; At an item/headline: delegate to `org-cycle-internal-local'. (let ((pos (point))
((and (or (and org-cycle-include-plain-lists (org-at-item-p)) (element (org-element-at-point)))
(save-excursion (move-beginning-of-line 1) (cond
(looking-at org-outline-regexp))) ;; Try toggling visibility for block at point.
(or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) ((org-hide-block-toggle nil t element))
(org-cycle-internal-local)) ;; Try toggling visibility for block at point.
((org-hide-drawer-toggle nil t element))
;; From there: TAB emulation and template completion. ;; Table: enter it or move to the next field.
(buffer-read-only (org-back-to-heading)) ((and (org-match-line "[ \t]*[|+]")
(org-element-lineage element '(table) t))
((run-hook-with-args-until-success (if (and (eq 'table (org-element-type element))
'org-tab-after-check-for-cycling-hook)) (eq 'table.el (org-element-property :type element)))
(message (substitute-command-keys "\\<org-mode-map>\
((run-hook-with-args-until-success Use `\\[org-edit-special]' to edit table.el tables"))
'org-tab-before-tab-emulation-hook)) (org-table-justify-field-maybe)
(call-interactively #'org-table-next-field)))
((and (eq org-cycle-emulate-tab 'exc-hl-bol) ((run-hook-with-args-until-success
(or (not (bolp)) 'org-tab-after-check-for-table-hook))
(not (looking-at org-outline-regexp)))) ;; At an item/headline: delegate to `org-cycle-internal-local'.
(call-interactively (global-key-binding "\t"))) ((and (or (and org-cycle-include-plain-lists
(let ((item (org-element-lineage element
((if (and (memq org-cycle-emulate-tab '(white whitestart)) '(item plain-list)
(save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) t)))
(or (and (eq org-cycle-emulate-tab 'white) (and item
(= (match-end 0) (point-at-eol))) (= (line-beginning-position)
(and (eq org-cycle-emulate-tab 'whitestart) (org-element-property :post-affiliated
(>= (match-end 0) pos)))) item)))))
t (save-excursion (move-beginning-of-line 1)
(eq org-cycle-emulate-tab t)) (looking-at org-outline-regexp)))
(call-interactively (global-key-binding "\t"))) (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
(org-cycle-internal-local))
(t (save-excursion ;; From there: TAB emulation and template completion.
(org-back-to-heading) (buffer-read-only (org-back-to-heading))
(org-cycle))))))) ((run-hook-with-args-until-success
'org-tab-after-check-for-cycling-hook))
((run-hook-with-args-until-success
'org-tab-before-tab-emulation-hook))
((and (eq org-cycle-emulate-tab 'exc-hl-bol)
(or (not (bolp))
(not (looking-at org-outline-regexp))))
(call-interactively (global-key-binding (kbd "TAB"))))
((or (eq org-cycle-emulate-tab t)
(and (memq org-cycle-emulate-tab '(white whitestart))
(save-excursion (beginning-of-line 1) (looking-at "[ \t]*"))
(or (and (eq org-cycle-emulate-tab 'white)
(= (match-end 0) (point-at-eol)))
(and (eq org-cycle-emulate-tab 'whitestart)
(>= (match-end 0) pos)))))
(call-interactively (global-key-binding (kbd "TAB"))))
(t
(save-excursion
(org-back-to-heading)
(org-cycle))))))))))
(defun org-cycle-internal-global () (defun org-cycle-internal-global ()
"Do the global cycling action." "Do the global cycling action."