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