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