org-fold.el (38396B)
1 ;;; org-fold.el --- Folding of Org entries -*- lexical-binding: t; -*- 2 ;; 3 ;; Copyright (C) 2020-2024 Free Software Foundation, Inc. 4 ;; 5 ;; Author: Ihor Radchenko <yantar92 at posteo dot net> 6 ;; Keywords: folding, 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 handling temporary invisibility (folding 28 ;; and unfolding) of text in org buffers. 29 30 ;; The folding is implemented using generic org-fold-core library. This file 31 ;; contains org-specific implementation of the folding. Also, various 32 ;; useful functions from org-fold-core are aliased under shorted `org-fold' 33 ;; prefix. 34 35 ;; The following features are implemented: 36 ;; - Folding/unfolding various Org mode elements and regions of Org buffers: 37 ;; + Region before first heading; 38 ;; + Org headings, their text, children (subtree), siblings, parents, etc; 39 ;; + Org blocks and drawers 40 ;; - Revealing Org structure around invisible point location 41 ;; - Revealing folded Org elements broken by user edits 42 43 ;;; Code: 44 45 (require 'org-macs) 46 (org-assert-version) 47 48 (require 'org-macs) 49 (require 'org-fold-core) 50 51 (defvar org-inlinetask-min-level) 52 (defvar org-odd-levels-only) 53 (defvar org-drawer-regexp) 54 (defvar org-property-end-re) 55 (defvar org-link-descriptive) 56 (defvar org-outline-regexp-bol) 57 (defvar org-archive-tag) 58 (defvar org-custom-properties-overlays) 59 (defvar org-element-headline-re) 60 61 (declare-function isearch-filter-visible "isearch" (beg end)) 62 (declare-function org-element-type "org-element-ast" (node &optional anonymous)) 63 (declare-function org-element-at-point "org-element" (&optional pom cached-only)) 64 (declare-function org-element-property "org-element-ast" (property node)) 65 (declare-function org-element-end "org-element" (node)) 66 (declare-function org-element-post-affiliated "org-element" (node)) 67 (declare-function org-element--current-element "org-element" (limit &optional granularity mode structure)) 68 (declare-function org-toggle-custom-properties-visibility "org" ()) 69 (declare-function org-item-re "org-list" ()) 70 (declare-function org-up-heading-safe "org" ()) 71 (declare-function org-get-tags "org" (&optional pos local fontify)) 72 (declare-function org-get-valid-level "org" (level &optional change)) 73 (declare-function org-before-first-heading-p "org" ()) 74 (declare-function org-goto-sibling "org" (&optional previous)) 75 (declare-function org-block-map "org" (function &optional start end)) 76 (declare-function org-map-region "org" (fun beg end)) 77 (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) 78 (declare-function org-back-to-heading-or-point-min "org" (&optional invisible-ok)) 79 (declare-function org-back-to-heading "org" (&optional invisible-ok)) 80 (declare-function org-at-heading-p "org" (&optional invisible-not-ok)) 81 (declare-function org-cycle-hide-drawers "org-cycle" (state)) 82 83 (declare-function outline-show-branches "outline" ()) 84 (declare-function outline-hide-sublevels "outline" (levels)) 85 (declare-function outline-get-next-sibling "outline" ()) 86 (declare-function outline-invisible-p "outline" (&optional pos)) 87 (declare-function outline-next-heading "outline" ()) 88 89 ;;; Customization 90 91 (defgroup org-fold-reveal-location nil 92 "Options about how to make context of a location visible." 93 :tag "Org Reveal Location" 94 :group 'org-structure) 95 96 (defcustom org-fold-show-context-detail '((agenda . local) 97 (bookmark-jump . lineage) 98 (isearch . lineage) 99 (default . ancestors)) 100 "Alist between context and visibility span when revealing a location. 101 102 \\<org-mode-map>Some actions may move point into invisible 103 locations. As a consequence, Org always exposes a neighborhood 104 around point. How much is shown depends on the initial action, 105 or context. Valid contexts are 106 107 agenda when exposing an entry from the agenda 108 org-goto when using the command `org-goto' (`\\[org-goto]') 109 occur-tree when using the command `org-occur' (`\\[org-sparse-tree] /') 110 tags-tree when constructing a sparse tree based on tags matches 111 link-search when exposing search matches associated with a link 112 mark-goto when exposing the jump goal of a mark 113 bookmark-jump when exposing a bookmark location 114 isearch when exiting from an incremental search 115 default default for all contexts not set explicitly 116 117 Allowed visibility spans are 118 119 minimal show current headline; if point is not on headline, 120 also show entry 121 122 local show current headline, entry and next headline 123 124 ancestors show current headline and its direct ancestors; if 125 point is not on headline, also show entry 126 127 ancestors-full show current subtree and its direct ancestors 128 129 lineage show current headline, its direct ancestors and all 130 their children; if point is not on headline, also show 131 entry and first child 132 133 tree show current headline, its direct ancestors and all 134 their children; if point is not on headline, also show 135 entry and all children 136 137 canonical show current headline, its direct ancestors along with 138 their entries and children; if point is not located on 139 the headline, also show current entry and all children 140 141 As special cases, a nil or t value means show all contexts in 142 `minimal' or `canonical' view, respectively. 143 144 Some views can make displayed information very compact, but also 145 make it harder to edit the location of the match. In such 146 a case, use the command `org-fold-reveal' (`\\[org-fold-reveal]') to show 147 more context." 148 :group 'org-fold-reveal-location 149 :version "26.1" 150 :package-version '(Org . "9.0") 151 :type '(choice 152 (const :tag "Canonical" t) 153 (const :tag "Minimal" nil) 154 (repeat :greedy t :tag "Individual contexts" 155 (cons 156 (choice :tag "Context" 157 (const agenda) 158 (const org-goto) 159 (const occur-tree) 160 (const tags-tree) 161 (const link-search) 162 (const mark-goto) 163 (const bookmark-jump) 164 (const isearch) 165 (const default)) 166 (choice :tag "Detail level" 167 (const minimal) 168 (const local) 169 (const ancestors) 170 (const ancestors-full) 171 (const lineage) 172 (const tree) 173 (const canonical)))))) 174 175 (defvar org-fold-reveal-start-hook nil 176 "Hook run before revealing a location.") 177 178 (defcustom org-fold-catch-invisible-edits 'smart 179 "Check if in invisible region before inserting or deleting a character. 180 Valid values are: 181 182 nil Do not check, so just do invisible edits. 183 error Throw an error and do nothing. 184 show Make point visible, and do the requested edit. 185 show-and-error Make point visible, then throw an error and abort the edit. 186 smart Make point visible, and do insertion/deletion if it is 187 adjacent to visible text and the change feels predictable. 188 Never delete a previously invisible character or add in the 189 middle or right after an invisible region. Basically, this 190 allows insertion and backward-delete right before ellipses. 191 FIXME: maybe in this case we should not even show? 192 193 This variable only affects commands listed in 194 `org-fold-catch-invisible-edits-commands'." 195 :group 'org-edit-structure 196 :version "24.1" 197 :type '(choice 198 (const :tag "Do not check" nil) 199 (const :tag "Throw error when trying to edit" error) 200 (const :tag "Unhide, but do not do the edit" show-and-error) 201 (const :tag "Show invisible part and do the edit" show) 202 (const :tag "Be smart and do the right thing" smart))) 203 204 (defcustom org-fold-catch-invisible-edits-commands 205 ;; We do not add non-Org commands here by default to avoid advising 206 ;; globally. See `org-fold--advice-edit-commands'. 207 '((org-self-insert-command . insert) 208 (org-delete-backward-char . delete-backward) 209 (org-delete-char . delete) 210 (org-meta-return . insert) 211 (org-return . insert)) 212 "Alist of commands where Org checks for invisible edits. 213 Each element is (COMMAND . KIND), where COMMAND is symbol representing 214 command as stored in `this-command' and KIND is symbol `insert', 215 symbol `delete', or symbol `delete-backward'. 216 217 The checks are performed around `point'. 218 219 This variable must be set before loading Org in order to take effect. 220 221 Also, see `org-fold-catch-invisible-edits'." 222 :group 'org-edit-structure 223 :package-version '("Org" . "9.7") 224 :type '(alist 225 :key-type symbol 226 :value-type (choice 227 (const insert) 228 (const delete) 229 (const delete-backward)))) 230 231 ;;; Core functionality 232 233 ;;; API 234 235 ;;;; Modifying folding specs 236 237 (defalias 'org-fold-folding-spec-p #'org-fold-core-folding-spec-p) 238 (defalias 'org-fold-add-folding-spec #'org-fold-core-add-folding-spec) 239 (defalias 'org-fold-remove-folding-spec #'org-fold-core-remove-folding-spec) 240 241 (defun org-fold-initialize (ellipsis) 242 "Setup folding in current Org buffer." 243 (setq-local org-fold-core-isearch-open-function #'org-fold--isearch-reveal) 244 (setq-local org-fold-core-extend-changed-region-functions (list #'org-fold--extend-changed-region)) 245 ;; FIXME: Converting org-link + org-description to overlays when 246 ;; search matches hidden "[[" part of the link, reverses priority of 247 ;; link and description and hides the whole link. Working around 248 ;; this until there will be no need to convert text properties to 249 ;; overlays for isearch. 250 (setq-local org-fold-core--isearch-special-specs '(org-link)) 251 (org-fold-core-initialize 252 `((,(if (eq org-fold-core-style 'text-properties) 'org-fold-outline 'outline) 253 (:ellipsis . ,ellipsis) 254 (:fragile . ,#'org-fold--reveal-outline-maybe) 255 (:isearch-open . t) 256 (:font-lock . t) 257 ;; This is needed to make sure that inserting a 258 ;; new planning line in folded heading is not 259 ;; revealed. Also, the below combination of :front-sticky and 260 ;; :rear-sticky conforms to the overlay properties in outline.el 261 ;; and the older Org versions as in `outline-flag-region'. 262 (:front-sticky . t) 263 (:rear-sticky . nil) 264 (:alias . (headline heading outline inlinetask plain-list))) 265 (,(if (eq org-fold-core-style 'text-properties) 'org-fold-block 'org-hide-block) 266 (:ellipsis . ,ellipsis) 267 (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe) 268 (:isearch-open . t) 269 (:font-lock . t) 270 (:front-sticky . t) 271 (:alias . ( block center-block comment-block 272 dynamic-block example-block export-block 273 quote-block special-block src-block 274 verse-block))) 275 (,(if (eq org-fold-core-style 'text-properties) 'org-fold-drawer 'org-hide-drawer) 276 (:ellipsis . ,ellipsis) 277 (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe) 278 (:isearch-open . t) 279 (:font-lock . t) 280 (:front-sticky . t) 281 (:alias . (drawer property-drawer)))))) 282 283 ;;;; Searching and examining folded text 284 285 (defalias 'org-fold-folded-p #'org-fold-core-folded-p) 286 (defalias 'org-fold-get-folding-spec #'org-fold-core-get-folding-spec) 287 (defalias 'org-fold-get-folding-specs-in-region #'org-fold-core-get-folding-specs-in-region) 288 (defalias 'org-fold-get-region-at-point #'org-fold-core-get-region-at-point) 289 (defalias 'org-fold-get-regions #'org-fold-core-get-regions) 290 (defalias 'org-fold-next-visibility-change #'org-fold-core-next-visibility-change) 291 (defalias 'org-fold-previous-visibility-change #'org-fold-core-previous-visibility-change) 292 (defalias 'org-fold-next-folding-state-change #'org-fold-core-next-folding-state-change) 293 (defalias 'org-fold-previous-folding-state-change #'org-fold-core-previous-folding-state-change) 294 (defalias 'org-fold-search-forward #'org-fold-core-search-forward) 295 296 ;;;;; Macros 297 298 (defalias 'org-fold-save-outline-visibility #'org-fold-core-save-visibility) 299 300 ;;;; Changing visibility (regions, blocks, drawers, headlines) 301 302 ;;;;; Region visibility 303 304 (defalias 'org-fold-region #'org-fold-core-region) 305 (defalias 'org-fold-regions #'org-fold-core-regions) 306 307 (defun org-fold-show-all (&optional types) 308 "Show all contents in the visible part of the buffer. 309 By default, the function expands headings, blocks and drawers. 310 When optional argument TYPES is a list of symbols among `blocks', 311 `drawers' and `headings', to only expand one specific type." 312 (interactive) 313 (dolist (type (or types '(blocks drawers headings))) 314 (org-fold-region (point-min) (point-max) nil 315 (pcase type 316 (`blocks 'block) 317 (`drawers 'drawer) 318 (`headings 'headline) 319 (_ (error "Invalid type: %S" type)))))) 320 321 (defun org-fold-flag-above-first-heading (&optional arg) 322 "Hide from bob up to the first heading. 323 Move point to the beginning of first heading or end of buffer." 324 (goto-char (point-min)) 325 (unless (org-at-heading-p) 326 (outline-next-heading)) 327 (unless (bobp) 328 (org-fold-region 1 (1- (point)) (not arg) 'outline))) 329 330 ;;;;; Heading visibility 331 332 (defun org-fold-heading (flag &optional entry) 333 "Fold/unfold the current heading. FLAG non-nil means make invisible. 334 When ENTRY is non-nil, show the entire entry." 335 (save-excursion 336 (org-back-to-heading t) 337 ;; Check if we should show the entire entry 338 (if (not entry) 339 (org-fold-region 340 (line-end-position 0) (line-end-position) flag 'outline) 341 (org-fold-show-entry) 342 (save-excursion 343 ;; FIXME: potentially catches inlinetasks 344 (and (outline-next-heading) 345 (org-fold-heading nil)))))) 346 347 (defun org-fold-hide-entry () 348 "Hide the body directly following this heading." 349 (interactive) 350 (save-excursion 351 (org-back-to-heading-or-point-min t) 352 (when (org-at-heading-p) (forward-line)) 353 (unless (or (eobp) (org-at-heading-p)) ; Current headline is empty. 354 (org-fold-region 355 (line-end-position 0) 356 (save-excursion 357 (if (re-search-forward 358 (concat "[\r\n]" (org-get-limited-outline-regexp)) nil t) 359 (line-end-position 0) 360 (point-max))) 361 t 362 'outline)))) 363 364 (defun org-fold-subtree (flag) 365 "Hide (when FLAG) or reveal subtree at point." 366 (save-excursion 367 (org-back-to-heading t) 368 (org-fold-region 369 (line-end-position) 370 (progn (org-end-of-subtree t t) (if (eobp) (point) (1- (point)))) 371 flag 372 'outline))) 373 374 ;; Replaces `outline-hide-subtree'. 375 (defun org-fold-hide-subtree () 376 "Hide everything after this heading at deeper levels." 377 (interactive) 378 (org-fold-subtree t)) 379 380 ;; Replaces `outline-hide-sublevels' 381 (defun org-fold-hide-sublevels (levels) 382 "Hide everything but the top LEVELS levels of headers, in whole buffer. 383 This also unhides the top heading-less body, if any. 384 385 Interactively, the prefix argument supplies the value of LEVELS. 386 When invoked without a prefix argument, LEVELS defaults to the level 387 of the current heading, or to 1 if the current line is not a heading." 388 (interactive (list 389 (cond 390 (current-prefix-arg (prefix-numeric-value current-prefix-arg)) 391 ((save-excursion (forward-line 0) 392 (looking-at outline-regexp)) 393 (funcall outline-level)) 394 (t 1)))) 395 (if (< levels 1) 396 (error "Must keep at least one level of headers")) 397 (save-excursion 398 (let* ((beg (progn 399 (goto-char (point-min)) 400 ;; Skip the prelude, if any. 401 (unless (org-at-heading-p) (outline-next-heading)) 402 (point))) 403 (end (progn 404 (goto-char (point-max)) 405 ;; Keep empty last line, if available. 406 (max (point-min) (if (bolp) (1- (point)) (point)))))) 407 (if (< end beg) 408 (setq beg (prog1 end (setq end beg)))) 409 ;; First hide everything. 410 (org-fold-region beg end t 'headline) 411 ;; Then unhide the top level headers. 412 (org-map-region 413 (lambda () 414 (when (<= (funcall outline-level) levels) 415 (org-fold-heading nil))) 416 beg end) 417 ;; Finally unhide any trailing newline. 418 (goto-char (point-max)) 419 (if (and (bolp) (not (bobp)) (outline-invisible-p (1- (point)))) 420 (org-fold-region (max (point-min) (1- (point))) (point) nil))))) 421 422 (defun org-fold-show-entry (&optional hide-drawers) 423 "Show the body directly following its heading. 424 Show the heading too, if it is currently invisible." 425 (interactive) 426 (save-excursion 427 (org-back-to-heading-or-point-min t) 428 (org-fold-region 429 (line-end-position 0) 430 (save-excursion 431 (if (re-search-forward 432 (concat "[\r\n]\\(" (org-get-limited-outline-regexp) "\\)") nil t) 433 (match-beginning 1) 434 (point-max))) 435 nil 436 'outline) 437 (when hide-drawers (org-cycle-hide-drawers 'children)))) 438 439 (defalias 'org-fold-show-hidden-entry #'org-fold-show-entry 440 "Show an entry where even the heading is hidden.") 441 442 (defun org-fold-show-siblings () 443 "Show all siblings of the current headline." 444 (save-excursion 445 (while (org-goto-sibling) (org-fold-heading nil))) 446 (save-excursion 447 (while (org-goto-sibling 'previous) 448 (org-fold-heading nil)))) 449 450 (defun org-fold-show-children (&optional level) 451 "Show all direct subheadings of this heading. 452 Prefix arg LEVEL is how many levels below the current level should be 453 shown. If direct subheadings are deeper than LEVEL, they are still 454 displayed." 455 (interactive "p") 456 (unless (org-before-first-heading-p) 457 (save-excursion 458 (org-with-limited-levels (org-back-to-heading t)) 459 (let* ((current-level (funcall outline-level)) 460 (parent-level current-level) 461 (max-level (org-get-valid-level 462 parent-level 463 (if level (prefix-numeric-value level) 1))) 464 (min-level-direct-child most-positive-fixnum) 465 (end (save-excursion (org-end-of-subtree t t))) 466 (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)") 467 ;; Make sure to skip inlinetasks. 468 (re (format regexp-fmt 469 current-level 470 (cond 471 ((not (featurep 'org-inlinetask)) "") 472 (org-odd-levels-only (- (* 2 org-inlinetask-min-level) 473 3)) 474 (t (1- org-inlinetask-min-level)))))) 475 ;; Display parent heading. 476 (org-fold-heading nil) 477 (forward-line) 478 ;; Display children. First child may be deeper than expected 479 ;; MAX-LEVEL. Since we want to display it anyway, adjust 480 ;; MAX-LEVEL accordingly. 481 (while (re-search-forward re end t) 482 (setq current-level (funcall outline-level)) 483 (when (< current-level min-level-direct-child) 484 (setq min-level-direct-child current-level 485 re (format regexp-fmt 486 parent-level 487 (max min-level-direct-child max-level)))) 488 (org-fold-heading nil)))))) 489 490 (defun org-fold-show-subtree () 491 "Show everything after this heading at deeper levels." 492 (interactive) 493 (org-fold-region 494 (point) (save-excursion (org-end-of-subtree t t)) nil 'outline)) 495 496 (defun org-fold-show-branches () 497 "Show all subheadings of this heading, but not their bodies." 498 (interactive) 499 (org-fold-show-children 1000)) 500 501 (defun org-fold-show-branches-buffer () 502 "Show all branches in the buffer." 503 (org-fold-flag-above-first-heading) 504 (org-fold-hide-sublevels 1) 505 (unless (eobp) 506 (org-fold-show-branches) 507 (while (outline-get-next-sibling) 508 (org-fold-show-branches))) 509 (goto-char (point-min))) 510 511 ;;;;; Blocks and drawers visibility 512 513 (defun org-fold--hide-wrapper-toggle (element category force no-error) 514 "Toggle visibility for ELEMENT. 515 516 ELEMENT is a block or drawer type parsed element. CATEGORY is 517 either `block' or `drawer'. When FORCE is `off', show the block 518 or drawer. If it is non-nil, hide it unconditionally. Throw an 519 error when not at a block or drawer, unless NO-ERROR is non-nil. 520 521 Return a non-nil value when toggling is successful." 522 (let ((type (org-element-type element))) 523 (cond 524 ((memq type 525 (pcase category 526 (`drawer '(drawer property-drawer)) 527 (`block '(center-block 528 comment-block dynamic-block example-block export-block 529 quote-block special-block src-block verse-block)) 530 (_ (error "Unknown category: %S" category)))) 531 (let* ((post (org-element-post-affiliated element)) 532 (start (save-excursion 533 (goto-char post) 534 (line-end-position))) 535 (end (save-excursion 536 (goto-char (org-element-end element)) 537 (skip-chars-backward " \t\n") 538 (line-end-position)))) 539 ;; Do nothing when not before or at the block opening line or 540 ;; at the block closing line. 541 (unless (let ((eol (line-end-position))) 542 (and (> eol start) (/= eol end))) 543 (org-fold-region start end 544 (cond ((eq force 'off) nil) 545 (force t) 546 ((org-fold-folded-p start category) nil) 547 (t t)) 548 category) 549 ;; When the block is hidden away, make sure point is left in 550 ;; a visible part of the buffer. 551 (when (invisible-p (max (1- (point)) (point-min))) 552 (goto-char post)) 553 ;; Signal success. 554 t))) 555 (no-error nil) 556 (t 557 (user-error (format "%s@%s: %s" 558 (buffer-file-name (buffer-base-buffer)) 559 (point) 560 (if (eq category 'drawer) 561 "Not at a drawer" 562 "Not at a block"))))))) 563 564 (defun org-fold-hide-block-toggle (&optional force no-error element) 565 "Toggle the visibility of the current block. 566 567 When optional argument FORCE is `off', make block visible. If it 568 is non-nil, hide it unconditionally. Throw an error when not at 569 a block, unless NO-ERROR is non-nil. When optional argument 570 ELEMENT is provided, consider it instead of the current block. 571 572 Return a non-nil value when toggling is successful." 573 (interactive) 574 (org-fold--hide-wrapper-toggle 575 (or element (org-element-at-point)) 'block force no-error)) 576 577 (defun org-fold-hide-drawer-toggle (&optional force no-error element) 578 "Toggle the visibility of the current drawer. 579 580 When optional argument FORCE is `off', make drawer visible. If 581 it is non-nil, hide it unconditionally. Throw an error when not 582 at a drawer, unless NO-ERROR is non-nil. When optional argument 583 ELEMENT is provided, consider it instead of the current drawer. 584 585 Return a non-nil value when toggling is successful." 586 (interactive) 587 (org-fold--hide-wrapper-toggle 588 (or element (org-element-at-point)) 'drawer force no-error)) 589 590 (defun org-fold-hide-block-all () 591 "Fold all blocks in the current buffer." 592 (interactive) 593 (org-block-map (apply-partially #'org-fold-hide-block-toggle 'hide))) 594 595 (defun org-fold-hide-drawer-all (&optional begin end) 596 "Fold all drawers in the current buffer or active region BEGIN..END." 597 (interactive (list (and (use-region-p) (region-beginning)) 598 (and (use-region-p) (region-end)))) 599 (let ((begin (or begin (point-min))) 600 (end (or end (point-max)))) 601 (org-fold--hide-drawers begin end))) 602 603 (defun org-fold--hide-drawers (begin end) 604 "Hide all drawers between BEGIN and END." 605 (save-excursion 606 (goto-char begin) 607 (while (and (< (point) end) 608 (re-search-forward org-drawer-regexp end t)) 609 ;; Skip folded drawers 610 (if (org-fold-folded-p nil 'drawer) 611 (goto-char (org-fold-next-folding-state-change 'drawer nil end)) 612 (let* ((drawer (org-element-at-point)) 613 (type (org-element-type drawer))) 614 (when (memq type '(drawer property-drawer)) 615 (org-fold-hide-drawer-toggle t nil drawer) 616 ;; Make sure to skip drawer entirely or we might flag it 617 ;; another time when matching its ending line with 618 ;; `org-drawer-regexp'. 619 (goto-char (org-element-end drawer)))))))) 620 621 (defun org-fold-hide-archived-subtrees (beg end) 622 "Re-hide all archived subtrees after a visibility state change." 623 (org-with-wide-buffer 624 (let ((case-fold-search nil) 625 (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":"))) 626 (goto-char beg) 627 ;; Include headline point is currently on. 628 (forward-line 0) 629 (while (and (< (point) end) (re-search-forward re end t)) 630 (when (member org-archive-tag (org-get-tags nil t)) 631 (org-fold-subtree t) 632 (org-end-of-subtree t)))))) 633 634 ;;;;; Reveal point location 635 636 (defun org-fold-show-context (&optional key) 637 "Make sure point and context are visible. 638 Optional argument KEY, when non-nil, is a symbol. See 639 `org-fold-show-context-detail' for allowed values and how much is to 640 be shown." 641 (org-fold-show-set-visibility 642 (cond ((symbolp org-fold-show-context-detail) org-fold-show-context-detail) 643 ((cdr (assq key org-fold-show-context-detail))) 644 (t (cdr (assq 'default org-fold-show-context-detail)))))) 645 646 647 (defvar org-hide-emphasis-markers); Defined in org.el 648 (defvar org-pretty-entities); Defined in org.el 649 (defun org-fold-show-set-visibility (detail) 650 "Set visibility around point according to DETAIL. 651 DETAIL is either nil, `minimal', `local', `ancestors', 652 `ancestors-full', `lineage', `tree', `canonical' or t. See 653 `org-show-context-detail' for more information." 654 ;; Show current heading and possibly its entry, following headline 655 ;; or all children. 656 (if (and (org-at-heading-p) (not (eq detail 'local))) 657 (org-fold-heading nil) 658 (org-fold-show-entry) 659 ;; If point is hidden make sure to expose it. 660 (when (org-invisible-p) 661 ;; FIXME: No clue why, but otherwise the following might not work. 662 (redisplay) 663 ;; Reveal emphasis markers. 664 (when (eq detail 'local) 665 (let (org-hide-emphasis-markers 666 org-link-descriptive 667 org-pretty-entities 668 (org-hide-macro-markers nil) 669 (region (or (org-find-text-property-region (point) 'org-emphasis) 670 (org-find-text-property-region (point) 'org-macro) 671 (org-find-text-property-region (point) 'invisible)))) 672 ;; Silence byte-compiler. 673 (ignore org-hide-macro-markers) 674 (when region 675 (org-with-point-at (car region) 676 (forward-line 0) 677 (let (font-lock-extend-region-functions) 678 (font-lock-fontify-region (max (point-min) (1- (car region))) (cdr region))))))) 679 (let (region) 680 (dolist (spec (org-fold-core-folding-spec-list)) 681 (setq region (org-fold-get-region-at-point spec)) 682 (when region 683 (org-fold-region (car region) (cdr region) nil spec))))) 684 (unless (org-before-first-heading-p) 685 (org-with-limited-levels 686 (cl-case detail 687 ((tree canonical t) (org-fold-show-children)) 688 ((nil minimal ancestors ancestors-full)) 689 (t (save-excursion 690 (outline-next-heading) 691 (org-fold-heading nil))))))) 692 ;; Show whole subtree. 693 (when (eq detail 'ancestors-full) (org-fold-show-subtree)) 694 ;; Show all siblings. 695 (when (eq detail 'lineage) (org-fold-show-siblings)) 696 ;; Show ancestors, possibly with their children. 697 (when (memq detail '(ancestors ancestors-full lineage tree canonical t)) 698 (save-excursion 699 (while (org-up-heading-safe) 700 (org-fold-heading nil) 701 (when (memq detail '(canonical t)) (org-fold-show-entry)) 702 (when (memq detail '(tree canonical t)) (org-fold-show-children)))))) 703 704 (defun org-fold-reveal (&optional siblings) 705 "Show current entry, hierarchy above it, and the following headline. 706 707 This can be used to show a consistent set of context around 708 locations exposed with `org-fold-show-context'. 709 710 With optional argument SIBLINGS, on each level of the hierarchy all 711 siblings are shown. This repairs the tree structure to what it would 712 look like when opened with hierarchical calls to `org-cycle'. 713 714 With a \\[universal-argument] \\[universal-argument] prefix, \ 715 go to the parent and show the entire tree." 716 (interactive "P") 717 (run-hooks 'org-fold-reveal-start-hook) 718 (cond ((equal siblings '(4)) (org-fold-show-set-visibility 'canonical)) 719 ((equal siblings '(16)) 720 (save-excursion 721 (when (org-up-heading-safe) 722 (org-fold-show-subtree) 723 (run-hook-with-args 'org-cycle-hook 'subtree)))) 724 (t (org-fold-show-set-visibility 'lineage)))) 725 726 ;;; Make isearch search in some text hidden via text properties. 727 728 (defun org-fold--isearch-reveal (pos) 729 "Reveal text at POS found by isearch." 730 (org-with-point-at pos 731 (org-fold-show-context 'isearch))) 732 733 ;;; Handling changes in folded elements 734 735 (defun org-fold--extend-changed-region (from to) 736 "Consider folded regions in the next/previous line when fixing region visibility. 737 This function is intended to be used as a member of 738 `org-fold-core-extend-changed-region-functions'." 739 ;; If the edit is done in the first line of a folded drawer/block, 740 ;; the folded text is only starting from the next line and needs to 741 ;; be checked. 742 (setq to (save-excursion (goto-char to) (line-beginning-position 2))) 743 ;; If the ":END:" line of the drawer is deleted, the folded text is 744 ;; only ending at the previous line and needs to be checked. 745 (setq from (save-excursion (goto-char from) (line-beginning-position 0))) 746 (cons from to)) 747 748 (defun org-fold--reveal-headline-at-point () 749 "Reveal header line and empty contents inside. 750 Reveal the header line and, if present, also reveal its contents, when 751 the contents consists of blank lines. 752 753 Assume that point is located at the header line." 754 (org-with-wide-buffer 755 (forward-line 0) 756 (org-fold-region 757 (max (point-min) (1- (point))) 758 (let ((endl (line-end-position))) 759 (save-excursion 760 (goto-char endl) 761 (skip-chars-forward "\n\t\r ") 762 ;; Unfold blank lines after newly inserted headline. 763 (if (equal (point) 764 (save-excursion 765 (goto-char endl) 766 (org-end-of-subtree t) 767 (skip-chars-forward "\n\t\r "))) 768 (point) 769 endl))) 770 nil 'headline))) 771 772 (defun org-fold--reveal-outline-maybe (region _) 773 "Reveal folded outline in REGION when needed. 774 775 This function is intended to be used as :fragile property of 776 `org-fold-outline' spec. See `org-fold-core--specs' for details." 777 (save-match-data 778 (org-with-wide-buffer 779 (goto-char (car region)) 780 ;; The line before beginning of the fold should be either a 781 ;; headline or a list item. 782 (backward-char) 783 (forward-line 0) 784 ;; Make sure that headline is not partially hidden. 785 (unless (org-fold-folded-p nil 'headline) 786 (org-fold--reveal-headline-at-point)) 787 ;; Never hide level 1 headlines 788 (save-excursion 789 (goto-char (line-end-position)) 790 (unless (>= (point) (cdr region)) 791 (when (re-search-forward (rx bol "* ") (cdr region) t) 792 (org-fold--reveal-headline-at-point)))) 793 ;; Make sure that headline after is not partially hidden. 794 (goto-char (cdr region)) 795 (forward-line 0) 796 (unless (org-fold-folded-p nil 'headline) 797 (when (looking-at-p org-element-headline-re) 798 (org-fold--reveal-headline-at-point))) 799 ;; Check the validity of headline 800 (goto-char (car region)) 801 (backward-char) 802 (forward-line 0) 803 (unless (let ((case-fold-search t)) 804 (looking-at (rx-to-string 805 `(or (regex ,(org-item-re)) 806 (regex ,org-outline-regexp-bol))))) 807 t)))) 808 809 (defun org-fold--reveal-drawer-or-block-maybe (region spec) 810 "Reveal folded drawer/block (according to SPEC) in REGION when needed. 811 812 This function is intended to be used as :fragile property of 813 `org-fold-drawer' or `org-fold-block' spec." 814 (let ((begin-re (cond 815 ((eq spec (org-fold-core-get-folding-spec-from-alias 'drawer)) 816 org-drawer-regexp) 817 ;; Group one below contains the type of the block. 818 ((eq spec (org-fold-core-get-folding-spec-from-alias 'block)) 819 (rx bol (zero-or-more (any " " "\t")) 820 "#+begin" 821 (or ":" 822 (seq "_" 823 (group (one-or-more (not (syntax whitespace)))))))))) 824 ;; To be determined later. May depend on `begin-re' match (i.e. for blocks). 825 end-re) 826 (save-match-data ; we should not clobber match-data in after-change-functions 827 (let ((fold-begin (car region)) 828 (fold-end (cdr region))) 829 (let (unfold?) 830 (catch :exit 831 ;; The line before folded text should be beginning of 832 ;; the drawer/block. 833 (save-excursion 834 (goto-char fold-begin) 835 ;; The line before beginning of the fold should be the 836 ;; first line of the drawer/block. 837 (backward-char) 838 (forward-line 0) 839 (unless (let ((case-fold-search t)) 840 (looking-at begin-re)) ; the match-data will be used later 841 (throw :exit (setq unfold? t)))) 842 ;; Set `end-re' for the current drawer/block. 843 (setq end-re 844 (cond 845 ((eq spec (org-fold-core-get-folding-spec-from-alias 'drawer)) 846 org-property-end-re) 847 ((eq spec (org-fold-core-get-folding-spec-from-alias 'block)) 848 (let ((block-type (match-string 1))) ; the last match is from `begin-re' 849 (concat (rx bol (zero-or-more (any " " "\t")) "#+end") 850 (if block-type 851 (concat "_" 852 (regexp-quote block-type) 853 (rx (zero-or-more (any " " "\t")) eol)) 854 (rx (opt ":") (zero-or-more (any " " "\t")) eol))))))) 855 ;; The last line of the folded text should match `end-re'. 856 (save-excursion 857 (goto-char fold-end) 858 (forward-line 0) 859 (unless (let ((case-fold-search t)) 860 (looking-at end-re)) 861 (throw :exit (setq unfold? t)))) 862 ;; There should be no `end-re' or 863 ;; `org-outline-regexp-bol' anywhere in the 864 ;; drawer/block body. 865 (save-excursion 866 (goto-char fold-begin) 867 (when (save-excursion 868 (let ((case-fold-search t)) 869 (re-search-forward (rx-to-string `(or (regex ,end-re) 870 (regex ,org-outline-regexp-bol))) 871 (max (point) 872 (1- (save-excursion 873 (goto-char fold-end) 874 (line-beginning-position)))) 875 t))) 876 (throw :exit (setq unfold? t))))) 877 unfold?))))) 878 879 ;; Catching user edits inside invisible text 880 (defun org-fold-check-before-invisible-edit (kind) 881 "Check if editing KIND is dangerous with invisible text around. 882 The detailed reaction depends on the user option 883 `org-fold-catch-invisible-edits'." 884 ;; First, try to get out of here as quickly as possible, to reduce overhead 885 (when (and org-fold-catch-invisible-edits 886 (or (not (boundp 'visible-mode)) (not visible-mode)) 887 (or (org-invisible-p) 888 (org-invisible-p (max (point-min) (1- (point)))))) 889 ;; OK, we need to take a closer look. Only consider invisibility 890 ;; caused by folding of headlines, drawers, and blocks. Edits 891 ;; inside links will be handled by font-lock. 892 (let* ((invisible-at-point (org-fold-folded-p (point) '(headline drawer block))) 893 (invisible-before-point 894 (and (not (bobp)) 895 (org-fold-folded-p (1- (point)) '(headline drawer block)))) 896 (border-and-ok-direction 897 (or 898 ;; Check if we are acting predictably before invisible 899 ;; text. 900 (and invisible-at-point (not invisible-before-point) 901 (memq kind '(insert delete-backward))) 902 ;; Check if we are acting predictably after invisible text 903 ;; This works not well, and I have turned it off. It seems 904 ;; better to always show and stop after invisible text. 905 ;; (and (not invisible-at-point) invisible-before-point 906 ;; (memq kind '(insert delete))) 907 ))) 908 (when (or invisible-at-point invisible-before-point) 909 (when (eq org-fold-catch-invisible-edits 'error) 910 (user-error "Editing in invisible areas is prohibited, make them visible first")) 911 (if (and org-custom-properties-overlays 912 (y-or-n-p "Display invisible properties in this buffer? ")) 913 (org-toggle-custom-properties-visibility) 914 ;; Make the area visible 915 (save-excursion 916 (org-fold-show-set-visibility 'local)) 917 (when invisible-before-point 918 (org-with-point-at (1- (point)) (org-fold-show-set-visibility 'local))) 919 (cond 920 ((eq org-fold-catch-invisible-edits 'show) 921 ;; That's it, we do the edit after showing 922 (message 923 "Unfolding invisible region around point before editing") 924 (sit-for 1)) 925 ((and (eq org-fold-catch-invisible-edits 'smart) 926 border-and-ok-direction) 927 (message "Unfolding invisible region around point before editing")) 928 (t 929 ;; Don't do the edit, make the user repeat it in full visibility 930 (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) 931 932 (defun org-fold-check-before-invisible-edit-maybe (&rest _) 933 "Check before invisible command by `this-command'." 934 (when (derived-mode-p 'org-mode) 935 (pcase (alist-get this-command org-fold-catch-invisible-edits-commands) 936 ((pred null) nil) 937 (kind (org-fold-check-before-invisible-edit kind))))) 938 939 (defun org-fold--advice-edit-commands () 940 "Advice editing commands according to `org-fold-catch-invisible-edits-commands'. 941 The advices are installed in current buffer." 942 (dolist (command (mapcar #'car org-fold-catch-invisible-edits-commands)) 943 (advice-add command :before #'org-fold-check-before-invisible-edit-maybe))) 944 945 (provide 'org-fold) 946 947 ;;; org-fold.el ends here