org-cycle.el (34846B)
1 ;;; org-cycle.el --- Visibility cycling of Org entries -*- lexical-binding: t; -*- 2 ;; 3 ;; Copyright (C) 2020-2024 Free Software Foundation, Inc. 4 ;; 5 ;; Maintainer: Ihor Radchenko <yantar92 at posteo dot net> 6 ;; Keywords: folding, visibility cycling, invisible text 7 ;; URL: https://orgmode.org 8 ;; 9 ;; This file is part of GNU Emacs. 10 ;; 11 ;; GNU Emacs is free software: you can redistribute it and/or modify 12 ;; it under the terms of the GNU General Public License as published by 13 ;; the Free Software Foundation, either version 3 of the License, or 14 ;; (at your option) any later version. 15 16 ;; GNU Emacs is distributed in the hope that it will be useful, 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; GNU General Public License for more details. 20 21 ;; You should have received a copy of the GNU General Public License 22 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 24 ;; 25 ;;; Commentary: 26 27 ;; This file contains code controlling global folding state in buffer 28 ;; and TAB-cycling. 29 30 ;;; Code: 31 32 (require 'org-macs) 33 (org-assert-version) 34 35 (require 'org-macs) 36 (require 'org-fold) 37 38 (declare-function org-element-type-p "org-element-ast" (node types)) 39 (declare-function org-element-property "org-element-ast" (property node)) 40 (declare-function org-element-post-affiliated "org-element" (node)) 41 (declare-function org-element-lineage "org-element-ast" (datum &optional types with-self)) 42 (declare-function org-element-at-point "org-element" (&optional pom cached-only)) 43 (declare-function org-display-inline-images "org" (&optional include-linked refresh beg end)) 44 (declare-function org-get-tags "org" (&optional pos local fontify)) 45 (declare-function org-subtree-end-visible-p "org" ()) 46 (declare-function org-narrow-to-subtree "org" (&optional element)) 47 (declare-function org-next-visible-heading "org" (arg)) 48 (declare-function org-at-property-p "org" ()) 49 (declare-function org-re-property "org" (property &optional literal allow-null value)) 50 (declare-function org-remove-inline-images "org" (&optional beg end)) 51 (declare-function org-item-beginning-re "org" ()) 52 (declare-function org-at-heading-p "org" (&optional invisible-not-ok)) 53 (declare-function org-at-item-p "org" ()) 54 (declare-function org-before-first-heading-p "org" ()) 55 (declare-function org-back-to-heading "org" (&optional invisible-ok)) 56 (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) 57 (declare-function org-entry-end-position "org" ()) 58 (declare-function org-try-cdlatex-tab "org" ()) 59 (declare-function org-cycle-level "org" ()) 60 (declare-function org-table-next-field "org-table" ()) 61 (declare-function org-table-justify-field-maybe "org-table" (&optional new)) 62 (declare-function org-inlinetask-at-task-p "org-inlinetask" ()) 63 (declare-function org-inlinetask-toggle-visibility "org-inlinetask" ()) 64 (declare-function org-list-get-all-items "org-list" (item struct prevs)) 65 (declare-function org-list-get-bottom-point "org-list" (struct)) 66 (declare-function org-list-prevs-alist "org-list" (struct)) 67 (declare-function org-list-set-item-visibility "org-list" (item struct view)) 68 (declare-function org-list-search-forward "org-list" (regexp &optional bound noerror)) 69 (declare-function org-list-has-child-p "org-list" (item struct)) 70 (declare-function org-list-get-item-end-before-blank "org-list" (item struct)) 71 (declare-function org-list-struct "org-list" ()) 72 (declare-function org-cycle-item-indentation "org-list" ()) 73 74 (declare-function outline-previous-heading "outline" ()) 75 (declare-function outline-next-heading "outline" ()) 76 (declare-function outline-end-of-heading "outline" ()) 77 (declare-function outline-up-heading "outline" (arg &optional invisible-ok)) 78 79 (defvar org-drawer-regexp) 80 (defvar org-odd-levels-only) 81 (defvar org-startup-folded) 82 (defvar org-archive-tag) 83 (defvar org-cycle-include-plain-lists) 84 (defvar org-outline-regexp-bol) 85 86 (defvar-local org-cycle-global-status nil) 87 (put 'org-cycle-global-status 'org-state t) 88 (defvar-local org-cycle-subtree-status nil) 89 (put 'org-cycle-subtree-status 'org-state t) 90 91 ;;;; Customization: 92 93 94 (defgroup org-cycle nil 95 "Options concerning visibility cycling in Org mode." 96 :tag "Org Cycle" 97 :group 'org-structure) 98 99 (defcustom org-cycle-skip-children-state-if-no-children t 100 "Non-nil means skip CHILDREN state in entries that don't have any." 101 :group 'org-cycle 102 :type 'boolean) 103 104 (defcustom org-cycle-max-level nil 105 "Maximum level which should still be subject to visibility cycling. 106 Levels higher than this will, for cycling, be treated as text, not a headline. 107 When `org-odd-levels-only' is set, a value of N in this variable actually 108 means 2N-1 stars as the limiting headline. 109 When nil, cycle all levels. 110 Note that the limiting level of cycling is also influenced by 111 `org-inlinetask-min-level'. When `org-cycle-max-level' is not set but 112 `org-inlinetask-min-level' is, cycling will be limited to levels one less 113 than its value." 114 :group 'org-cycle 115 :type '(choice 116 (const :tag "No limit" nil) 117 (integer :tag "Maximum level"))) 118 119 (defvaralias 'org-hide-block-startup 'org-cycle-hide-block-startup) 120 (defcustom org-cycle-hide-block-startup nil 121 "Non-nil means entering Org mode will fold all blocks. 122 This can also be set in on a per-file basis with 123 124 #+STARTUP: hideblocks 125 #+STARTUP: nohideblocks" 126 :group 'org-startup 127 :group 'org-cycle 128 :type 'boolean) 129 130 (defvaralias 'org-hide-drawer-startup 'org-cycle-hide-drawer-startup) 131 (defcustom org-cycle-hide-drawer-startup t 132 "Non-nil means entering Org mode will fold all drawers. 133 This can also be set in on a per-file basis with 134 135 #+STARTUP: hidedrawers 136 #+STARTUP: nohidedrawers" 137 :group 'org-startup 138 :group 'org-cycle 139 :type 'boolean) 140 141 (defcustom org-cycle-global-at-bob nil 142 "Cycle globally if cursor is at beginning of buffer and not at a headline. 143 144 This makes it possible to do global cycling without having to use `S-TAB' 145 or `\\[universal-argument] TAB'. For this special case to work, the first \ 146 line of the buffer 147 must not be a headline -- it may be empty or some other text. 148 149 When used in this way, `org-cycle-hook' is disabled temporarily to make 150 sure the cursor stays at the beginning of the buffer. 151 152 When this option is nil, don't do anything special at the beginning of 153 the buffer." 154 :group 'org-cycle 155 :type 'boolean) 156 157 (defcustom org-cycle-level-after-item/entry-creation t 158 "Non-nil means cycle entry level or item indentation in new empty entries. 159 160 When the cursor is at the end of an empty headline, i.e., with only stars 161 and maybe a TODO keyword, TAB will then switch the entry to become a child, 162 and then all possible ancestor states, before returning to the original state. 163 This makes data entry extremely fast: M-RET to create a new headline, 164 on TAB to make it a child, two or more tabs to make it a (grand-)uncle. 165 166 When the cursor is at the end of an empty plain list item, one TAB will 167 make it a subitem, two or more tabs will back up to make this an item 168 higher up in the item hierarchy." 169 :group 'org-cycle 170 :type 'boolean) 171 172 (defcustom org-cycle-emulate-tab t 173 "Where should `org-cycle' emulate TAB. 174 nil Never 175 white Only in completely white lines 176 whitestart Only at the beginning of lines, before the first non-white char 177 t Everywhere except in headlines 178 exc-hl-bol Everywhere except at the start of a headline 179 If TAB is used in a place where it does not emulate TAB, the current subtree 180 visibility is cycled." 181 :group 'org-cycle 182 :type '(choice (const :tag "Never" nil) 183 (const :tag "Only in completely white lines" white) 184 (const :tag "Before first char in a line" whitestart) 185 (const :tag "Everywhere except in headlines" t) 186 (const :tag "Everywhere except at bol in headlines" exc-hl-bol))) 187 188 (defcustom org-cycle-separator-lines 2 189 "Number of empty lines needed to keep an empty line between collapsed trees. 190 If you leave an empty line between the end of a subtree and the following 191 headline, this empty line is hidden when the subtree is folded. 192 Org mode will leave (exactly) one empty line visible if the number of 193 empty lines is equal or larger to the number given in this variable. 194 So the default 2 means at least 2 empty lines after the end of a subtree 195 are needed to produce free space between a collapsed subtree and the 196 following headline. 197 198 If the number is negative, and the number of empty lines is at least -N, 199 all empty lines are shown. 200 201 Special case: when 0, never leave empty lines in collapsed view." 202 :group 'org-cycle 203 :type 'integer) 204 (put 'org-cycle-separator-lines 'safe-local-variable 'integerp) 205 206 (defvaralias 'org-pre-cycle-hook 'org-cycle-pre-hook) 207 (defcustom org-cycle-pre-hook nil 208 "Hook that is run before visibility cycling is happening. 209 The function(s) in this hook must accept a single argument which indicates 210 the new state that will be set right after running this hook. The 211 argument is a symbol. Before a global state change, it can have the values 212 `overview', `content', or `all'. Before a local state change, it can have 213 the values `folded', `children', or `subtree'." 214 :group 'org-cycle 215 :type 'hook) 216 217 (defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees 218 org-cycle-show-empty-lines 219 org-cycle-optimize-window-after-visibility-change 220 org-cycle-display-inline-images) 221 "Hook that is run after `org-cycle' has changed the buffer visibility. 222 The function(s) in this hook must accept a single argument which indicates 223 the new state that was set by the most recent `org-cycle' command. The 224 argument is a symbol. After a global state change, it can have the values 225 `overview', `contents', or `all'. After a local state change, it can have 226 the values `folded', `children', or `subtree'." 227 :group 'org-cycle 228 :package-version '(Org . "9.4") 229 :type 'hook) 230 231 (defcustom org-cycle-open-archived-trees nil 232 "Non-nil means `org-cycle' will open archived trees. 233 An archived tree is a tree marked with the tag ARCHIVE. 234 When nil, archived trees will stay folded. You can still open them with 235 normal outline commands like `show-all', but not with the cycling commands." 236 :group 'org-archive 237 :group 'org-cycle 238 :type 'boolean) 239 240 (defcustom org-cycle-inline-images-display nil 241 "Non-nil means auto display inline images under subtree when cycling." 242 :group 'org-startup 243 :group 'org-cycle 244 :package-version '(Org . "9.6") 245 :type 'boolean) 246 247 (defvaralias 'org-tab-first-hook 'org-cycle-tab-first-hook) 248 (defvar org-cycle-tab-first-hook nil 249 "Hook for functions to attach themselves to TAB. 250 See `org-ctrl-c-ctrl-c-hook' for more information. 251 This hook runs as the first action when TAB is pressed, even before 252 `org-cycle' messes around with the `outline-regexp' to cater for 253 inline tasks and plain list item folding. 254 If any function in this hook returns t, any other actions that 255 would have been caused by TAB (such as table field motion or visibility 256 cycling) will not occur.") 257 258 ;;;; Implementation: 259 260 (defun org-cycle-hide-drawers (state) 261 "Re-hide all drawers after a visibility state change. 262 STATE should be one of the symbols listed in the docstring of 263 `org-cycle-hook'." 264 (when (derived-mode-p 'org-mode) 265 (cond ((not (memq state '(overview folded contents))) 266 (let* ((global? (eq state 'all)) 267 (beg (if global? (point-min) (line-beginning-position))) 268 (end (cond (global? (point-max)) 269 ((eq state 'children) (org-entry-end-position)) 270 (t (save-excursion (org-end-of-subtree t t)))))) 271 (org-fold--hide-drawers beg end))) 272 ((memq state '(overview contents)) 273 ;; Hide drawers before first heading. 274 (let ((beg (point-min)) 275 (end (save-excursion 276 (goto-char (point-min)) 277 (if (org-before-first-heading-p) 278 (org-entry-end-position) 279 (point-min))))) 280 (when (< beg end) 281 (org-fold--hide-drawers beg end))))))) 282 283 ;;;###autoload 284 (defun org-cycle (&optional arg) 285 "TAB-action and visibility cycling for Org mode. 286 287 This is the command invoked in Org mode by the `TAB' key. Its main 288 purpose is outline visibility cycling, but it also invokes other actions 289 in special contexts. 290 291 When this function is called with a `\\[universal-argument]' prefix, rotate \ 292 the entire 293 buffer through 3 states (global cycling) 294 1. OVERVIEW: Show only top-level headlines. 295 2. CONTENTS: Show all headlines of all levels, but no body text. 296 3. SHOW ALL: Show everything. 297 298 With a `\\[universal-argument] \\[universal-argument]' prefix argument, \ 299 switch to the startup visibility, 300 determined by the variable `org-startup-folded', and by any VISIBILITY 301 properties in the buffer. 302 303 With a `\\[universal-argument] \\[universal-argument] \ 304 \\[universal-argument]' prefix argument, show the entire buffer, including 305 any drawers. 306 307 When inside a table, re-align the table and move to the next field. 308 309 When point is at the beginning of a headline, rotate the subtree started 310 by this line through 3 different states (local cycling) 311 1. FOLDED: Only the main headline is shown. 312 2. CHILDREN: The main headline and the direct children are shown. 313 From this state, you can move to one of the children 314 and zoom in further. 315 3. SUBTREE: Show the entire subtree, including body text. 316 If there is no subtree, switch directly from CHILDREN to FOLDED. 317 318 When point is at the beginning of an empty headline and the variable 319 `org-cycle-level-after-item/entry-creation' is set, cycle the level 320 of the headline by demoting and promoting it to likely levels. This 321 speeds up creation document structure by pressing `TAB' once or several 322 times right after creating a new headline. 323 324 When there is a numeric prefix, go up to a heading with level ARG, do 325 a `show-subtree' and return to the previous cursor position. If ARG 326 is negative, go up that many levels. 327 328 When point is not at the beginning of a headline, execute the global 329 binding for `TAB', which is re-indenting the line. See the option 330 `org-cycle-emulate-tab' for details. 331 332 As a special case, if point is at the very beginning of the buffer, if 333 there is no headline there, and if the variable `org-cycle-global-at-bob' 334 is non-nil, this function acts as if called with prefix argument \ 335 \(`\\[universal-argument] TAB', 336 same as `S-TAB') also when called without prefix argument." 337 (interactive "P") 338 (org-load-modules-maybe) 339 (unless (or (run-hook-with-args-until-success 'org-cycle-tab-first-hook) 340 (and org-cycle-level-after-item/entry-creation 341 (or (org-cycle-level) 342 (org-cycle-item-indentation)))) 343 (when (and org-cycle-max-level 344 (or (not (integerp org-cycle-max-level)) 345 (< org-cycle-max-level 1))) 346 (user-error "`org-cycle-max-level' must be a positive integer")) 347 (let* ((limit-level 348 (or org-cycle-max-level 349 (and (boundp 'org-inlinetask-min-level) 350 org-inlinetask-min-level 351 (1- org-inlinetask-min-level)))) 352 (nstars 353 (and limit-level 354 (if org-odd-levels-only 355 (1- (* 2 limit-level)) 356 limit-level))) 357 (org-outline-regexp 358 (format "\\*%s " (if nstars (format "\\{1,%d\\}" nstars) "+")))) 359 (cond 360 ((equal arg '(16)) 361 (setq last-command 'dummy) 362 (org-cycle-set-startup-visibility) 363 (org-unlogged-message "Startup visibility, plus VISIBILITY properties")) 364 ((equal arg '(64)) 365 (org-fold-show-all) 366 (org-unlogged-message "Entire buffer visible, including drawers")) 367 ((equal arg '(4)) (org-cycle-internal-global)) 368 ;; Show-subtree, ARG levels up from here. 369 ((integerp arg) 370 (save-excursion 371 (org-back-to-heading) 372 (outline-up-heading (if (< arg 0) (- arg) 373 (- (funcall outline-level) arg))) 374 (org-fold-show-subtree))) 375 ;; Global cycling at BOB: delegate to `org-cycle-internal-global'. 376 ((and org-cycle-global-at-bob 377 (bobp) 378 (not (looking-at org-outline-regexp))) 379 (let ((org-cycle-hook 380 (remq 'org-cycle-optimize-window-after-visibility-change 381 org-cycle-hook))) 382 (org-cycle-internal-global))) 383 ;; Try CDLaTeX TAB completion. 384 ((org-try-cdlatex-tab)) 385 ;; Inline task: delegate to `org-inlinetask-toggle-visibility'. 386 ((and (featurep 'org-inlinetask) 387 (org-inlinetask-at-task-p) 388 (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) 389 (org-inlinetask-toggle-visibility)) 390 (t 391 (let ((pos (point)) 392 (element (org-element-at-point))) 393 (cond 394 ;; Try toggling visibility for block at point. 395 ((org-fold-hide-block-toggle nil t element)) 396 ;; Try toggling visibility for drawer at point. 397 ((org-fold-hide-drawer-toggle nil t element)) 398 ;; Table: enter it or move to the next field. 399 ((and (org-match-line "[ \t]*[|+]") 400 (org-element-lineage element 'table t)) 401 (if (and (org-element-type-p element 'table) 402 (eq 'table.el (org-element-property :type element))) 403 (message (substitute-command-keys "\\<org-mode-map>\ 404 Use `\\[org-edit-special]' to edit table.el tables")) 405 (org-table-justify-field-maybe) 406 (call-interactively #'org-table-next-field))) 407 ((run-hook-with-args-until-success 408 'org-tab-after-check-for-table-hook)) 409 ;; At an item/headline: delegate to `org-cycle-internal-local'. 410 ((and (or (and org-cycle-include-plain-lists 411 (let ((item (org-element-lineage element 412 '(item plain-list) 413 t))) 414 (and item 415 (= (line-beginning-position) 416 (org-element-post-affiliated 417 item))))) 418 (org-match-line org-outline-regexp)) 419 (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) 420 (org-cycle-internal-local)) 421 ;; From there: TAB emulation and template completion. 422 (buffer-read-only (org-back-to-heading)) 423 ((run-hook-with-args-until-success 424 'org-tab-after-check-for-cycling-hook)) 425 ((run-hook-with-args-until-success 426 'org-tab-before-tab-emulation-hook)) 427 ((and (eq org-cycle-emulate-tab 'exc-hl-bol) 428 (or (not (bolp)) 429 (not (looking-at org-outline-regexp)))) 430 (call-interactively (global-key-binding (kbd "TAB")))) 431 ((or (eq org-cycle-emulate-tab t) 432 (and (memq org-cycle-emulate-tab '(white whitestart)) 433 (save-excursion (forward-line 0) (looking-at "[ \t]*")) 434 (or (and (eq org-cycle-emulate-tab 'white) 435 (= (match-end 0) (line-end-position))) 436 (and (eq org-cycle-emulate-tab 'whitestart) 437 (>= (match-end 0) pos))))) 438 (call-interactively (global-key-binding (kbd "TAB")))) 439 (t 440 (save-excursion 441 (org-back-to-heading) 442 (org-cycle)))))))))) 443 444 (defun org-cycle-force-archived () 445 "Cycle subtree even if it is archived." 446 (interactive) 447 (setq this-command 'org-cycle) 448 (let ((org-cycle-open-archived-trees t)) 449 (call-interactively 'org-cycle))) 450 451 (defun org-cycle-internal-global () 452 "Do the global cycling action." 453 ;; Hack to avoid display of messages for .org attachments in Gnus 454 (let ((ga (string-match-p "\\*fontification" (buffer-name)))) 455 (cond 456 ((and (eq last-command this-command) 457 (eq org-cycle-global-status 'overview)) 458 ;; We just created the overview - now do table of contents 459 ;; This can be slow in very large buffers, so indicate action 460 (run-hook-with-args 'org-cycle-pre-hook 'contents) 461 (unless ga (org-unlogged-message "CONTENTS...")) 462 (org-cycle-content) 463 (unless ga (org-unlogged-message "CONTENTS...done")) 464 (setq org-cycle-global-status 'contents) 465 (run-hook-with-args 'org-cycle-hook 'contents)) 466 467 ((and (eq last-command this-command) 468 (eq org-cycle-global-status 'contents)) 469 ;; We just showed the table of contents - now show everything 470 (run-hook-with-args 'org-cycle-pre-hook 'all) 471 (org-fold-show-all '(headings blocks)) 472 (unless ga (org-unlogged-message "SHOW ALL")) 473 (setq org-cycle-global-status 'all) 474 (run-hook-with-args 'org-cycle-hook 'all)) 475 476 (t 477 ;; Default action: go to overview 478 (run-hook-with-args 'org-cycle-pre-hook 'overview) 479 (org-cycle-overview) 480 (unless ga (org-unlogged-message "OVERVIEW")) 481 (setq org-cycle-global-status 'overview) 482 (run-hook-with-args 'org-cycle-hook 'overview))))) 483 484 (defun org-cycle-internal-local () 485 "Do the local cycling action." 486 (let ((goal-column 0) eoh eol eos has-children children-skipped struct) 487 ;; First, determine end of headline (EOH), end of subtree or item 488 ;; (EOS), and if item or heading has children (HAS-CHILDREN). 489 (save-excursion 490 (if (org-at-item-p) 491 (progn 492 (forward-line 0) 493 (setq struct (org-list-struct)) 494 (setq eoh (line-end-position)) 495 (setq eos (org-list-get-item-end-before-blank (point) struct)) 496 (setq has-children (org-list-has-child-p (point) struct))) 497 (org-back-to-heading) 498 (setq eoh (save-excursion (outline-end-of-heading) (point))) 499 (setq eos (save-excursion 500 (org-end-of-subtree t t) 501 (unless (eobp) (forward-char -1)) 502 (point))) 503 (setq has-children 504 (or 505 (save-excursion 506 (let ((level (funcall outline-level))) 507 (outline-next-heading) 508 (and (org-at-heading-p) 509 (> (funcall outline-level) level)))) 510 (and (eq org-cycle-include-plain-lists 'integrate) 511 (save-excursion 512 (org-list-search-forward (org-item-beginning-re) eos t)))))) 513 ;; Determine end invisible part of buffer (EOL) 514 (forward-line 1) 515 (if (eq org-fold-core-style 'text-properties) 516 (while (and (not (eobp)) ;this is like `next-line' 517 (org-fold-folded-p (1- (point)))) 518 (goto-char (org-fold-next-visibility-change nil nil t)) 519 (and (eolp) (forward-line 1))) 520 (while (and (not (eobp)) ;this is like `next-line' 521 (get-char-property (1- (point)) 'invisible)) 522 (goto-char (next-single-char-property-change (point) 'invisible)) 523 (and (eolp) (forward-line 1)))) 524 (setq eol (point))) 525 ;; Find out what to do next and set `this-command' 526 (cond 527 ((= eos eoh) 528 ;; Nothing is hidden behind this heading 529 (unless (org-before-first-heading-p) 530 (run-hook-with-args 'org-cycle-pre-hook 'empty)) 531 (org-unlogged-message "EMPTY ENTRY") 532 (setq org-cycle-subtree-status nil) 533 (save-excursion 534 (goto-char eos) 535 (org-with-limited-levels 536 (outline-next-heading)) 537 (when (org-invisible-p) (org-fold-heading nil)))) 538 ((and (or (>= eol eos) 539 (save-excursion (goto-char eol) (skip-chars-forward "[:space:]" eos) (= (point) eos))) 540 (or has-children 541 (not (setq children-skipped 542 org-cycle-skip-children-state-if-no-children)))) 543 ;; Entire subtree is hidden in one line: children view 544 (unless (org-before-first-heading-p) 545 (org-with-limited-levels 546 (run-hook-with-args 'org-cycle-pre-hook 'children))) 547 (if (org-at-item-p) 548 (org-list-set-item-visibility (line-beginning-position) struct 'children) 549 (org-fold-show-entry) 550 (org-with-limited-levels (org-fold-show-children)) 551 (org-fold-show-set-visibility 'tree) 552 ;; Fold every list in subtree to top-level items. 553 (when (eq org-cycle-include-plain-lists 'integrate) 554 (save-excursion 555 (org-back-to-heading) 556 (while (org-list-search-forward (org-item-beginning-re) eos t) 557 (forward-line 0) 558 (let* ((struct (org-list-struct)) 559 (prevs (org-list-prevs-alist struct)) 560 (end (org-list-get-bottom-point struct))) 561 (dolist (e (org-list-get-all-items (point) struct prevs)) 562 (org-list-set-item-visibility e struct 'folded)) 563 (goto-char (if (< end eos) end eos))))))) 564 (org-unlogged-message "CHILDREN") 565 (save-excursion 566 (goto-char eos) 567 (org-with-limited-levels 568 (outline-next-heading)) 569 (when (and 570 ;; Subtree does not end at the end of visible section of the 571 ;; buffer. 572 (< (point) (point-max)) 573 (org-invisible-p)) 574 ;; Reveal the following heading line. 575 (org-fold-heading nil))) 576 (setq org-cycle-subtree-status 'children) 577 (unless (org-before-first-heading-p) 578 (run-hook-with-args 'org-cycle-hook 'children))) 579 ((or children-skipped 580 (and (eq last-command this-command) 581 (eq org-cycle-subtree-status 'children))) 582 ;; We just showed the children, or no children are there, 583 ;; now show everything. 584 (unless (org-before-first-heading-p) 585 (run-hook-with-args 'org-pre-cycle-hook 'subtree)) 586 (org-fold-region eoh eos nil 'outline) 587 (org-unlogged-message 588 (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) 589 (setq org-cycle-subtree-status 'subtree) 590 (unless (org-before-first-heading-p) 591 (run-hook-with-args 'org-cycle-hook 'subtree))) 592 (t 593 ;; Default action: hide the subtree. 594 (run-hook-with-args 'org-cycle-pre-hook 'folded) 595 (org-fold-region eoh eos t 'outline) 596 (org-unlogged-message "FOLDED") 597 (setq org-cycle-subtree-status 'folded) 598 (unless (org-before-first-heading-p) 599 (run-hook-with-args 'org-cycle-hook 'folded)))))) 600 601 ;;;###autoload 602 (defun org-cycle-global (&optional arg) 603 "Cycle the global visibility. For details see `org-cycle'. 604 With `\\[universal-argument]' prefix ARG, switch to startup visibility. 605 With a numeric prefix, show all headlines up to that level." 606 (interactive "P") 607 (cond 608 ((integerp arg) 609 (org-cycle-content arg) 610 (setq org-cycle-global-status 'contents)) 611 ((equal arg '(4)) 612 (org-cycle-set-startup-visibility) 613 (org-unlogged-message "Startup visibility, plus VISIBILITY properties.")) 614 (t 615 (org-cycle '(4))))) 616 617 (defun org-cycle-set-startup-visibility () 618 "Set the visibility required by startup options and properties." 619 (cond 620 ;; `fold' is technically not allowed value, but it is often 621 ;; intuitively tried by users by analogy with #+STARTUP: fold. 622 ((memq org-startup-folded '(t fold overview)) 623 (org-cycle-overview)) 624 ((eq org-startup-folded 'content) 625 (org-cycle-content)) 626 ((eq org-startup-folded 'show2levels) 627 (org-cycle-content 2)) 628 ((eq org-startup-folded 'show3levels) 629 (org-cycle-content 3)) 630 ((eq org-startup-folded 'show4levels) 631 (org-cycle-content 4)) 632 ((eq org-startup-folded 'show5levels) 633 (org-cycle-content 5)) 634 ;; `nofold' and `showall' are technically not allowed values, but 635 ;; they are often intuitively tried by users by analogy with 636 ;; #+STARTUP: nofold or #STARTUP: showall. 637 ((memq org-startup-folded '(showeverything nil nofold showall)) 638 (org-fold-show-all))) 639 (unless (eq org-startup-folded 'showeverything) 640 (when org-cycle-hide-block-startup (org-fold-hide-block-all)) 641 (org-cycle-set-visibility-according-to-property) 642 (org-cycle-hide-archived-subtrees 'all) 643 (when org-cycle-hide-drawer-startup (org-cycle-hide-drawers 'all)) 644 (org-cycle-show-empty-lines t))) 645 646 (defun org-cycle-set-visibility-according-to-property () 647 "Switch subtree visibility according to VISIBILITY property." 648 (interactive) 649 (let ((regexp (org-re-property "VISIBILITY"))) 650 (save-excursion 651 (goto-char (point-min)) 652 (while (re-search-forward regexp nil t) 653 (let ((state (match-string 3))) 654 (if (not (org-at-property-p)) (outline-next-heading) 655 (save-excursion 656 (org-back-to-heading t) 657 (org-fold-subtree t) 658 (pcase state 659 ("folded" 660 (org-fold-subtree t)) 661 ("children" 662 (org-fold-show-hidden-entry) 663 (org-fold-show-children)) 664 ("content" 665 ;; Newline before heading will be outside the 666 ;; narrowing. Make sure that it is revealed. 667 (org-fold-heading nil) 668 (save-excursion 669 (save-restriction 670 (org-narrow-to-subtree) 671 (org-cycle-content)))) 672 ((or "all" "showall") 673 (org-fold-show-subtree)) 674 (_ nil))))))))) 675 676 (defun org-cycle-overview () 677 "Switch to overview mode, showing only top-level headlines." 678 (interactive) 679 (save-excursion 680 (goto-char (point-min)) 681 ;; Hide top-level drawer. 682 (save-restriction 683 (narrow-to-region (point-min) (or (re-search-forward org-outline-regexp-bol nil t) (point-max))) 684 (org-fold-hide-drawer-all)) 685 (goto-char (point-min)) 686 (when (re-search-forward org-outline-regexp-bol nil t) 687 (let* ((last (line-end-position)) 688 (level (- (match-end 0) (match-beginning 0) 1)) 689 (regexp (format "^\\*\\{1,%d\\} " level))) 690 (while (re-search-forward regexp nil :move) 691 (org-fold-region last (line-end-position 0) t 'outline) 692 (setq last (line-end-position)) 693 (setq level (- (match-end 0) (match-beginning 0) 1)) 694 (setq regexp (format "^\\*\\{1,%d\\} " level))) 695 (org-fold-region last (point) t 'outline))))) 696 697 (defun org-cycle-content (&optional arg) 698 "Show all headlines in the buffer, like a table of contents. 699 With numerical argument ARG, show content up to level ARG." 700 (interactive "p") 701 (org-fold-show-all '(headings)) 702 (save-excursion 703 (goto-char (point-min)) 704 ;; Hide top-level drawer. 705 (save-restriction 706 (narrow-to-region (point-min) (or (re-search-forward org-outline-regexp-bol nil t) (point-max))) 707 (org-fold-hide-drawer-all)) 708 (goto-char (point-max)) 709 (let ((regexp (if (and (wholenump arg) (> arg 0)) 710 (format "^\\*\\{1,%d\\} " arg) 711 "^\\*+ ")) 712 (last (point))) 713 (while (re-search-backward regexp nil t) 714 (org-fold-region (line-end-position) last t 'outline) 715 (setq last (line-end-position 0)))))) 716 717 (defvar org-cycle-scroll-position-to-restore nil 718 "Temporarily store scroll position to restore.") 719 (defun org-cycle-optimize-window-after-visibility-change (state) 720 "Adjust the window after a change in outline visibility. 721 This function is the default value of the hook `org-cycle-hook'. 722 STATE is the current outline visibility state. It should be one of 723 symbols `content', `all', `folded', `children', or `subtree'." 724 (when (get-buffer-window (current-buffer)) 725 (let ((repeat (eq last-command this-command))) 726 (unless repeat 727 (setq org-cycle-scroll-position-to-restore nil)) 728 (cond 729 ((eq state 'content) nil) 730 ((eq state 'all) nil) 731 ((and org-cycle-scroll-position-to-restore repeat 732 (eq state 'folded)) 733 (set-window-start nil org-cycle-scroll-position-to-restore)) 734 ((eq state 'folded) nil) 735 ((eq state 'children) 736 (setq org-cycle-scroll-position-to-restore (window-start)) 737 (or (org-subtree-end-visible-p) (recenter 1))) 738 ((eq state 'subtree) 739 (unless repeat 740 (setq org-cycle-scroll-position-to-restore (window-start))) 741 (or (org-subtree-end-visible-p) (recenter 1))))))) 742 743 (defun org-cycle-show-empty-lines (state) 744 "Show empty lines above all visible headlines. 745 The region to be covered depends on STATE when called through 746 `org-cycle-hook'. Lisp program can use t for STATE to get the 747 entire buffer covered. Note that an empty line is only shown if there 748 are at least `org-cycle-separator-lines' empty lines before the headline." 749 (when (/= org-cycle-separator-lines 0) 750 (save-excursion 751 (let* ((n (abs org-cycle-separator-lines)) 752 (re (cond 753 ((= n 1) "\\(\n[ \t]*\n\\*+\\) ") 754 ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ") 755 (t (let ((ns (number-to-string (- n 2)))) 756 (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}" 757 "[ \t]*\\(\n[ \t]*\n\\*+\\) "))))) 758 beg end) 759 (cond 760 ((memq state '(overview contents t)) 761 (setq beg (point-min) end (point-max))) 762 ((memq state '(children folded)) 763 (setq beg (point) 764 end (progn (org-end-of-subtree t t) 765 (line-beginning-position 2))))) 766 (when beg 767 (goto-char beg) 768 (while (re-search-forward re end t) 769 (unless (org-invisible-p (match-end 1)) 770 (let ((e (match-end 1)) 771 (b (if (>= org-cycle-separator-lines 0) 772 (match-beginning 1) 773 (save-excursion 774 (goto-char (match-beginning 0)) 775 (skip-chars-backward " \t\n") 776 (line-end-position))))) 777 (org-fold-region b e nil 'outline)))))))) 778 ;; Never hide empty lines at the end of the file. 779 (save-excursion 780 (goto-char (point-max)) 781 (outline-previous-heading) 782 (outline-end-of-heading) 783 (when (and (looking-at "[ \t\n]+") 784 (= (match-end 0) (point-max))) 785 (org-fold-region (point) (match-end 0) nil 'outline)))) 786 787 (defun org-cycle-hide-archived-subtrees (state) 788 "Re-hide all archived subtrees after a visibility state change. 789 STATE should be one of the symbols listed in the docstring of 790 `org-cycle-hook'." 791 (when (and (not org-cycle-open-archived-trees) 792 (not (memq state '(overview folded)))) 793 (let ((globalp (memq state '(contents all)))) 794 (if globalp 795 (org-fold-hide-archived-subtrees (point-min) (point-max)) 796 (org-fold-hide-archived-subtrees 797 (point) 798 (save-excursion 799 (org-end-of-subtree t)))) 800 (when (and (not globalp) 801 (member org-archive-tag 802 (org-get-tags nil 'local))) 803 (message "%s" (substitute-command-keys 804 "Subtree is archived and stays closed. Use \ 805 `\\[org-cycle-force-archived]' to cycle it anyway.")))))) 806 807 (defun org-cycle-display-inline-images (state) 808 "Auto display inline images under subtree when cycling. 809 It works when `org-cycle-inline-images-display' is non-nil. 810 STATE is the current outline visibility state. It should be one of 811 symbols `content', `all', `folded', `children', or `subtree'." 812 (when org-cycle-inline-images-display 813 (pcase state 814 ('children 815 (org-with-wide-buffer 816 (org-narrow-to-subtree) 817 ;; If has nested headlines, beg,end only from parent headline 818 ;; to first child headline which reference to upper 819 ;; let-binding `org-next-visible-heading'. 820 (org-display-inline-images 821 nil nil 822 (point-min) (progn (org-next-visible-heading 1) (point))))) 823 ('subtree 824 (org-with-wide-buffer 825 (org-narrow-to-subtree) 826 ;; If has nested headlines, also inline display images under all sub-headlines. 827 (org-display-inline-images nil nil (point-min) (point-max)))) 828 ('folded 829 (org-with-wide-buffer 830 (org-narrow-to-subtree) 831 (if (numberp (point-max)) 832 (org-remove-inline-images (point-min) (point-max)) 833 (ignore))))))) 834 835 (provide 'org-cycle) 836 837 ;;; org-cycle.el ends here