Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Against aea1109ef
diff --git a/contrib/lisp/org-checklist.el b/contrib/lisp/org-checklist.el
index 2bc00c0b9..f50c811ab 100644
--- a/contrib/lisp/org-checklist.el
+++ b/contrib/lisp/org-checklist.el
@@ -103,7 +103,7 @@ of checkbox items"
(save-excursion
(org-narrow-to-subtree)
(org-update-checkbox-count-maybe)
- (org-show-subtree)
+ (org-fold-show-subtree)
(goto-char (point-min))
(when (looking-at org-complex-heading-regexp)
(setq title (match-string 4)))
diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el
index 4b3693a0e..02c6a6a36 100644
--- a/contrib/lisp/org-contacts.el
+++ b/contrib/lisp/org-contacts.el
@@ -673,7 +673,7 @@ description."
(when marker
(switch-to-buffer-other-window (marker-buffer marker))
(goto-char marker)
- (when (eq major-mode 'org-mode) (org-show-context 'agenda)))))
+ (when (eq major-mode 'org-mode) (org-fold-show-context 'agenda)))))
(with-no-warnings (defvar date)) ;; unprefixed, from calendar.el
(defun org-contacts-anniversaries (&optional field format)
diff --git a/contrib/lisp/org-invoice.el b/contrib/lisp/org-invoice.el
index 686889411..e6a0910a1 100644
--- a/contrib/lisp/org-invoice.el
+++ b/contrib/lisp/org-invoice.el
@@ -393,7 +393,7 @@ I place mine under a third-level heading like so:
(let ((report (org-invoice-in-report-p)))
(when (and (not report) jump)
(when (re-search-forward "^#\\+BEGIN:[ \t]+invoice" nil t)
- (org-show-entry)
+ (org-fold-show-entry)
(beginning-of-line)
(setq report (point))))
(if report (goto-char report)
diff --git a/contrib/lisp/org-notify.el b/contrib/lisp/org-notify.el
index 7f610a0df..625abe4c3 100644
--- a/contrib/lisp/org-notify.el
+++ b/contrib/lisp/org-notify.el
@@ -255,7 +255,7 @@ seconds. The default value for SECS is 20."
(switch-to-buffer (find-file-noselect file))
(org-with-wide-buffer
(goto-char begin)
- (outline-show-entry))
+ (org-fold-show-entry))
(goto-char begin)
(search-forward "DEADLINE: <")
(search-forward ":")
diff --git a/contrib/lisp/org-registry.el b/contrib/lisp/org-registry.el
index 402ce3082..98a0f4bd0 100644
--- a/contrib/lisp/org-registry.el
+++ b/contrib/lisp/org-registry.el
@@ -119,7 +119,7 @@ buffer."
(funcall org-registry-find-file file)
(goto-char point)
(unless (org-before-first-heading-p)
- (org-show-context)))
+ (org-fold-show-context)))
((and files (not visit))
;; result(s) to display
(cond ((eq 1 (length files))
diff --git a/contrib/lisp/org-toc.el b/contrib/lisp/org-toc.el
index e05c4bdf8..545b06482 100644
--- a/contrib/lisp/org-toc.el
+++ b/contrib/lisp/org-toc.el
@@ -197,7 +197,7 @@ specified, then make `org-toc-recenter' use this value."
(setq ov (make-overlay beg end)))
;; change the folding status of this headline
(cond ((or (null status) (eq status 'folded))
- (org-show-children)
+ (org-fold-show-children)
(message "CHILDREN")
(overlay-put ov 'status 'children))
((eq status 'children)
@@ -290,9 +290,9 @@ If CYCLE is non-nil, cycle the targeted subtree in the Org window."
(if cycle (org-cycle)
(progn (org-overview)
(if org-toc-show-subtree-mode
- (org-show-subtree)
- (org-show-entry))
- (org-show-context)))
+ (org-fold-show-subtree)
+ (org-fold-show-entry))
+ (org-fold-show-context)))
(if org-toc-recenter-mode
(if (>= org-toc-recenter 1000) (recenter)
(recenter org-toc-recenter)))
@@ -441,7 +441,7 @@ current table of contents to it."
(setq ov (make-overlay (match-beginning 0)
(match-end 0))))
(cond ((eq (cdr hlcfg0) 'children)
- (org-show-children)
+ (org-fold-show-children)
(message "CHILDREN")
(overlay-put ov 'status 'children))
((eq (cdr hlcfg0) 'branches)
diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el
index bfc4d6c3e..c861e9858 100644
--- a/contrib/lisp/org-velocity.el
+++ b/contrib/lisp/org-velocity.el
@@ -325,7 +325,7 @@ use it."
(save-excursion
(when narrow
(org-narrow-to-subtree))
- (outline-show-all)))
+ (org-fold-show-all)))
(defun org-velocity-edit-entry/inline (heading)
"Edit entry at HEADING in the original buffer."
diff --git a/doc/org-manual.org b/doc/org-manual.org
index 7ab7d1c94..d16eb7306 100644
--- a/doc/org-manual.org
+++ b/doc/org-manual.org
@@ -509,11 +509,11 @@ Org uses just two commands, bound to {{{kbd(TAB)}}} and
Switch back to the startup visibility of the buffer (see [[*Initial
visibility]]).
-- {{{kbd(C-u C-u C-u TAB)}}} (~outline-show-all~) ::
+- {{{kbd(C-u C-u C-u TAB)}}} (~org-show-all~) ::
#+cindex: show all, command
#+kindex: C-u C-u C-u TAB
- #+findex: outline-show-all
+ #+findex: org-show-all
Show all, including drawers.
- {{{kbd(C-c C-r)}}} (~org-reveal~) ::
@@ -529,18 +529,18 @@ Org uses just two commands, bound to {{{kbd(TAB)}}} and
headings. With a double prefix argument, also show the entire
subtree of the parent.
-- {{{kbd(C-c C-k)}}} (~outline-show-branches~) ::
+- {{{kbd(C-c C-k)}}} (~org-show-branches~) ::
#+cindex: show branches, command
#+kindex: C-c C-k
- #+findex: outline-show-branches
+ #+findex: org-show-branches
Expose all the headings of the subtree, but not their bodies.
-- {{{kbd(C-c TAB)}}} (~outline-show-children~) ::
+- {{{kbd(C-c TAB)}}} (~org-show-children~) ::
#+cindex: show children, command
#+kindex: C-c TAB
- #+findex: outline-show-children
+ #+findex: org-show-children
Expose all direct children of the subtree. With a numeric prefix
argument {{{var(N)}}}, expose all children down to level
{{{var(N)}}}.
@@ -7296,7 +7296,7 @@ its location in the outline tree, but behaves in the following way:
command (see [[*Visibility Cycling]]). You can force cycling archived
subtrees with {{{kbd(C-TAB)}}}, or by setting the option
~org-cycle-open-archived-trees~. Also normal outline commands, like
- ~outline-show-all~, open archived subtrees.
+ ~org-show-all~, open archived subtrees.
-
#+vindex: org-sparse-tree-open-archived-trees
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 7300f239e..e2da8bb99 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -26,6 +26,7 @@
(require 'cl-lib)
(require 'ob-eval)
(require 'org-macs)
+(require 'org-fold)
(require 'org-compat)
(defconst org-babel-exeext
@@ -1788,7 +1789,7 @@ If the point is not on a source block then return nil."
(let ((point (org-babel-find-named-block name)))
(if point
;; Taken from `org-open-at-point'.
- (progn (org-mark-ring-push) (goto-char point) (org-show-context))
+ (progn (org-mark-ring-push) (goto-char point) (org-fold-show-context))
(message "source-code block `%s' not found in this buffer" name))))
(defun org-babel-find-named-block (name)
@@ -1828,7 +1829,7 @@ to `org-babel-named-src-block-regexp'."
(let ((point (org-babel-find-named-result name)))
(if point
;; taken from `org-open-at-point'
- (progn (goto-char point) (org-show-context))
+ (progn (goto-char point) (org-fold-show-context))
(message "result `%s' not found in this buffer" name))))
(defun org-babel-find-named-result (name)
diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el
index 394c4ffb5..c19152d47 100644
--- a/lisp/ob-ref.el
+++ b/lisp/ob-ref.el
@@ -104,7 +104,7 @@ Emacs Lisp representation of the value of the variable."
(pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
(move-marker m nil)
- (org-show-context)
+ (org-fold-show-context)
t))))
(defun org-babel-ref-headline-body ()
diff --git a/lisp/ol.el b/lisp/ol.el
index 951bb74e7..18100ecf9 100644
--- a/lisp/ol.el
+++ b/lisp/ol.el
@@ -721,7 +721,7 @@ White spaces are not significant."
(let ((object (org-element-context)))
(when (eq (org-element-type object) 'radio-target)
(goto-char (org-element-property :begin object))
- (org-show-context 'link-search)
+ (org-fold-show-context 'link-search)
(throw :radio-match nil))))
(goto-char origin)
(user-error "No match for radio target: %s" target))))
@@ -1243,7 +1243,7 @@ of matched result, which is either `dedicated' or `fuzzy'."
(error "No match for fuzzy expression: %s" normalized)))
;; Disclose surroundings of match, if appropriate.
(when (and (derived-mode-p 'org-mode) (not stealth))
- (org-show-context 'link-search))
+ (org-fold-show-context 'link-search))
type))
(defun org-link-heading-search-string (&optional string)
@@ -1408,7 +1408,7 @@ is non-nil, move backward."
(`nil nil)
(link
(goto-char (org-element-property :begin link))
- (when (org-invisible-p) (org-show-context))
+ (when (org-invisible-p) (org-fold-show-context))
(throw :found t)))))
(goto-char pos)
(setq org-link--search-failed t)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 82fe6091c..8de815c3a 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -6835,7 +6835,7 @@ and stored in the variable `org-prefix-format-compiled'."
(t " %-12:c%?-12t% s")))
(start 0)
varform vars var e c f opt)
- (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+)\\)"
+ (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+?)\\)"
s start)
(setq var (or (cdr (assoc (match-string 4 s)
'(("c" . category) ("t" . time) ("l" . level) ("s" . extra)
@@ -8801,7 +8801,7 @@ When called with a prefix argument, include all archive files as well."
(push-mark)
(goto-char pos)
(when (derived-mode-p 'org-mode)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(recenter (/ (window-height) 2))
(org-back-to-heading t)
(let ((case-fold-search nil))
@@ -9088,7 +9088,7 @@ displayed Org file fills the frame."
(widen)
(goto-char pos)
(when (derived-mode-p 'org-mode)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(run-hooks 'org-agenda-after-show-hook)))))
(defun org-agenda-goto-mouse (ev)
@@ -9104,7 +9104,7 @@ if it was hidden in the outline."
(interactive "P")
(let ((win (selected-window)))
(org-agenda-goto t)
- (when full-entry (org-show-entry))
+ (when full-entry (org-fold-show-entry))
(select-window win)))
(defvar org-agenda-show-window nil)
@@ -9123,12 +9123,12 @@ fold drawers."
(select-window org-agenda-show-window)
(ignore-errors (scroll-up)))
(org-agenda-goto t)
- (org-show-entry)
+ (org-fold-show-entry)
(if arg (org-cycle-hide-drawers 'children)
(org-with-wide-buffer
(narrow-to-region (org-entry-beginning-position)
(org-entry-end-position))
- (org-show-all '(drawers))))
+ (org-fold-show-all '(drawers))))
(setq org-agenda-show-window (selected-window)))
(select-window win)))
@@ -9159,7 +9159,7 @@ if it was hidden in the outline."
(set-window-start (selected-window) (point-at-bol))
(cond
((= more 0)
- (org-flag-subtree t)
+ (org-fold-subtree t)
(save-excursion
(org-back-to-heading)
(run-hook-with-args 'org-cycle-hook 'folded))
@@ -9167,20 +9167,20 @@ if it was hidden in the outline."
((and (called-interactively-p 'any) (= more 1))
(message "Remote: show with default settings"))
((= more 2)
- (outline-show-entry)
- (org-show-children)
+ (org-fold-show-entry)
+ (org-fold-show-children)
(save-excursion
(org-back-to-heading)
(run-hook-with-args 'org-cycle-hook 'children))
(message "Remote: CHILDREN"))
((= more 3)
- (outline-show-subtree)
+ (org-fold-show-subtree)
(save-excursion
(org-back-to-heading)
(run-hook-with-args 'org-cycle-hook 'subtree))
(message "Remote: SUBTREE"))
((> more 3)
- (outline-show-subtree)
+ (org-fold-show-subtree)
(message "Remote: SUBTREE AND ALL DRAWERS")))
(select-window win)))
@@ -9310,7 +9310,7 @@ the same tree node, and the headline of the tree node in the Org file."
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(let ((current-prefix-arg arg))
(call-interactively 'org-todo))
(and (bolp) (forward-char 1))
@@ -9318,7 +9318,7 @@ the same tree node, and the headline of the tree node in the Org file."
(when (and (bound-and-true-p
org-agenda-headline-snapshot-before-repeat)
(not (equal org-agenda-headline-snapshot-before-repeat
- newhead))
+ newhead))
todayp)
(setq newhead org-agenda-headline-snapshot-before-repeat
just-one t))
@@ -9348,7 +9348,7 @@ the same tree node, and the headline of the tree node in the Org file."
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(org-add-note))))
(defun org-agenda-change-all-lines (newhead hdmarker
@@ -9488,7 +9488,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(org-priority force-direction)
(end-of-line 1)
(setq newhead (org-get-heading)))
@@ -9512,7 +9512,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(if tag
(org-toggle-tag tag onoff)
(call-interactively #'org-set-tags-command))
@@ -9537,7 +9537,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(call-interactively 'org-set-property))))))
(defun org-agenda-set-effort ()
@@ -9556,7 +9556,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(call-interactively 'org-set-effort)
(end-of-line 1)
(setq newhead (org-get-heading)))
@@ -9578,7 +9578,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(call-interactively 'org-toggle-archive-tag)
(end-of-line 1)
(setq newhead (org-get-heading)))
@@ -9783,7 +9783,7 @@ ARG is passed through to `org-deadline'."
(with-current-buffer (marker-buffer marker)
(widen)
(goto-char pos)
- (org-show-context 'agenda)
+ (org-fold-show-context 'agenda)
(org-clock-in arg)
(setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead hdmarker))
@@ -9872,7 +9872,7 @@ buffer, display it in another window."
(find-file-noselect org-agenda-diary-file))
(require 'org-datetree)
(org-datetree-find-date-create d1)
- (org-reveal t))
+ (org-fold-reveal t))
(t (user-error "Invalid selection character `%c'" char)))))
(defcustom org-agenda-insert-diary-strategy 'date-tree
@@ -9974,7 +9974,7 @@ the resulting entry will not be shown. When TEXT is empty, switch to
(message "%s entry added to %s"
(capitalize (symbol-name type))
(abbreviate-file-name org-agenda-diary-file)))
- (org-reveal t)
+ (org-fold-reveal t)
(message "Please finish entry here"))))
(defun org-agenda-insert-diary-as-top-level (text)
@@ -10012,7 +10012,7 @@ a timestamp can be added there."
(unless (bolp) (insert "\n"))
(unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n")))
(when org-adapt-indentation (indent-to-column col)))
- (org-show-set-visibility 'lineage))
+ (org-fold-show-set-visibility 'lineage))
(defun org-agenda-diary-entry ()
"Make a diary entry, like the `i' command from the calendar.
diff --git a/lisp/org-archive.el b/lisp/org-archive.el
index d3e12d17b..54239e74e 100644
--- a/lisp/org-archive.el
+++ b/lisp/org-archive.el
@@ -315,7 +315,7 @@ direct children of this heading."
org-odd-levels-only
tr-org-odd-levels-only)))
(goto-char (point-min))
- (org-show-all '(headings blocks))
+ (org-fold-show-all '(headings blocks))
(if (and heading (not (and datetree-date (not datetree-subheading-p))))
(progn
(if (re-search-forward
@@ -330,7 +330,7 @@ direct children of this heading."
(insert (if datetree-date "" "\n") heading "\n")
(end-of-line 0))
;; Make the subtree visible
- (outline-show-subtree)
+ (org-fold-show-subtree)
(if org-archive-reversed-order
(progn
(org-back-to-heading t)
@@ -408,7 +408,7 @@ direct children of this heading."
(if (eq this-buffer buffer)
(concat "under heading: " heading)
(concat "in file: " (abbreviate-file-name afile)))))))
- (org-reveal)
+ (org-fold-reveal)
(if (looking-at "^[ \t]*$")
(outline-next-visible-heading 1))))
@@ -478,13 +478,13 @@ Archiving time is retained in the ARCHIVE_TIME node property."
(format-time-string
(substring (cdr org-time-stamp-formats) 1 -1)))
(outline-up-heading 1 t)
- (org-flag-subtree t)
+ (org-fold-subtree t)
(org-cycle-show-empty-lines 'folded)
(when org-provide-todo-statistics
;; Update TODO statistics of parent.
(org-update-parent-todo-statistics))
(goto-char pos)))
- (org-reveal)
+ (org-fold-reveal)
(if (looking-at "^[ \t]*$")
(outline-next-visible-heading 1))))
@@ -593,7 +593,7 @@ the children that do not contain any open TODO items."
(save-excursion
(org-back-to-heading t)
(setq set (org-toggle-tag org-archive-tag))
- (when set (org-flag-subtree t)))
+ (when set (org-fold-subtree t)))
(and set (beginning-of-line 1))
(message "Subtree %s" (if set "archived" "unarchived"))))))
diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index d73e927fc..37402bf88 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -1121,7 +1121,7 @@ may have been stored before."
(org-switch-to-buffer-other-window
(org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE"))
(widen)
- (org-show-all)
+ (org-fold-show-all)
(goto-char (org-capture-get :pos))
(setq-local outline-level 'org-outline-level)
(pcase (org-capture-get :type)
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index 9efd99be8..4c368539d 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -1025,7 +1025,7 @@ CLOCK is a cons cell of the form (MARKER START-TIME)."
(let ((element (org-element-at-point)))
(when (eq (org-element-type element) 'drawer)
(when (> (org-element-property :end element) (car clock))
- (org-hide-drawer-toggle 'off nil element))
+ (org-fold-hide-drawer-toggle 'off nil element))
(throw 'exit nil)))))))))))
(defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly)
@@ -1581,8 +1581,8 @@ line and position cursor in that line."
(let ((beg (point)))
(insert ":" drawer ":\n:END:\n")
(org-indent-region beg (point))
- (org-flag-region
- (line-end-position -1) (1- (point)) t 'outline)
+ (org-fold-region
+ (line-end-position -1) (1- (point)) t (org-fold-get-folding-spec-for-element 'headline))
(forward-line -1))))
;; When a clock drawer needs to be created because of the
;; number of clock items or simply if it is missing, collect
@@ -1607,7 +1607,7 @@ line and position cursor in that line."
(let ((end (point-marker)))
(goto-char beg)
(save-excursion (insert ":" drawer ":\n"))
- (org-flag-region (line-end-position) (1- end) t 'outline)
+ (org-fold-region (line-end-position) (1- end) t (org-fold-get-folding-spec-for-element 'headline))
(org-indent-region (point) end)
(forward-line)
(unless org-log-states-order-reversed
@@ -1834,10 +1834,10 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
(pop-to-buffer-same-window (marker-buffer m))
(if (or (< m (point-min)) (> m (point-max))) (widen))
(goto-char m)
- (org-show-entry)
+ (org-fold-show-entry)
(org-back-to-heading t)
(recenter org-clock-goto-before-context)
- (org-reveal)
+ (org-fold-reveal)
(if recent
(message "No running clock, this is the most recently clocked task"))
(run-hooks 'org-clock-goto-hook)))
@@ -2131,7 +2131,7 @@ in the buffer and update it."
(org-clock-remove-overlays)
(when arg
(org-find-dblock "clocktable")
- (org-show-entry))
+ (org-fold-show-entry))
(pcase (org-in-clocktable-p)
(`nil
(org-create-dblock
@@ -3100,7 +3100,7 @@ The details of what will be saved are regulated by the variable
(let ((org-clock-in-resume 'auto-restart)
(org-clock-auto-clock-resolution nil))
(org-clock-in)
- (when (org-invisible-p) (org-show-context))))))
+ (when (org-invisible-p) (org-fold-show-context))))))
(_ nil)))))
;; Suggested bindings
diff --git a/lisp/org-colview.el b/lisp/org-colview.el
index e50a4d7c8..357de7573 100644
--- a/lisp/org-colview.el
+++ b/lisp/org-colview.el
@@ -699,7 +699,7 @@ FUN is a function called with no argument."
(move-beginning-of-line 2)
(org-at-heading-p t)))))
(unwind-protect (funcall fun)
- (when hide-body (outline-hide-entry)))))
+ (when hide-body (org-fold-hide-entry)))))
(defun org-columns-previous-allowed-value ()
"Switch to the previous allowed value for this column."
diff --git a/lisp/org-compat.el b/lisp/org-compat.el
index 4cd7b817a..bef70c34f 100644
--- a/lisp/org-compat.el
+++ b/lisp/org-compat.el
@@ -46,14 +46,14 @@
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment))
(declare-function org-get-tags "org" (&optional pos local))
-(declare-function org-hide-block-toggle "org" (&optional force no-error element))
+(declare-function org-fold-hide-block-toggle "org-fold" (&optional force no-error element))
(declare-function org-link-display-format "ol" (s))
(declare-function org-link-set-parameters "ol" (type &rest rest))
(declare-function org-log-into-drawer "org" ())
(declare-function org-make-tag-string "org" (tags))
(declare-function org-reduced-level "org" (l))
(declare-function org-return "org" (&optional indent arg interactive))
-(declare-function org-show-context "org" (&optional key))
+(declare-function org-fold-show-context "org-fold" (&optional key))
(declare-function org-table-end "org-table" (&optional table-type))
(declare-function outline-next-heading "outline" ())
(declare-function speedbar-line-directory "speedbar" (&optional depth))
@@ -146,12 +146,8 @@ This is a floating point number if the size is too large for an integer."
;;; Emacs < 25.1 compatibility
(when (< emacs-major-version 25)
- (defalias 'outline-hide-entry 'hide-entry)
- (defalias 'outline-hide-sublevels 'hide-sublevels)
- (defalias 'outline-hide-subtree 'hide-subtree)
(defalias 'outline-show-branches 'show-branches)
(defalias 'outline-show-children 'show-children)
- (defalias 'outline-show-entry 'show-entry)
(defalias 'outline-show-subtree 'show-subtree)
(defalias 'xref-find-definitions 'find-tag)
(defalias 'format-message 'format)
@@ -227,6 +223,12 @@ Case is significant."
(define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "Org 9.0")
(define-obsolete-function-alias 'org-file-remote-p 'file-remote-p "Org 9.2")
+(define-obsolete-function-alias 'org-reveal 'org-fold-reveal "Org 9.4")
+(define-obsolete-function-alias 'org-show-context 'org-fold-show-context "Org 9.4")
+(define-obsolete-function-alias 'org-show-entry 'org-fold-show-entry "Org 9.4")
+(define-obsolete-function-alias 'org-show-children 'org-fold-show-children "Org 9.4")
+
+
(defmacro org-re (s)
"Replace posix classes in regular expression S."
(declare (debug (form))
@@ -328,11 +330,74 @@ Counting starts at 1."
(define-obsolete-function-alias 'org-remove-latex-fragment-image-overlays
'org-clear-latex-preview "Org 9.3")
+(define-obsolete-function-alias 'org-hide-archived-subtrees
+ 'org-fold-hide-archived-subtrees "Org 9.4")
+
+(define-obsolete-function-alias 'org-flag-subtree
+ 'org-fold-subtree "Org 9.4")
+
+(define-obsolete-function-alias 'org-hide-entry
+ 'org-fold-hide-entry "Org 9.4")
+
+(define-obsolete-function-alias 'org-show-subtree
+ 'org-fold-show-subtree "Org 9.4")
+
+(define-obsolete-function-alias 'org--hide-wrapper-toggle
+ 'org-fold--hide-wrapper-toggle "Org 9.4")
+
+(define-obsolete-function-alias 'org-hide-block-toggle
+ 'org-fold-hide-block-toggle "Org 9.4")
+
+(define-obsolete-function-alias 'org-hide-drawer-toggle
+ 'org-fold-hide-drawer-toggle "Org 9.4")
+
+(define-obsolete-function-alias 'org-hide-block-all
+ 'org-fold-hide-block-all "Org 9.4")
+
+(define-obsolete-function-alias 'org-hide-drawer-all
+ 'org-fold-hide-drawer-all "Org 9.4")
+
+(define-obsolete-function-alias 'org-show-all
+ 'org-fold-show-all "Org 9.4")
+
+(define-obsolete-function-alias 'org-set-startup-visibility
+ 'org-cycle-set-startup-visibility "Org 9.4")
+
+(define-obsolete-function-alias 'org-show-set-visibility
+ 'org-fold-show-set-visibility "Org 9.4")
+
+(define-obsolete-function-alias 'org-check-before-invisible-edit
+ 'org-fold-check-before-invisible-edit "Org 9.4")
+
+(define-obsolete-function-alias 'org-flag-above-first-heading
+ 'org-fold-flag-above-first-heading "Org 9.4")
+
+(define-obsolete-function-alias 'org-show-branches-buffer
+ 'org-fold-show-branches-buffer "Org 9.4")
+
+(define-obsolete-function-alias 'org-show-siblings
+ 'org-fold-show-siblings "Org 9.4")
+
+(define-obsolete-function-alias 'org-show-hidden-entry
+ 'org-fold-show-hidden-entry "Org 9.4")
+
+(define-obsolete-function-alias 'org-flag-heading
+ 'org-fold-heading "Org 9.4")
+
(define-obsolete-variable-alias 'org-attach-directory
'org-attach-id-dir "Org 9.3")
(make-obsolete 'org-attach-store-link "No longer used" "Org 9.4")
(make-obsolete 'org-attach-expand-link "No longer used" "Org 9.4")
+(define-obsolete-variable-alias 'org-show-context-detail
+ 'org-fold-show-context-detail "Org 9.4")
+
+(define-obsolete-variable-alias 'org-catch-invisible-edits
+ 'org-fold-catch-invisible-edits "Org 9.4")
+
+(define-obsolete-variable-alias 'org-reveal-start-hook
+ 'org-fold-reveal-start-hook "Org 9.4")
+
(defun org-in-fixed-width-region-p ()
"Non-nil if point in a fixed-width region."
(save-match-data
@@ -609,7 +674,7 @@ use of this function is for the stuck project list."
(defun org-show-block-all ()
"Unfold all blocks in the current buffer."
(interactive)
- (remove-overlays nil nil 'invisible 'org-hide-block))
+ (org-fold-show-all '(blocks)))
(make-obsolete 'org-show-block-all
"use `org-show-all' instead."
@@ -652,7 +717,7 @@ When optional argument ELEMENT is a parsed drawer, as returned by
When buffer positions BEG and END are provided, hide or show that
region as a drawer without further ado."
(declare (obsolete "use `org-hide-drawer-toggle' instead." "Org 9.4"))
- (if (and beg end) (org-flag-region beg end flag 'outline)
+ (if (and beg end) (org-fold-region beg end flag (org-fold-get-folding-spec-for-element 'drawer))
(let ((drawer
(or element
(and (save-excursion
@@ -661,12 +726,12 @@ region as a drawer without further ado."
(org-element-at-point)))))
(when (memq (org-element-type drawer) '(drawer property-drawer))
(let ((post (org-element-property :post-affiliated drawer)))
- (org-flag-region
+ (org-fold-region
(save-excursion (goto-char post) (line-end-position))
(save-excursion (goto-char (org-element-property :end drawer))
(skip-chars-backward " \t\n")
(line-end-position))
- flag 'outline)
+ flag (org-fold-get-folding-spec-for-element 'drawer))
;; When the drawer is hidden away, make sure point lies in
;; a visible part of the buffer.
(when (invisible-p (max (1- (point)) (point-min)))
@@ -678,7 +743,7 @@ Unlike to `org-hide-block-toggle', this function does not throw
an error. Return a non-nil value when toggling is successful."
(declare (obsolete "use `org-hide-block-toggle' instead." "Org 9.4"))
(interactive)
- (org-hide-block-toggle nil t))
+ (org-fold-hide-block-toggle nil t))
(defun org-hide-block-toggle-all ()
"Toggle the visibility of all blocks in the current buffer."
@@ -694,7 +759,7 @@ an error. Return a non-nil value when toggling is successful."
(save-excursion
(save-match-data
(goto-char (match-beginning 0))
- (org-hide-block-toggle)))))))
+ (org-fold-hide-block-toggle)))))))
(defun org-return-indent ()
"Goto next table row or insert a newline and indent.
@@ -919,7 +984,7 @@ This also applied for speedbar access."
(add-hook 'imenu-after-jump-hook
(lambda ()
(when (derived-mode-p 'org-mode)
- (org-show-context 'org-goto))))
+ (org-fold-show-context 'org-goto))))
(add-hook 'org-mode-hook
(lambda ()
(setq imenu-create-index-function 'org-imenu-get-tree)))))
@@ -984,7 +1049,7 @@ To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'."
(define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock)
(define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
(add-hook 'speedbar-visiting-tag-hook
- (lambda () (and (derived-mode-p 'org-mode) (org-show-context 'org-goto))))))
+ (lambda () (and (derived-mode-p 'org-mode) (org-fold-show-context 'org-goto))))))
;;;; Add Log
@@ -1097,7 +1162,7 @@ ELEMENT is the element at point."
(or (org-invisible-p)
(save-excursion (goto-char (max (point-min) (1- (point))))
(org-invisible-p)))
- (org-show-context 'bookmark-jump)))
+ (org-fold-show-context 'bookmark-jump)))
;; Make `bookmark-jump' shows the jump location if it was hidden.
(eval-after-load "bookmark"
@@ -1172,7 +1237,7 @@ key."
'(defadvice ecb-method-clicked (after esf/org-show-context activate)
"Make hierarchy visible when jumping into location from ECB tree buffer."
(when (derived-mode-p 'org-mode)
- (org-show-context))))
+ (org-fold-show-context))))
;;;; Simple
@@ -1180,7 +1245,7 @@ key."
"Make the point visible with `org-show-context' after jumping to the mark."
(when (and (derived-mode-p 'org-mode)
(org-invisible-p))
- (org-show-context 'mark-goto)))
+ (org-fold-show-context 'mark-goto)))
(eval-after-load "simple"
'(defadvice pop-to-mark-command (after org-make-visible activate)
diff --git a/lisp/org-crypt.el b/lisp/org-crypt.el
index 187560c55..26dd8cd49 100644
--- a/lisp/org-crypt.el
+++ b/lisp/org-crypt.el
@@ -311,7 +311,7 @@ Assume `epg-context' is set."
'org-mode-hook
(lambda () (add-hook 'before-save-hook 'org-encrypt-entries nil t))))
-(add-hook 'org-reveal-start-hook 'org-decrypt-entry)
+(add-hook 'org-fold-reveal-start-hook 'org-decrypt-entry)
(provide 'org-crypt)
diff --git a/lisp/org-cycle.el b/lisp/org-cycle.el
new file mode 100644
index 000000000..e0b1a39dc
--- /dev/null
+++ b/lisp/org-cycle.el
@@ -0,0 +1,554 @@
+;;; org-cycle.el --- Visibility cycling of Org entries -*- lexical-binding: t; -*-
+;;
+;; Copyright (C) 2020-2020 Free Software Foundation, Inc.
+;;
+;; Author: ??
+;; Keywords: folding, visibility cycling, invisible text
+;; Homepage: https://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains code controlling global folding state in buffer
+;; and TAB-cycling.
+
+;;; Code:
+
+(require 'org-macs)
+(require 'org-fold)
+
+(declare-function org-element-type "org-element" (element))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-lineage "org-element" (datum &optional types with-self))
+(declare-function org-inlinetask-at-task-p "org-inlinetask" ())
+(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ())
+
+(defvar-local org-cycle-global-status nil)
+(put 'org-cycle-global-status 'org-state t)
+(defvar-local org-cycle-subtree-status nil)
+(put 'org-cycle-subtree-status 'org-state t)
+
+(defun org-cycle-hide-drawers (state)
+ "Re-hide all drawers after a visibility state change.
+STATE should be one of the symbols listed in the docstring of
+`org-cycle-hook'."
+ (when (and (derived-mode-p 'org-mode)
+ (not (memq state '(overview folded contents))))
+ (let* ((global? (eq state 'all))
+ (beg (if global? (point-min) (line-beginning-position)))
+ (end (cond (global? (point-max))
+ ((eq state 'children) (org-entry-end-position))
+ (t (save-excursion (org-end-of-subtree t t))))))
+ (save-excursion
+ (goto-char beg)
+ (while (re-search-forward org-drawer-regexp end t)
+ (if (org-fold-get-folding-spec (org-fold-get-folding-spec-for-element 'drawer))
+ ;; Do not fold already folded drawers.
+ (goto-char (min end (org-fold-next-folding-state-change (org-fold-get-folding-spec-for-element 'drawer))))
+ (let ((drawer (org-element-at-point)))
+ (when (memq (org-element-type drawer) '(drawer property-drawer))
+ (org-fold-hide-drawer-toggle t nil drawer)
+ ;; Make sure to skip drawer entirely or we might flag
+ ;; it another time when matching its ending line with
+ ;; `org-drawer-regexp'.
+ (goto-char (org-element-property :end drawer))))))))))
+
+;;;###autoload
+(defun org-cycle (&optional arg)
+ "TAB-action and visibility cycling for Org mode.
+
+This is the command invoked in Org mode by the `TAB' key. Its main
+purpose is outline visibility cycling, but it also invokes other actions
+in special contexts.
+
+When this function is called with a `\\[universal-argument]' prefix, rotate \
+the entire
+buffer through 3 states (global cycling)
+ 1. OVERVIEW: Show only top-level headlines.
+ 2. CONTENTS: Show all headlines of all levels, but no body text.
+ 3. SHOW ALL: Show everything.
+
+With a `\\[universal-argument] \\[universal-argument]' prefix argument, \
+switch to the startup visibility,
+determined by the variable `org-startup-folded', and by any VISIBILITY
+properties in the buffer.
+
+With a `\\[universal-argument] \\[universal-argument] \
+\\[universal-argument]' prefix argument, show the entire buffer, including
+any drawers.
+
+When inside a table, re-align the table and move to the next field.
+
+When point is at the beginning of a headline, rotate the subtree started
+by this line through 3 different states (local cycling)
+ 1. FOLDED: Only the main headline is shown.
+ 2. CHILDREN: The main headline and the direct children are shown.
+ From this state, you can move to one of the children
+ and zoom in further.
+ 3. SUBTREE: Show the entire subtree, including body text.
+If there is no subtree, switch directly from CHILDREN to FOLDED.
+
+When point is at the beginning of an empty headline and the variable
+`org-cycle-level-after-item/entry-creation' is set, cycle the level
+of the headline by demoting and promoting it to likely levels. This
+speeds up creation document structure by pressing `TAB' once or several
+times right after creating a new headline.
+
+When there is a numeric prefix, go up to a heading with level ARG, do
+a `show-subtree' and return to the previous cursor position. If ARG
+is negative, go up that many levels.
+
+When point is not at the beginning of a headline, execute the global
+binding for `TAB', which is re-indenting the line. See the option
+`org-cycle-emulate-tab' for details.
+
+As a special case, if point is at the very beginning of the buffer, if
+there is no headline there, and if the variable `org-cycle-global-at-bob'
+is non-nil, this function acts as if called with prefix argument \
+\(`\\[universal-argument] TAB',
+same as `S-TAB') also when called without prefix argument."
+ (interactive "P")
+ (org-load-modules-maybe)
+ (unless (or (run-hook-with-args-until-success 'org-tab-first-hook)
+ (and org-cycle-level-after-item/entry-creation
+ (or (org-cycle-level)
+ (org-cycle-item-indentation))))
+ (let* ((limit-level
+ (or org-cycle-max-level
+ (and (boundp 'org-inlinetask-min-level)
+ org-inlinetask-min-level
+ (1- org-inlinetask-min-level))))
+ (nstars
+ (and limit-level
+ (if org-odd-levels-only
+ (1- (* 2 limit-level))
+ limit-level)))
+ (org-outline-regexp
+ (format "\\*%s " (if nstars (format "\\{1,%d\\}" nstars) "+"))))
+ (cond
+ ((equal arg '(16))
+ (setq last-command 'dummy)
+ (org-cycle-set-startup-visibility)
+ (org-unlogged-message "Startup visibility, plus VISIBILITY properties"))
+ ((equal arg '(64))
+ (org-fold-show-all)
+ (org-unlogged-message "Entire buffer visible, including drawers"))
+ ((equal arg '(4)) (org-cycle-internal-global))
+ ;; Show-subtree, ARG levels up from here.
+ ((integerp arg)
+ (save-excursion
+ (org-back-to-heading)
+ (outline-up-heading (if (< arg 0) (- arg)
+ (- (funcall outline-level) arg)))
+ (org-fold-show-subtree)))
+ ;; Global cycling at BOB: delegate to `org-cycle-internal-global'.
+ ((and org-cycle-global-at-bob
+ (bobp)
+ (not (looking-at org-outline-regexp)))
+ (let ((org-cycle-hook
+ (remq 'org-optimize-window-after-visibility-change
+ org-cycle-hook)))
+ (org-cycle-internal-global)))
+ ;; Try CDLaTeX TAB completion.
+ ((org-try-cdlatex-tab))
+ ;; Inline task: delegate to `org-inlinetask-toggle-visibility'.
+ ((and (featurep 'org-inlinetask)
+ (org-inlinetask-at-task-p)
+ (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
+ (org-inlinetask-toggle-visibility))
+ (t
+ (let ((pos (point))
+ (element (org-element-at-point)))
+ (cond
+ ;; Try toggling visibility for block at point.
+ ((org-fold-hide-block-toggle nil t element))
+ ;; Try toggling visibility for drawer at point.
+ ((org-fold-hide-drawer-toggle nil t element))
+ ;; Table: enter it or move to the next field.
+ ((and (org-match-line "[ \t]*[|+]")
+ (org-element-lineage element '(table) t))
+ (if (and (eq 'table (org-element-type element))
+ (eq 'table.el (org-element-property :type element)))
+ (message (substitute-command-keys "\\<org-mode-map>\
+Use `\\[org-edit-special]' to edit table.el tables"))
+ (org-table-justify-field-maybe)
+ (call-interactively #'org-table-next-field)))
+ ((run-hook-with-args-until-success
+ 'org-tab-after-check-for-table-hook))
+ ;; At an item/headline: delegate to `org-cycle-internal-local'.
+ ((and (or (and org-cycle-include-plain-lists
+ (let ((item (org-element-lineage element
+ '(item plain-list)
+ t)))
+ (and item
+ (= (line-beginning-position)
+ (org-element-property :post-affiliated
+ item)))))
+ (org-match-line org-outline-regexp))
+ (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
+ (org-cycle-internal-local))
+ ;; From there: TAB emulation and template completion.
+ (buffer-read-only (org-back-to-heading))
+ ((run-hook-with-args-until-success
+ 'org-tab-after-check-for-cycling-hook))
+ ((run-hook-with-args-until-success
+ 'org-tab-before-tab-emulation-hook))
+ ((and (eq org-cycle-emulate-tab 'exc-hl-bol)
+ (or (not (bolp))
+ (not (looking-at org-outline-regexp))))
+ (call-interactively (global-key-binding (kbd "TAB"))))
+ ((or (eq org-cycle-emulate-tab t)
+ (and (memq org-cycle-emulate-tab '(white whitestart))
+ (save-excursion (beginning-of-line 1) (looking-at "[ \t]*"))
+ (or (and (eq org-cycle-emulate-tab 'white)
+ (= (match-end 0) (point-at-eol)))
+ (and (eq org-cycle-emulate-tab 'whitestart)
+ (>= (match-end 0) pos)))))
+ (call-interactively (global-key-binding (kbd "TAB"))))
+ (t
+ (save-excursion
+ (org-back-to-heading)
+ (org-cycle))))))))))
+
+(defun org-cycle-internal-global ()
+ "Do the global cycling action."
+ ;; Hack to avoid display of messages for .org attachments in Gnus
+ (let ((ga (string-match-p "\\*fontification" (buffer-name))))
+ (cond
+ ((and (eq last-command this-command)
+ (eq org-cycle-global-status 'overview))
+ ;; We just created the overview - now do table of contents
+ ;; This can be slow in very large buffers, so indicate action
+ (run-hook-with-args 'org-pre-cycle-hook 'contents)
+ (unless ga (org-unlogged-message "CONTENTS..."))
+ (org-content)
+ (unless ga (org-unlogged-message "CONTENTS...done"))
+ (setq org-cycle-global-status 'contents)
+ (run-hook-with-args 'org-cycle-hook 'contents))
+
+ ((and (eq last-command this-command)
+ (eq org-cycle-global-status 'contents))
+ ;; We just showed the table of contents - now show everything
+ (run-hook-with-args 'org-pre-cycle-hook 'all)
+ (org-fold-show-all '(headings blocks))
+ (unless ga (org-unlogged-message "SHOW ALL"))
+ (setq org-cycle-global-status 'all)
+ (run-hook-with-args 'org-cycle-hook 'all))
+
+ (t
+ ;; Default action: go to overview
+ (run-hook-with-args 'org-pre-cycle-hook 'overview)
+ (org-overview)
+ (unless ga (org-unlogged-message "OVERVIEW"))
+ (setq org-cycle-global-status 'overview)
+ (run-hook-with-args 'org-cycle-hook 'overview)))))
+
+(defun org-cycle-internal-local ()
+ "Do the local cycling action."
+ (let ((goal-column 0) eoh eol eos has-children children-skipped struct)
+ ;; First, determine end of headline (EOH), end of subtree or item
+ ;; (EOS), and if item or heading has children (HAS-CHILDREN).
+ (save-excursion
+ (if (org-at-item-p)
+ (progn
+ (beginning-of-line)
+ (setq struct (org-list-struct))
+ (setq eoh (point-at-eol))
+ (setq eos (org-list-get-item-end-before-blank (point) struct))
+ (setq has-children (org-list-has-child-p (point) struct)))
+ (org-back-to-heading)
+ (setq eoh (save-excursion (outline-end-of-heading) (point)))
+ (setq eos (save-excursion
+ (org-end-of-subtree t t)
+ (unless (eobp) (forward-char -1))
+ (point)))
+ (setq has-children
+ (or
+ (save-excursion
+ (let ((level (funcall outline-level)))
+ (outline-next-heading)
+ (and (org-at-heading-p t)
+ (> (funcall outline-level) level))))
+ (and (eq org-cycle-include-plain-lists 'integrate)
+ (save-excursion
+ (org-list-search-forward (org-item-beginning-re) eos t))))))
+ ;; Determine end invisible part of buffer (EOL)
+ (beginning-of-line 2)
+ (while (and (not (eobp)) ;this is like `next-line'
+ (org-fold-get-folding-spec nil (1- (point))))
+ (goto-char (org-fold-next-visibility-change (point)))
+ (and (eolp) (beginning-of-line 2)))
+ (setq eol (point)))
+ ;; Find out what to do next and set `this-command'
+ (cond
+ ((= eos eoh)
+ ;; Nothing is hidden behind this heading
+ (unless (org-before-first-heading-p)
+ (run-hook-with-args 'org-pre-cycle-hook 'empty))
+ (org-unlogged-message "EMPTY ENTRY")
+ (setq org-cycle-subtree-status nil)
+ (save-excursion
+ (goto-char eos)
+ (org-with-limited-levels
+ (outline-next-heading))
+ (when (org-invisible-p) (org-fold-heading nil))))
+ ((and (>= eol eos)
+ (or has-children
+ (not (setq children-skipped
+ org-cycle-skip-children-state-if-no-children))))
+ ;; Entire subtree is hidden in one line: children view
+ (unless (org-before-first-heading-p)
+ (run-hook-with-args 'org-pre-cycle-hook 'children))
+ (if (org-at-item-p)
+ (org-list-set-item-visibility (point-at-bol) struct 'children)
+ (org-fold-show-entry)
+ (org-with-limited-levels (org-fold-show-children))
+ (org-fold-show-set-visibility 'canonical)
+ ;; Fold every list in subtree to top-level items.
+ (when (eq org-cycle-include-plain-lists 'integrate)
+ (save-excursion
+ (org-back-to-heading)
+ (while (org-list-search-forward (org-item-beginning-re) eos t)
+ (beginning-of-line 1)
+ (let* ((struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct))
+ (end (org-list-get-bottom-point struct)))
+ (dolist (e (org-list-get-all-items (point) struct prevs))
+ (org-list-set-item-visibility e struct 'folded))
+ (goto-char (if (< end eos) end eos)))))))
+ (org-unlogged-message "CHILDREN")
+ (save-excursion
+ (goto-char eos)
+ (org-with-limited-levels
+ (outline-next-heading))
+ (when (org-invisible-p) (org-fold-heading nil)))
+ (setq org-cycle-subtree-status 'children)
+ (unless (org-before-first-heading-p)
+ (run-hook-with-args 'org-cycle-hook 'children)))
+ ((or children-skipped
+ (and (eq last-command this-command)
+ (eq org-cycle-subtree-status 'children)))
+ ;; We just showed the children, or no children are there,
+ ;; now show everything.
+ (unless (org-before-first-heading-p)
+ (run-hook-with-args 'org-pre-cycle-hook 'subtree))
+ (org-fold-region eoh eos nil (org-fold-get-folding-spec-for-element 'headline))
+ (org-unlogged-message
+ (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE"))
+ (setq org-cycle-subtree-status 'subtree)
+ (unless (org-before-first-heading-p)
+ (run-hook-with-args 'org-cycle-hook 'subtree)))
+ (t
+ ;; Default action: hide the subtree.
+ (run-hook-with-args 'org-pre-cycle-hook 'folded)
+ (org-fold-region eoh eos t (org-fold-get-folding-spec-for-element 'headline))
+ (org-unlogged-message "FOLDED")
+ (setq org-cycle-subtree-status 'folded)
+ (unless (org-before-first-heading-p)
+ (run-hook-with-args 'org-cycle-hook 'folded))))))
+
+;;;###autoload
+(defun org-global-cycle (&optional arg)
+ "Cycle the global visibility. For details see `org-cycle'.
+With `\\[universal-argument]' prefix ARG, switch to startup visibility.
+With a numeric prefix, show all headlines up to that level."
+ (interactive "P")
+ (cond
+ ((integerp arg)
+ (org-content arg)
+ (setq org-cycle-global-status 'contents))
+ ((equal arg '(4))
+ (org-cycle-set-startup-visibility)
+ (org-unlogged-message "Startup visibility, plus VISIBILITY properties."))
+ (t
+ (org-cycle '(4)))))
+
+(defun org-cycle-set-startup-visibility ()
+ "Set the visibility required by startup options and properties."
+ (cond
+ ((eq org-startup-folded t)
+ (org-overview))
+ ((eq org-startup-folded 'content)
+ (org-content))
+ ((or (eq org-startup-folded 'showeverything)
+ (eq org-startup-folded nil))
+ (org-fold-show-all)))
+ (unless (eq org-startup-folded 'showeverything)
+ (when org-hide-block-startup (org-fold-hide-block-all))
+ (org-set-visibility-according-to-property)
+ (org-cycle-hide-archived-subtrees 'all)
+ (org-cycle-hide-drawers 'all)
+ (org-cycle-show-empty-lines t)))
+
+(defun org-set-visibility-according-to-property ()
+ "Switch subtree visibility according to VISIBILITY property."
+ (interactive)
+ (let ((regexp (org-re-property "VISIBILITY")))
+ (org-with-point-at 1
+ (while (re-search-forward regexp nil t)
+ (let ((state (match-string 3)))
+ (if (not (org-at-property-p)) (outline-next-heading)
+ (save-excursion
+ (org-back-to-heading t)
+ (org-fold-subtree t)
+ (org-fold-reveal)
+ (pcase state
+ ("folded"
+ (org-fold-subtree t))
+ ("children"
+ (org-fold-show-hidden-entry)
+ (org-fold-show-children))
+ ("content"
+ (save-excursion
+ (save-restriction
+ (org-narrow-to-subtree)
+ (org-content))))
+ ((or "all" "showall")
+ (org-fold-show-subtree))
+ (_ nil)))
+ (org-end-of-subtree)))))))
+
+(defun org-overview ()
+ "Switch to overview mode, showing only top-level headlines."
+ (interactive)
+ (org-fold-show-all '(headings drawers))
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward org-outline-regexp-bol nil t)
+ (let* ((last (line-end-position))
+ (level (- (match-end 0) (match-beginning 0) 1))
+ (regexp (format "^\\*\\{1,%d\\} " level)))
+ (while (re-search-forward regexp nil :move)
+ (org-fold-region last (line-end-position 0) t (org-fold-get-folding-spec-for-element 'headline))
+ (setq last (line-end-position))
+ (setq level (- (match-end 0) (match-beginning 0) 1))
+ (setq regexp (format "^\\*\\{1,%d\\} " level)))
+ (org-fold-region last (point) t (org-fold-get-folding-spec-for-element 'headline))))))
+
+(defun org-content (&optional arg)
+ "Show all headlines in the buffer, like a table of contents.
+With numerical argument N, show content up to level N."
+ (interactive "p")
+ (org-fold-show-all '(headings drawers))
+ (save-excursion
+ (goto-char (point-max))
+ (let ((regexp (if (and (wholenump arg) (> arg 0))
+ (format "^\\*\\{1,%d\\} " arg)
+ "^\\*+ "))
+ (last (point)))
+ (while (re-search-backward regexp nil t)
+ (org-fold-region (line-end-position) last t (org-fold-get-folding-spec-for-element 'headline))
+ (setq last (line-end-position 0))))))
+
+(defvar org-scroll-position-to-restore nil
+ "Temporarily store scroll position to restore.")
+(defun org-optimize-window-after-visibility-change (state)
+ "Adjust the window after a change in outline visibility.
+This function is the default value of the hook `org-cycle-hook'."
+ (when (get-buffer-window (current-buffer))
+ (cond
+ ((eq state 'content) nil)
+ ((eq state 'all) nil)
+ ((and (eq state 'folded) (eq last-command this-command))
+ (set-window-start nil org-scroll-position-to-restore))
+ ((eq state 'folded) nil)
+ ((eq state 'children)
+ (setq org-scroll-position-to-restore (window-start))
+ (or (org-subtree-end-visible-p) (recenter 1)))
+ ((eq state 'subtree)
+ (when (not (eq last-command this-command))
+ (setq org-scroll-position-to-restore (window-start)))
+ (or (org-subtree-end-visible-p) (recenter 1))))))
+
+(defun org-clean-visibility-after-subtree-move ()
+ "Fix visibility issues after moving a subtree."
+ ;; First, find a reasonable region to look at:
+ ;; Start two siblings above, end three below
+ (let* ((beg (save-excursion
+ (and (org-get-last-sibling)
+ (org-get-last-sibling))
+ (point)))
+ (end (save-excursion
+ (and (org-get-next-sibling)
+ (org-get-next-sibling)
+ (org-get-next-sibling))
+ (if (org-at-heading-p)
+ (point-at-eol)
+ (point))))
+ (level (looking-at "\\*+"))
+ (re (when level (concat "^" (regexp-quote (match-string 0)) " "))))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (when re
+ ;; Properly fold already folded siblings
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (when (and (not (org-invisible-p))
+ (org-invisible-p (line-end-position)))
+ (org-fold-hide-entry))))
+ (org-cycle-hide-drawers 'all)
+ (org-cycle-show-empty-lines 'overview)))))
+
+(defun org-cycle-show-empty-lines (state)
+ "Show empty lines above all visible headlines.
+The region to be covered depends on STATE when called through
+`org-cycle-hook'. Lisp program can use t for STATE to get the
+entire buffer covered. Note that an empty line is only shown if there
+are at least `org-cycle-separator-lines' empty lines before the headline."
+ (when (/= org-cycle-separator-lines 0)
+ (save-excursion
+ (let* ((n (abs org-cycle-separator-lines))
+ (re (cond
+ ((= n 1) "\\(\n[ \t]*\n\\*+\\) ")
+ ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ")
+ (t (let ((ns (number-to-string (- n 2))))
+ (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}"
+ "[ \t]*\\(\n[ \t]*\n\\*+\\) ")))))
+ beg end)
+ (cond
+ ((memq state '(overview contents t))
+ (setq beg (point-min) end (point-max)))
+ ((memq state '(children folded))
+ (setq beg (point)
+ end (progn (org-end-of-subtree t t)
+ (line-beginning-position 2)))))
+ (when beg
+ (goto-char beg)
+ (while (re-search-forward re end t)
+ (unless (org-invisible-p (match-end 1))
+ (let ((e (match-end 1))
+ (b (if (>= org-cycle-separator-lines 0)
+ (match-beginning 1)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (skip-chars-backward " \t\n")
+ (line-end-position)))))
+ (org-fold-region b e nil (org-fold-get-folding-spec-for-element 'headline)))))))))
+ ;; Never hide empty lines at the end of the file.
+ (save-excursion
+ (goto-char (point-max))
+ (outline-previous-heading)
+ (outline-end-of-heading)
+ (when (and (looking-at "[ \t\n]+")
+ (= (match-end 0) (point-max)))
+ (org-fold-region (point) (match-end 0) nil (org-fold-get-folding-spec-for-element 'headline)))))
+
+(provide 'org-cycle)
+
+;;; org-cycle.el ends here
diff --git a/lisp/org-element.el b/lisp/org-element.el
index 755de8661..cf4493092 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -5465,8 +5465,9 @@ the process stopped before finding the expected result."
;; There's a headline between cached value and POS: cached
;; value is invalid. Start parsing from first element
;; following the headline.
- ((re-search-backward
- (org-with-limited-levels org-outline-regexp-bol) begin t)
+ ((and (> (point) begin)
+ (re-search-backward
+ (org-with-limited-levels org-outline-regexp-bol) begin t))
(forward-line)
(skip-chars-forward " \r\t\n")
(beginning-of-line)
diff --git a/lisp/org-feed.el b/lisp/org-feed.el
index 58bbba7c7..23055af2e 100644
--- a/lisp/org-feed.el
+++ b/lisp/org-feed.el
@@ -347,8 +347,8 @@ it can be a list structured like an entry in `org-feed-alist'."
(setq olds (nth 2 (assoc (plist-get e :guid) old-status)))
(if (and olds
(not (string= (sha1
- (plist-get e :item-full-text))
- olds)))
+ (plist-get e :item-full-text))
+ olds)))
(push e changed))))
;; Parse the relevant entries fully
@@ -412,8 +412,8 @@ it can be a list structured like an entry in `org-feed-alist'."
;; Normalize the visibility of the inbox tree
(goto-char inbox-pos)
- (org-flag-subtree t)
- (org-show-children)
+ (org-fold-subtree t) []
+ (org-fold-show-children)
;; Hooks and messages
(when org-feed-save-after-adding (save-buffer))
diff --git a/lisp/org-fold.el b/lisp/org-fold.el
new file mode 100644
index 000000000..50b0bf5b7
--- /dev/null
+++ b/lisp/org-fold.el
@@ -0,0 +1,1334 @@
+;;; org-fold.el --- Folding of Org entries -*- lexical-binding: t; -*-
+;;
+;; Copyright (C) 2020-2020 Free Software Foundation, Inc.
+;;
+;; Author: ???
+;; Keywords: folding, invisible text
+;; Homepage: https://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains code handling temporary invisibility (folding
+;; and unfolding) of text in org buffers.
+
+;; The file implements the following functionality:
+;; - Folding/unfolding text regions and org elements
+;; - Searching and examining boundaries of folded text
+;; - Revealing text around point
+;; - Interactive searching in folded text (via isearch)
+;; - Handling edits in folded text
+
+;;; Folding/unfolding text regions and org elements
+
+;; User can temporarily fold/unfold arbitrary regions or text inside
+;; headlines, blocks, or drawers.
+
+;; Internally, different types of elements are marked with different
+;; folding specs (see `org-fold--spec-priority-list' for the list of available
+;; specs). Overlapping folds marked with the same folding spec are
+;; automatically merged, while folds with different folding specs can
+;; coexist and be folded/unfolded independently.
+
+;; By default, we define tree types of folding specs:
+;; - for headlines
+;; - for all kinds of blocks
+;; - for drawers (including property drawers)
+
+;; If necessary, one can add extra folding specs using
+;; `org-fold-add-folding-spec'.
+
+;; Because of details of implementation of the folding, it is not
+;; recommended to set text visibility in org buffer directly by
+;; setting 'invisible text property to anything other than t. While
+;; this should usually work just fine, normal org folding can be
+;; broken if one sets 'invisible text property to a value not listed
+;; in `buffer-invisibility-spec'.
+
+;;; Searching and examining boundaries of folded text
+
+;; It is possible to examine folding specs (there may be several) of
+;; text at point or search for regions with the same folding spec.
+
+;; If one wants to search invisible text without using functions
+;; defined below, it is important to keep in mind that 'invisible text
+;; property in org buffers may have multiple possible values (not just nil
+;; and t). Hence, (next-single-char-property-change pos 'invisible) is
+;; not guarantied to return the boundary of invisible/visible text.
+
+;;; Revealing text around point
+
+;; In addition to unfolding individual org elements, it is possible to
+;; unfold meaningful headline structure around point using
+;; `org-fold-show-context' and `org-fold-reveal'. There are several possible variants
+;; of structure to be revealed. See `org-fold-show-context-detail' for the
+;; details.
+
+;;; Handling edits inside invisible text
+
+;; Accidental user edits inside invisible text may easily mess up org
+;; documents. Here, we provide a framework to catch such edits and
+;; throw error if necessary. This framework is used, for example, by
+;; `org-self-insert-command' and `org-delete-backward-char', See
+;; `org-fold-catch-invisible-edits' for available customisation.
+
+;; Some edits inside folded text are not accidental and done by
+;; various Org functions. Setting scheduled time, deadlines,
+;; properties, etc often involve adding or changing text insided
+;; folded headlines or drawers. Normally, such edits do not reveal
+;; the folded text. However, the edited text is revealed when
+;; document structure is disturbed by edits. See more details in
+;; `org-fold--fix-folded-region'.
+
+;;; Code:
+
+(require 'org-macs)
+
+(defvar org-inlinetask-min-level)
+
+(declare-function isearch-filter-visible "isearch" (beg end))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-element-property "org-element" (property element))
+
+;;; Customization
+
+(defgroup org-fold-reveal-location nil
+ "Options about how to make context of a location visible."
+ :tag "Org Reveal Location"
+ :group 'org-structure)
+
+(defcustom org-show-context-detail '((agenda . local)
+ (bookmark-jump . lineage)
+ (isearch . lineage)
+ (default . ancestors))
+ "Alist between context and visibility span when revealing a location.
+
+\\<org-mode-map>Some actions may move point into invisible
+locations. As a consequence, Org always exposes a neighborhood
+around point. How much is shown depends on the initial action,
+or context. Valid contexts are
+
+ agenda when exposing an entry from the agenda
+ org-goto when using the command `org-goto' (`\\[org-goto]')
+ occur-tree when using the command `org-occur' (`\\[org-sparse-tree] /')
+ tags-tree when constructing a sparse tree based on tags matches
+ link-search when exposing search matches associated with a link
+ mark-goto when exposing the jump goal of a mark
+ bookmark-jump when exposing a bookmark location
+ isearch when exiting from an incremental search
+ default default for all contexts not set explicitly
+
+Allowed visibility spans are
+
+ minimal show current headline; if point is not on headline,
+ also show entry
+
+ local show current headline, entry and next headline
+
+ ancestors show current headline and its direct ancestors; if
+ point is not on headline, also show entry
+
+ lineage show current headline, its direct ancestors and all
+ their children; if point is not on headline, also show
+ entry and first child
+
+ tree show current headline, its direct ancestors and all
+ their children; if point is not on headline, also show
+ entry and all children
+
+ canonical show current headline, its direct ancestors along with
+ their entries and children; if point is not located on
+ the headline, also show current entry and all children
+
+As special cases, a nil or t value means show all contexts in
+`minimal' or `canonical' view, respectively.
+
+Some views can make displayed information very compact, but also
+make it harder to edit the location of the match. In such
+a case, use the command `org-fold-reveal' (`\\[org-fold-reveal]') to show
+more context."
+ :group 'org-fold-reveal-location
+ :version "26.1"
+ :package-version '(Org . "9.0")
+ :type '(choice
+ (const :tag "Canonical" t)
+ (const :tag "Minimal" nil)
+ (repeat :greedy t :tag "Individual contexts"
+ (cons
+ (choice :tag "Context"
+ (const agenda)
+ (const org-goto)
+ (const occur-tree)
+ (const tags-tree)
+ (const link-search)
+ (const mark-goto)
+ (const bookmark-jump)
+ (const isearch)
+ (const default))
+ (choice :tag "Detail level"
+ (const minimal)
+ (const local)
+ (const ancestors)
+ (const lineage)
+ (const tree)
+ (const canonical))))))
+
+(defvar org-fold-reveal-start-hook nil
+ "Hook run before revealing a location.")
+
+(defcustom org-fold-catch-invisible-edits nil
+ "Check if in invisible region before inserting or deleting a character.
+Valid values are:
+
+nil Do not check, so just do invisible edits.
+error Throw an error and do nothing.
+show Make point visible, and do the requested edit.
+show-and-error Make point visible, then throw an error and abort the edit.
+smart Make point visible, and do insertion/deletion if it is
+ adjacent to visible text and the change feels predictable.
+ Never delete a previously invisible character or add in the
+ middle or right after an invisible region. Basically, this
+ allows insertion and backward-delete right before ellipses.
+ FIXME: maybe in this case we should not even show?"
+ :group 'org-edit-structure
+ :version "24.1"
+ :type '(choice
+ (const :tag "Do not check" nil)
+ (const :tag "Throw error when trying to edit" error)
+ (const :tag "Unhide, but do not do the edit" show-and-error)
+ (const :tag "Show invisible part and do the edit" show)
+ (const :tag "Be smart and do the right thing" smart)))
+
+;;; Core functionality
+
+;;;; Buffer-local folding specs
+
+(defvar-local org-fold--spec-priority-list '(org-fold-outline
+ org-fold-drawer
+ org-fold-block)
+ "Priority of folding specs.
+If a region has multiple folding specs at the same time, only the
+first property from this list will be considered.")
+
+(defvar-local org-fold--spec-with-ellipsis '(org-fold-outline
+ org-fold-drawer
+ org-fold-block)
+ "A list of folding specs, which should be indicated by `org-ellipsis'.")
+
+(defvar-local org-fold--isearch-specs '(org-fold-block
+ org-fold-drawer
+ org-fold-outline)
+ "List of text invisibility specs to be searched by isearch.
+By default ([2020-05-09 Sat]), isearch does not search in hidden text,
+which was made invisible using text properties. Isearch will be forced
+to search in hidden text with any of the listed 'invisible property value.")
+
+(defsubst org-fold-get-folding-spec-for-element (type)
+ "Return name of folding spec for element TYPE."
+ (pcase type
+ (`headline 'org-fold-outline)
+ (`inlinetask 'org-fold-outline)
+ (`plain-list 'org-fold-outline)
+ (`block 'org-fold-block)
+ (`center-block 'org-fold-block)
+ (`comment-block 'org-fold-block)
+ (`dynamic-block 'org-fold-block)
+ (`example-block 'org-fold-block)
+ (`export-block 'org-fold-block)
+ (`quote-block 'org-fold-block)
+ (`special-block 'org-fold-block)
+ (`src-block 'org-fold-block)
+ (`verse-block 'org-fold-block)
+ (`drawer 'org-fold-drawer)
+ (`property-drawer 'org-fold-drawer)
+ (_ nil)))
+
+(defvar org-fold--property-symbol-cache (make-hash-table :test 'equal)
+ "Saved values of folding properties for (buffer . spec) conses.")
+
+;; This is the core function used to fold text in org buffers. We use
+;; text properties to hide folded text, however 'invisible property is
+;; not directly used. Instead, we define unique text property (folding
+;; property) for every possible folding spec and add the resulting
+;; text properties into `char-property-alias-alist', so that
+;; 'invisible text property is automatically defined if any of the
+;; folding properties is non-nil.
+;; This approach lets us maintain multiple folds for the same text
+;; region - poor man's overlays (but much faster).
+;; Additionally, folding properties are ensured to be unique for
+;; different buffers (especially for indirect buffers). This is done
+;; to allow different folding states in indirect org buffers.
+;; If one changes folding state in a fresh indirect buffer, all the
+;; folding properties carried from the base buffer are updated to
+;; become unique in the new indirect buffer.
+(defun org-fold--property-symbol-get-create (spec &optional buffer return-only)
+ "Return a unique symbol suitable as folding text property.
+Return value is unique for folding SPEC in BUFFER.
+If the buffer already have buffer-local setup in `char-property-alias-alist'
+and the setup appears to be created for different buffer,
+copy the old invisibility state into new buffer-local text properties,
+unless RETURN-ONLY is non-nil."
+ (org-fold--check-spec spec)
+ (let* ((buf (or buffer (current-buffer))))
+ ;; Create unique property symbol for SPEC in BUFFER
+ (let ((local-prop (or (gethash (cons buf spec) org-fold--property-symbol-cache)
+ (puthash (cons buf spec)
+ (intern (format "org-fold--spec-%s-%S"
+ (symbol-name spec)
+ ;; (sxhash buf) appears to be not constant over time.
+ ;; Using buffer-name is safe, since the only place where
+ ;; buffer-local text property actually matters is an indirect
+ ;; buffer, where the name cannot be same anyway.
+ (sxhash (buffer-name buf))))
+ org-fold--property-symbol-cache))))
+ (prog1
+ local-prop
+ (unless return-only
+ (with-current-buffer buf
+ ;; Update folding properties carried over from other
+ ;; buffer (implying that current buffer is indirect
+ ;; buffer). Normally, `char-property-alias-alist' in new
+ ;; indirect buffer is a copy of the same variable from
+ ;; the base buffer. Then, `char-property-alias-alist'
+ ;; would contain folding properties, which are not
+ ;; matching the generated `local-prop'.
+ (unless (member local-prop (cdr (assq 'invisible char-property-alias-alist)))
+ ;; Copy all the old folding properties to preserve the folding state
+ (dolist (old-prop (cdr (assq 'invisible char-property-alias-alist)))
+ (org-with-wide-buffer
+ (let* ((pos (point-min))
+ ;; We know that folding properties have
+ ;; folding spec in their name. Extract that
+ ;; spec.
+ (spec (catch :exit
+ (dolist (spec org-fold--spec-priority-list)
+ (when (string-match-p (symbol-name spec)
+ (symbol-name old-prop))
+ (throw :exit spec)))))
+ ;; Generate new buffer-unique folding property
+ (new-prop (org-fold--property-symbol-get-create spec nil 'return-only)))
+ ;; Copy the visibility state for `spec' from `old-prop' to `new-prop'
+ (while (< pos (point-max))
+ (let ((val (get-text-property pos old-prop)))
+ (when val
+ (put-text-property pos (next-single-char-property-change pos old-prop) new-prop val)))
+ (setq pos (next-single-char-property-change pos old-prop))))))
+ ;; Update `char-property-alias-alist' with folding
+ ;; properties unique for the current buffer.
+ (setq-local char-property-alias-alist
+ (cons (cons 'invisible
+ (mapcar (lambda (spec)
+ (org-fold--property-symbol-get-create spec nil 'return-only))
+ org-fold--spec-priority-list))
+ (remove (assq 'invisible char-property-alias-alist)
+ char-property-alias-alist))))))))))
+
+;;; API
+
+;;;; Modifying folding specs
+
+(defun org-fold-add-folding-spec (spec &optional buffer no-ellipsis-p no-isearch-open-p append)
+ "Add a new folding SPEC in BUFFER.
+
+SPEC must be a symbol. BUFFER can be a buffer to set SPEC in, nil to
+set SPEC in current buffer, or 'all to set SPEC in all open `org-mode'
+buffers and all future org buffers. Non-nil optional argument
+NO-ELLIPSIS-P means that folded text will not be indicated by
+`org-ellipsis'. Non-nil optional argument NO-ISEARCH-OPEN-P means
+that folded text cannot be searched by isearch. By default, the added
+SPEC will have highest priority among the previously defined specs.
+When optional APPEND argument is non-nil, SPEC will have the lowest
+priority instead. If SPEC was already defined earlier, it will be
+redefined according to provided optional arguments."
+ (when (eq spec 'all) (user-error "Folding spec name 'all is not allowed"))
+ (when (eq buffer 'all)
+ (mapc (lambda (buf)
+ (org-fold-add-folding-spec spec buf no-ellipsis-p no-isearch-open-p append))
+ (org-buffer-list))
+ (setq-default org-fold--spec-priority-list (delq spec org-fold--spec-priority-list))
+ (add-to-list 'org-fold--spec-priority-list spec append)
+ (setq-default org-fold--spec-priority-list org-fold--spec-priority-list)
+ (when no-ellipsis-p (setq-default org-fold--spec-with-ellipsis (delq spec org-fold--spec-with-ellipsis)))
+ (unless no-ellipsis-p
+ (add-to-list 'org-fold--spec-with-ellipsis spec)
+ (setq-default org-fold--spec-with-ellipsis org-fold--spec-with-ellipsis))
+ (when no-isearch-open-p (setq-default org-fold--isearch-specs (delq spec org-fold--isearch-specs)))
+ (unless no-isearch-open-p
+ (add-to-list 'org-fold--isearch-specs spec)
+ (setq-default org-fold--isearch-specs org-fold--isearch-specs)))
+ (let ((buffer (or buffer (current-buffer))))
+ (with-current-buffer buffer
+ (add-to-invisibility-spec (cons spec (not no-ellipsis-p)))
+ (setq org-fold--spec-priority-list (delq spec org-fold--spec-priority-list))
+ (add-to-list 'org-fold--spec-priority-list spec append)
+ (when no-ellipsis-p (setq org-fold--spec-with-ellipsis (delq spec org-fold--spec-with-ellipsis)))
+ (unless no-ellipsis-p (add-to-list 'org-fold--spec-with-ellipsis spec))
+ (when no-isearch-open-p (setq org-fold--isearch-specs (delq spec org-fold--isearch-specs)))
+ (unless no-isearch-open-p (add-to-list 'org-fold--isearch-specs spec)))))
+
+(defun org-fold-remove-folding-spec (spec &optional buffer)
+ "Remove a folding SPEC in BUFFER.
+
+SPEC must be a symbol.
+BUFFER can be a buffer to remove SPEC in, nil to remove SPEC in current buffer,
+or 'all to remove SPEC in all open org-mode buffers and all future org buffers."
+ (org-fold--check-spec spec)
+ (when (eq buffer 'all)
+ (mapc (lambda (buf)
+ (org-fold-remove-folding-spec spec buf))
+ (org-buffer-list))
+ (setq-default org-fold--spec-priority-list (delq spec org-fold--spec-priority-list))
+ (setq-default org-fold--spec-with-ellipsis (delq spec org-fold--spec-with-ellipsis))
+ (setq-default org-fold--isearch-specs (delq spec org-fold--isearch-specs)))
+ (let ((buffer (or buffer (current-buffer))))
+ (with-current-buffer buffer
+ (remove-from-invisibility-spec (cons spec t))
+ (remove-from-invisibility-spec spec)
+ (setq org-fold--spec-priority-list (delq spec org-fold--spec-priority-list))
+ (setq org-fold--spec-with-ellipsis (delq spec org-fold--spec-with-ellipsis))
+ (setq org-fold--isearch-specs (delq spec org-fold--isearch-specs)))))
+
+(defun org-fold-initialize ()
+ "Setup org-fold in current buffer."
+ (dolist (spec org-fold--spec-priority-list)
+ (org-fold-add-folding-spec spec nil (not (memq spec org-fold--spec-with-ellipsis)) (not (memq spec org-fold--isearch-specs))))
+ (add-hook 'after-change-functions 'org-fold--fix-folded-region nil 'local)
+ ;; Make isearch reveal context
+ (setq-local outline-isearch-open-invisible-function
+ (lambda (&rest _) (org-fold-show-context 'isearch)))
+ (require 'isearch)
+ (if (boundp 'isearch-opened-regions)
+ ;; Use new implementation of isearch allowing to search inside text
+ ;; hidden via text properties.
+ (org-fold--isearch-setup 'text-properties)
+ (org-fold--isearch-setup 'overlays)))
+
+;;;; Searching and examining folded text
+
+(defun org-fold-folded-p (&optional pos)
+ "Non-nil if the character after POS is folded.
+If POS is nil, use `point' instead."
+ (let ((value (get-char-property (or pos (point)) 'invisible)))
+ (cond ((not value) nil)
+ ((memq value org-fold--spec-priority-list) value)
+ (t nil))))
+
+(defun org-fold-get-folding-spec (&optional spec pom)
+ "Get folding state SPEC at POM.
+If SPEC is nil, return a folding spec with highest priority among
+present at point or POM.
+If SPEC is 'all, return the list of all present folding specs.
+Return nil if there is no folding at point or POM.
+If SPEC is a valid folding spec, return value is SPEC if the point is
+within region folded using SPEC or nil otherwise."
+ (when (and spec (not (eq spec 'all))) (org-fold--check-spec spec))
+ (org-with-point-at (or pom (point))
+ (if (and spec (not (eq spec 'all)))
+ (get-char-property (point) (org-fold--property-symbol-get-create spec nil t))
+ (let ((result))
+ (dolist (spec org-fold--spec-priority-list)
+ (let ((val (get-char-property (point) (org-fold--property-symbol-get-create spec nil t))))
+ (when val
+ (push val result))))
+ (if (eq spec 'all)
+ result
+ (car (last result)))))))
+
+(defun org-fold-get-folding-specs-in-region (beg end)
+ "Get all folding specs in region from BEG to END."
+ (let ((pos beg)
+ all-specs)
+ (while (< pos end)
+ (setq all-specs (append all-specs (org-fold-get-folding-spec nil pos)))
+ (setq pos (org-fold-next-folding-state-change nil pos end)))
+ (unless (listp all-specs) (setq all-specs (list all-specs)))
+ (delete-dups all-specs)))
+
+(defun org-fold-get-region-at-point (&optional spec pom)
+ "Return region folded using SPEC at POM.
+If SPEC is nil, return the largest possible folded region.
+The return value is a cons of beginning and the end of the region.
+Return nil when no fold is present at point of POM."
+ (when spec (org-fold--check-spec spec))
+ (org-with-point-at (or pom (point))
+ (if spec
+ (org-find-text-property-region (point) (org-fold--property-symbol-get-create spec nil t))
+ (let ((region (cons (point) (point))))
+ (dolist (spec (org-fold-get-folding-spec 'all))
+ (let ((local-region (org-fold-get-region-at-point spec)))
+ (when (< (car local-region) (car region))
+ (setcar region (car local-region)))
+ (when (> (cdr local-region) (cdr region))
+ (setcdr region (cdr local-region)))))
+ (unless (eq (car region) (cdr region)) region)))))
+
+;; FIXME: Optimize performance
+(defun org-fold-next-visibility-change (&optional pos limit ignore-hidden-p previous-p)
+ "Return next point from POS up to LIMIT where text becomes visible/invisible.
+By default, text hidden by any means (i.e. not only by folding, but
+also via fontification) will be considered.
+If IGNORE-HIDDEN-P is non-nil, consider only folded text.
+If PREVIOUS-P is non-nil, search backwards."
+ (let* ((pos (or pos (point)))
+ (invisible-p (if ignore-hidden-p
+ #'org-fold-folded-p
+ #'invisible-p))
+ (invisible-initially? (funcall invisible-p pos))
+ (limit (or limit (if previous-p
+ (point-min)
+ (point-max))))
+ (cmp (if previous-p #'> #'<))
+ (next-change (if previous-p
+ (if ignore-hidden-p
+ (lambda (p) (org-fold-previous-folding-state-change (org-fold-get-folding-spec nil p) p limit))
+ (lambda (p) (max limit (1- (previous-single-char-property-change p 'invisible nil limit)))))
+ (if ignore-hidden-p
+ (lambda (p) (org-fold-next-folding-state-change (org-fold-get-folding-spec nil p) p limit))
+ (lambda (p) (next-single-char-property-change p 'invisible nil limit)))))
+ (next pos))
+ (while (and (funcall cmp next limit)
+ (not (xor invisible-initially? (funcall invisible-p next))))
+ (setq next (funcall next-change next)))
+ next))
+
+(defun org-fold-previous-visibility-change (&optional pos limit ignore-hidden-p)
+ "Call `org-fold-next-visibility-change' searching backwards."
+ (org-fold-next-visibility-change pos limit ignore-hidden-p 'previous))
+
+(defun org-fold-next-folding-state-change (&optional spec pos limit previous-p)
+ "Return next point where folding state SPEC changes relative to POS up to LIMIT.
+If SPEC is nil, return next point where _any_ single folding type changes.
+For example, (org-fold-next-folding-state-change nil) with point
+somewhere in the below structure will return the nearest <...> point.
+
+* Headline <begin outline fold>
+:PROPERTIES:<begin drawer fold>
+:ID: test
+:END:<end drawer fold>
+
+Fusce suscipit, wisi nec facilisis facilisis, est dui fermentum leo, quis tempor ligula erat quis odio.
+
+** Another headline
+:DRAWER:<begin drawer fold>
+:END:<end drawer fold>
+** Yet another headline
+<end of outline fold>
+
+If SPEC is a list, only consider changes of folding states from the list.
+
+Search backwards when PREVIOUS-P is non-nil."
+ (when (and spec (symbolp spec))
+ (setq spec (list spec)))
+ (when spec (mapc #'org-fold--check-spec spec))
+ (unless spec
+ (setq spec org-fold--spec-priority-list))
+ (let* ((pos (or pos (point)))
+ (props (mapcar (lambda (el) (org-fold--property-symbol-get-create el nil t))
+ spec))
+ (cmp (if previous-p
+ #'max
+ #'min))
+ (next-change (if previous-p
+ (lambda (prop) (max (or limit (point-min)) (previous-single-char-property-change pos prop nil (or limit (point-min)))))
+ (lambda (prop) (next-single-char-property-change pos prop nil (or limit (point-max)))))))
+ (apply cmp (mapcar next-change props))))
+
+(defun org-fold-previous-folding-state-change (&optional spec pos limit)
+ "Call `org-fold-next-folding-state-change' searching backwards."
+ (org-fold-next-folding-state-change spec pos limit 'previous))
+
+(defun org-fold-search-forward (spec &optional limit)
+ "Search next region folded via folding SPEC up to LIMIT.
+Move point right after the end of the region, to LIMIT, or
+`point-max'. The `match-data' will contain the region."
+ (org-fold--check-spec spec)
+ (let ((prop-symbol (org-fold--property-symbol-get-create spec nil t)))
+ (goto-char (or (next-single-char-property-change (point) prop-symbol nil limit) limit (point-max)))
+ (when (and (< (point) (or limit (point-max)))
+ (not (org-fold-get-folding-spec spec)))
+ (goto-char (next-single-char-property-change (point) prop-symbol nil limit)))
+ (when (org-fold-get-folding-spec spec)
+ (let ((region (org-fold-get-region-at-point spec)))
+ (when (< (cdr region) (or limit (point-max)))
+ (goto-char (1+ (cdr region)))
+ (set-match-data (list (set-marker (make-marker) (car region) (current-buffer))
+ (set-marker (make-marker) (cdr region) (current-buffer)))))))))
+
+;;;; Changing visibility (regions, blocks, drawers, headlines)
+
+;;;;; Region visibility
+
+;; This is the core function performing actual folding/unfolding. The
+;; folding state is stored in text property (folding property)
+;; returned by `org-fold--property-symbol-get-create'. The value of the
+;; folding property is folding spec symbol.
+(defun org-fold-region (from to flag &optional spec)
+ "Hide or show lines from FROM to TO, according to FLAG.
+SPEC is the folding spec, as a symbol.
+If SPEC is omitted and FLAG is nil, unfold everything in the region."
+ (when spec (org-fold--check-spec spec))
+ (with-silent-modifications
+ (org-with-wide-buffer
+ (if flag
+ (if (not spec)
+ (error "Calling `org-fold-region' with missing SPEC")
+ (put-text-property from to
+ (org-fold--property-symbol-get-create spec)
+ spec)
+ (put-text-property from to
+ 'isearch-open-invisible
+ #'org-fold--isearch-show)
+ (put-text-property from to
+ 'isearch-open-invisible-temporary
+ #'org-fold--isearch-show-temporary))
+ (if (not spec)
+ (dolist (spec org-fold--spec-priority-list)
+ (remove-text-properties from to
+ (list (org-fold--property-symbol-get-create spec) nil)))
+ (remove-text-properties from to
+ (list (org-fold--property-symbol-get-create spec) nil)))))))
+
+(defun org-fold-show-all (&optional types)
+ "Show all contents in the visible part of the buffer.
+By default, the function expands headings, blocks and drawers.
+When optional argument TYPES is a list of symbols among `blocks',
+`drawers' and `headings', to only expand one specific type."
+ (interactive)
+ (dolist (type (or types '(blocks drawers headings)))
+ (org-fold-region (point-min) (point-max) nil
+ (pcase type
+ (`blocks (org-fold-get-folding-spec-for-element 'block))
+ (`drawers (org-fold-get-folding-spec-for-element 'drawer))
+ (`headings (org-fold-get-folding-spec-for-element 'headline))
+ (_ (error "Invalid type: %S" type))))))
+
+(defun org-fold-flag-above-first-heading (&optional arg)
+ "Hide from bob up to the first heading.
+Move point to the beginning of first heading or end of buffer."
+ (goto-char (point-min))
+ (unless (org-at-heading-p)
+ (outline-next-heading))
+ (unless (bobp)
+ (org-fold-region 1 (1- (point)) (not arg) (org-fold-get-folding-spec-for-element 'headline))))
+
+;;;;; Heading visibility
+
+(defun org-fold-heading (flag &optional entry)
+ "Fold/unfold the current heading. FLAG non-nil means make invisible.
+When ENTRY is non-nil, show the entire entry."
+ (save-excursion
+ (org-back-to-heading t)
+ ;; Check if we should show the entire entry
+ (if (not entry)
+ (org-fold-region
+ (line-end-position 0) (line-end-position) flag (org-fold-get-folding-spec-for-element 'headline))
+ (org-fold-show-entry)
+ (save-excursion
+ ;; FIXME: potentially catches inlinetasks
+ (and (outline-next-heading)
+ (org-fold-heading nil))))))
+
+(defun org-fold-hide-entry ()
+ "Hide the body directly following this heading."
+ (interactive)
+ (save-excursion
+ (org-back-to-heading-or-point-min t)
+ (when (org-at-heading-p) (forward-line))
+ (org-fold-region
+ (line-end-position 0)
+ (save-excursion
+ (if (re-search-forward
+ (concat "[\r\n]" (org-get-limited-outline-regexp)) nil t)
+ (line-end-position 0)
+ (point-max)))
+ t
+ (org-fold-get-folding-spec-for-element 'headline))))
+
+(defun org-fold-subtree (flag)
+ (save-excursion
+ (org-back-to-heading t)
+ (org-fold-region (line-end-position)
+ (progn (org-end-of-subtree t) (point))
+ flag
+ (org-fold-get-folding-spec-for-element 'headline))))
+
+(defun org-fold-hide-subtree ()
+ "Hide everything after this heading at deeper levels."
+ (interactive)
+ (org-fold-subtree t))
+
+(defun org-fold-hide-sublevels (levels)
+ "Hide everything but the top LEVELS levels of headers, in whole buffer.
+This also unhides the top heading-less body, if any.
+
+Interactively, the prefix argument supplies the value of LEVELS.
+When invoked without a prefix argument, LEVELS defaults to the level
+of the current heading, or to 1 if the current line is not a heading."
+ (interactive (list
+ (cond
+ (current-prefix-arg (prefix-numeric-value current-prefix-arg))
+ ((save-excursion (beginning-of-line)
+ (looking-at outline-regexp))
+ (funcall outline-level))
+ (t 1))))
+ (if (< levels 1)
+ (error "Must keep at least one level of headers"))
+ (save-excursion
+ (let* ((beg (progn
+ (goto-char (point-min))
+ ;; Skip the prelude, if any.
+ (unless (org-at-heading-p) (outline-next-heading))
+ (point)))
+ (end (progn
+ (goto-char (point-max))
+ ;; Keep empty last line, if available.
+ (max (point-min) (if (bolp) (1- (point)) (point))))))
+ (if (< end beg)
+ (setq beg (prog1 end (setq end beg))))
+ ;; First hide everything.
+ (org-fold-region beg end t (org-fold-get-folding-spec-for-element 'headline))
+ ;; Then unhide the top level headers.
+ (org-map-region
+ (lambda ()
+ (when (<= (funcall outline-level) levels)
+ (org-fold-show-entry)
+ (org-fold-hide-entry)))
+ beg end)
+ ;; Finally unhide any trailing newline.
+ (goto-char (point-max))
+ (if (and (bolp) (not (bobp)) (outline-invisible-p (1- (point))))
+ (org-fold-region (max (point-min) (1- (point))) (point) nil)))))
+
+(defun org-fold-show-entry ()
+ "Show the body directly following its heading.
+Show the heading too, if it is currently invisible."
+ (interactive)
+ (save-excursion
+ (org-back-to-heading-or-point-min t)
+ (org-fold-region
+ (line-end-position 0)
+ (save-excursion
+ (if (re-search-forward
+ (concat "[\r\n]\\(" (org-get-limited-outline-regexp) "\\)") nil t)
+ (match-beginning 1)
+ (point-max)))
+ nil
+ (org-fold-get-folding-spec-for-element 'headline))
+ (org-cycle-hide-drawers 'children)))
+
+;; FIXME: defalias instead?
+(defun org-fold-show-hidden-entry ()
+ "Show an entry where even the heading is hidden."
+ (save-excursion
+ (org-fold-show-entry)))
+
+(defun org-fold-show-siblings ()
+ "Show all siblings of the current headline."
+ (save-excursion
+ (while (org-goto-sibling) (org-fold-heading nil)))
+ (save-excursion
+ (while (org-goto-sibling 'previous)
+ (org-fold-heading nil))))
+
+(defun org-fold-show-children (&optional level)
+ "Show all direct subheadings of this heading.
+Prefix arg LEVEL is how many levels below the current level
+should be shown. Default is enough to cause the following
+heading to appear."
+ (interactive "p")
+ (unless (org-before-first-heading-p)
+ (save-excursion
+ (org-with-limited-levels (org-back-to-heading t))
+ (let* ((current-level (funcall outline-level))
+ (max-level (org-get-valid-level
+ current-level
+ (if level (prefix-numeric-value level) 1)))
+ (end (save-excursion (org-end-of-subtree t t)))
+ (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)")
+ (past-first-child nil)
+ ;; Make sure to skip inlinetasks.
+ (re (format regexp-fmt
+ current-level
+ (cond
+ ((not (featurep 'org-inlinetask)) "")
+ (org-odd-levels-only (- (* 2 org-inlinetask-min-level)
+ 3))
+ (t (1- org-inlinetask-min-level))))))
+ ;; Display parent heading.
+ (org-fold-heading nil)
+ (forward-line)
+ ;; Display children. First child may be deeper than expected
+ ;; MAX-LEVEL. Since we want to display it anyway, adjust
+ ;; MAX-LEVEL accordingly.
+ (while (re-search-forward re end t)
+ (unless past-first-child
+ (setq re (format regexp-fmt
+ current-level
+ (max (funcall outline-level) max-level)))
+ (setq past-first-child t))
+ (org-fold-heading nil))))))
+
+(defun org-fold-show-subtree ()
+ "Show everything after this heading at deeper levels."
+ (interactive)
+ (org-fold-region
+ (point) (save-excursion (org-end-of-subtree t t)) nil (org-fold-get-folding-spec-for-element 'headline)))
+
+(defun org-fold-show-branches ()
+ "Show all subheadings of this heading, but not their bodies."
+ (interactive)
+ (org-fold-show-children 1000))
+
+(defun org-fold-show-branches-buffer ()
+ "Show all branches in the buffer."
+ (org-fold-flag-above-first-heading)
+ (org-fold-hide-sublevels 1)
+ (unless (eobp)
+ (org-fold-show-branches)
+ (while (outline-get-next-sibling)
+ (org-fold-show-branches)))
+ (goto-char (point-min)))
+
+;;;;; Blocks and drawers visibility
+
+(defun org-fold--hide-wrapper-toggle (element category force no-error)
+ "Toggle visibility for ELEMENT.
+
+ELEMENT is a block or drawer type parsed element. CATEGORY is
+either `block' or `drawer'. When FORCE is `off', show the block
+or drawer. If it is non-nil, hide it unconditionally. Throw an
+error when not at a block or drawer, unless NO-ERROR is non-nil.
+
+Return a non-nil value when toggling is successful."
+ (let ((type (org-element-type element)))
+ (cond
+ ((memq type
+ (pcase category
+ (`drawer '(drawer property-drawer))
+ (`block '(center-block
+ comment-block dynamic-block example-block export-block
+ quote-block special-block src-block verse-block))
+ (_ (error "Unknown category: %S" category))))
+ (let* ((post (org-element-property :post-affiliated element))
+ (start (save-excursion
+ (goto-char post)
+ (line-end-position)))
+ (end (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \t\n")
+ (line-end-position))))
+ ;; Do nothing when not before or at the block opening line or
+ ;; at the block closing line.
+ (unless (let ((eol (line-end-position)))
+ (and (> eol start) (/= eol end)))
+ (let* ((spec (cond ((eq category 'block) (org-fold-get-folding-spec-for-element 'block))
+ ((eq category 'drawer) (org-fold-get-folding-spec-for-element 'drawer))
+ (t (org-fold-get-folding-spec-for-element 'headline))))
+ (flag
+ (cond ((eq force 'off) nil)
+ (force t)
+ ((org-fold-get-folding-spec nil start) nil)
+ (t t))))
+ (org-fold-region start end flag spec))
+ ;; When the block is hidden away, make sure point is left in
+ ;; a visible part of the buffer.
+ (when (invisible-p (max (1- (point)) (point-min)))
+ (goto-char post))
+ ;; Signal success.
+ t)))
+ (no-error nil)
+ (t
+ (user-error (if (eq category 'drawer)
+ "Not at a drawer"
+ "Not at a block"))))))
+
+(defun org-fold-hide-block-toggle (&optional force no-error element)
+ "Toggle the visibility of the current block.
+
+When optional argument FORCE is `off', make block visible. If it
+is non-nil, hide it unconditionally. Throw an error when not at
+a block, unless NO-ERROR is non-nil. When optional argument
+ELEMENT is provided, consider it instead of the current block.
+
+Return a non-nil value when toggling is successful."
+ (interactive)
+ (org-fold--hide-wrapper-toggle
+ (or element (org-element-at-point)) 'block force no-error))
+
+(defun org-fold-hide-drawer-toggle (&optional force no-error element)
+ "Toggle the visibility of the current drawer.
+
+When optional argument FORCE is `off', make drawer visible. If
+it is non-nil, hide it unconditionally. Throw an error when not
+at a drawer, unless NO-ERROR is non-nil. When optional argument
+ELEMENT is provided, consider it instead of the current drawer.
+
+Return a non-nil value when toggling is successful."
+ (interactive)
+ (org-fold--hide-wrapper-toggle
+ (or element (org-element-at-point)) 'drawer force no-error))
+
+(defun org-fold-hide-block-all ()
+ "Fold all blocks in the current buffer."
+ (interactive)
+ (org-fold-show-all '(blocks))
+ (org-block-map 'org-fold-hide-block-toggle))
+
+(defun org-fold-hide-drawer-all ()
+ "Fold all visible drawers in the current buffer or narrow."
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward org-drawer-regexp nil t)
+ ;; Skip drawers in folded headings
+ (when (org-fold-get-folding-spec) (goto-char (org-fold-next-visibility-change nil nil 'ignore-hidden)))
+ (let* ((drawer (org-element-at-point))
+ (type (org-element-type drawer)))
+ (when (memq type '(drawer property-drawer))
+ ;; We are sure regular drawers are unfolded because of
+ ;; `org-show-all' call above. However, property drawers may
+ ;; be folded, or in a folded headline. In that case, do not
+ ;; re-hide it.
+ (unless (and (eq type 'property-drawer)
+ (org-fold-get-folding-spec))
+ (org-fold-hide-drawer-toggle t nil drawer))
+ ;; Make sure to skip drawer entirely or we might flag it
+ ;; another time when matching its ending line with
+ ;; `org-drawer-regexp'.
+ (goto-char (org-element-property :end drawer)))))))
+
+;;;;; Reveal point location
+
+(defun org-fold-show-context (&optional key)
+ "Make sure point and context are visible.
+Optional argument KEY, when non-nil, is a symbol. See
+`org-fold-show-context-detail' for allowed values and how much is to
+be shown."
+ (org-fold-show-set-visibility
+ (cond ((symbolp org-fold-show-context-detail) org-fold-show-context-detail)
+ ((cdr (assq key org-fold-show-context-detail)))
+ (t (cdr (assq 'default org-fold-show-context-detail))))))
+
+(defun org-fold-show-set-visibility (detail)
+ "Set visibility around point according to DETAIL.
+DETAIL is either nil, `minimal', `local', `ancestors', `lineage',
+`tree', `canonical' or t. See `org-fold-show-context-detail' for more
+information."
+ ;; Show current heading and possibly its entry, following headline
+ ;; or all children.
+ (if (and (org-at-heading-p) (not (eq detail 'local)))
+ (org-fold-heading nil)
+ (org-fold-show-entry)
+ ;; If point is hidden within a drawer or a block, make sure to
+ ;; expose it.
+ (when (memq (org-fold-get-folding-spec)
+ (list (org-fold-get-folding-spec-for-element 'drawer) (org-fold-get-folding-spec-for-element 'block)))
+ (let ((region (org-fold-get-region-at-point)))
+ (org-fold-region (car region) (cdr region) nil)))
+ (unless (org-before-first-heading-p)
+ (org-with-limited-levels
+ (cl-case detail
+ ((tree canonical t) (org-fold-show-children))
+ ((nil minimal ancestors))
+ (t (save-excursion
+ (outline-next-heading)
+ (org-fold-heading nil)))))))
+ ;; Show all siblings.
+ (when (eq detail 'lineage) (org-fold-show-siblings))
+ ;; Show ancestors, possibly with their children.
+ (when (memq detail '(ancestors lineage tree canonical t))
+ (save-excursion
+ (while (org-up-heading-safe)
+ (org-fold-heading nil)
+ (when (memq detail '(canonical t)) (org-fold-show-entry))
+ (when (memq detail '(tree canonical t)) (org-fold-show-children))))))
+
+(defun org-fold-reveal (&optional siblings)
+ "Show current entry, hierarchy above it, and the following headline.
+
+This can be used to show a consistent set of context around
+locations exposed with `org-fold-show-context'.
+
+With optional argument SIBLINGS, on each level of the hierarchy all
+siblings are shown. This repairs the tree structure to what it would
+look like when opened with hierarchical calls to `org-cycle'.
+
+With a \\[universal-argument] \\[universal-argument] prefix, \
+go to the parent and show the entire tree."
+ (interactive "P")
+ (run-hooks 'org-fold-reveal-start-hook)
+ (cond ((equal siblings '(4)) (org-fold-show-set-visibility 'canonical))
+ ((equal siblings '(16))
+ (save-excursion
+ (when (org-up-heading-safe)
+ (org-fold-show-subtree)
+ (run-hook-with-args 'org-cycle-hook 'subtree))))
+ (t (org-fold-show-set-visibility 'lineage))))
+
+;;; Internal functions
+
+(defun org-fold--check-spec (spec)
+ "Throw an error if SPEC is not present in `org-fold--spec-priority-list'."
+ (unless (and spec (memq spec org-fold--spec-priority-list))
+ (user-error "%s is not a valid folding spec" spec)))
+
+;;; Make isearch search in some text hidden via text propertoes
+
+(defvar org-fold--isearch-overlays nil
+ "List of overlays temporarily created during isearch.
+This is used to allow searching in regions hidden via text properties.
+As for [2020-05-09 Sat], Isearch only has special handling of hidden overlays.
+Any text hidden via text properties is not revealed even if `search-invisible'
+is set to 't.")
+
+(defvar-local org-fold--isearch-local-regions (make-hash-table :test 'equal)
+ "Hash table storing temporarily shown folds from isearch matches.")
+
+(defun org-fold--isearch-setup (type)
+ "Initialize isearch in org buffer.
+TYPE can be either `text-properties' or `overlays'."
+ (pcase type
+ (`text-properties
+ (setq-local search-invisible 'open-all)
+ (add-hook 'isearch-mode-end-hook #'org-fold--clear-isearch-state nil 'local)
+ (add-hook 'isearch-mode-hook #'org-fold--clear-isearch-state nil 'local)
+ (setq-local isearch-filter-predicate #'org-fold--isearch-filter-predicate-text-properties))
+ (`overlays
+ (setq-local isearch-filter-predicate #'org-fold--isearch-filter-predicate-overlays)
+ (add-hook 'isearch-mode-end-hook #'org-fold--clear-isearch-overlays nil 'local))
+ (_ (error "%s: Unknown type of setup for `org-fold--isearch-setup'" type))))
+
+(defun org-fold--isearch-filter-predicate-text-properties (beg end)
+ "Make sure that text hidden by any means other than `org-fold--isearch-specs' is not searchable.
+This function is intended to be used as `isearch-filter-predicate'."
+ (and
+ ;; Check folding specs that cannot be searched
+ (seq-every-p (lambda (spec) (member spec org-fold--isearch-specs)) (org-fold-get-folding-specs-in-region beg end))
+ ;; Check 'invisible properties that are not folding specs
+ (or (eq search-invisible t) ; User wants to search, allow it
+ (let ((pos beg)
+ unknown-invisible-property)
+ (while (and (< pos end)
+ (not unknown-invisible-property))
+ (when (and (get-text-property pos 'invisible)
+ (not (member (get-text-property pos 'invisible) org-fold--isearch-specs)))
+ (setq unknown-invisible-property t))
+ (setq pos (next-single-char-property-change pos 'invisible)))
+ (not unknown-invisible-property)))
+ (or (and (eq search-invisible t)
+ ;; FIXME: this opens regions permanenly for now.
+ ;; I also tried to force search-invisible 'open-all around
+ ;; `isearch-range-invisible', but that somehow causes
+ ;; infinite loop in `isearch-lazy-highlight'.
+ (prog1 t
+ ;; We still need to reveal the folded location
+ (org-fold--isearch-show-temporary (cons beg end) nil)))
+ (not (isearch-range-invisible beg end)))))
+
+(defun org-fold--clear-isearch-state ()
+ "Clear `org-fold--isearch-local-regions'."
+ (clrhash org-fold--isearch-local-regions))
+
+(defun org-fold--isearch-show (region)
+ "Reveal text in REGION found by isearch."
+ (org-with-point-at (car region)
+ (while (< (point) (cdr region))
+ (org-fold-show-set-visibility 'isearch)
+ (goto-char (org-fold-next-visibility-change (point) (cdr region) 'ignore-hidden)))))
+
+(defun org-fold--isearch-show-temporary (region hide-p)
+ "Temporarily reveal text in REGION.
+Hide text instead if HIDE-P is non-nil."
+ (if (not hide-p)
+ (let ((pos (car region)))
+ (while (< pos (cdr region))
+ (dolist (spec (org-fold-get-folding-spec 'all pos))
+ (push (cons spec (org-fold-get-region-at-point spec pos)) (gethash region org-fold--isearch-local-regions)))
+ (org-fold--isearch-show region)
+ (setq pos (org-fold-next-folding-state-change nil pos (cdr region)))))
+ (mapc (lambda (val) (org-fold-region (cadr val) (cddr val) t (car val))) (gethash region org-fold--isearch-local-regions))
+ (remhash region org-fold--isearch-local-regions)))
+
+(defun org-fold--create-isearch-overlays (beg end)
+ "Replace text property invisibility spec by overlays between BEG and END.
+All the regions with invisibility text property spec from
+`org-fold--isearch-specs' will be changed to use overlays instead
+of text properties. The created overlays will be stored in
+`org-fold--isearch-overlays'."
+ (let ((pos beg))
+ (while (< pos end)
+ ;; We need loop below to make sure that we clean all invisible
+ ;; properties, which may be nested.
+ (while (memq (get-text-property pos 'invisible) org-fold--isearch-specs)
+ (let* ((spec (get-text-property pos 'invisible))
+ (region (org-find-text-property-region pos (org-fold--property-symbol-get-create spec nil t))))
+ ;; Changing text properties is considered buffer modification.
+ ;; We do not want it here.
+ (with-silent-modifications
+ (org-fold-region (car region) (cdr region) nil spec)
+ ;; The overlay is modelled after `outline-flag-region'
+ ;; [2020-05-09 Sat] overlay for 'outline blocks.
+ (let ((o (make-overlay (car region) (cdr region) nil 'front-advance)))
+ (overlay-put o 'evaporate t)
+ (overlay-put o 'invisible spec)
+ ;; `delete-overlay' here means that spec information will be lost
+ ;; for the region. The region will remain visible.
+ (overlay-put o 'isearch-open-invisible #'delete-overlay)
+ (push o org-fold--isearch-overlays)))))
+ (setq pos (next-single-property-change pos 'invisible nil end)))))
+
+(defun org-fold--isearch-filter-predicate-overlays (beg end)
+ "Return non-nil if text between BEG and END is deemed visible by isearch.
+This function is intended to be used as `isearch-filter-predicate'.
+Unlike `isearch-filter-visible', make text with `invisible' text property
+value listed in `org-fold--isearch-specs'."
+ (org-fold--create-isearch-overlays beg end) ;; trick isearch by creating overlays in place of invisible text
+ (isearch-filter-visible beg end))
+
+(defun org-fold--clear-isearch-overlay (ov)
+ "Convert OV region back into using text properties."
+ (let ((spec (overlay-get ov 'invisible)))
+ ;; Ignore deleted overlays.
+ (when (and spec
+ (overlay-buffer ov))
+ ;; Changing text properties is considered buffer modification.
+ ;; We do not want it here.
+ (with-silent-modifications
+ (when (< (overlay-end ov) (point-max))
+ (org-fold-region (overlay-start ov) (overlay-end ov) t spec)))))
+ (when (member ov isearch-opened-overlays)
+ (setq isearch-opened-overlays (delete ov isearch-opened-overlays)))
+ (delete-overlay ov))
+
+(defun org-fold--clear-isearch-overlays ()
+ "Convert overlays from `org--isearch-overlays' back into using text properties."
+ (when org-fold--isearch-overlays
+ (mapc #'org-fold--clear-isearch-overlay org-fold--isearch-overlays)
+ (setq org-fold--isearch-overlays nil)))
+
+;;; Handling changes in folded elements
+
+(defvar-local org-fold--last-buffer-chars-modified-tick nil
+ "Variable storing the last return value of `buffer-chars-modified-tick'.")
+
+(defun org-fold--fix-folded-region (from to _)
+ "Process changes in folded elements.
+This function intended to be used as one of `after-change-functions'.
+
+This function does nothing if text the only modification was changing
+text properties (for the sake of reducing overheads).
+
+If a text was inserted into invisible region, hide the inserted text.
+If the beginning/end line of a folded drawer/block was changed, unfold it.
+If a valid end line was inserted in the middle of the folded drawer/block, unfold it."
+ ;; If no insertions or deletions in buffer, skip all the checks.
+ (unless (eq org-fold--last-buffer-chars-modified-tick (buffer-chars-modified-tick))
+ ;; Store the new buffer modification state.
+ (setq org-fold--last-buffer-chars-modified-tick (buffer-chars-modified-tick))
+ ;; Re-hide text inserted in the middle of a folded region.
+ (unless (equal from to)
+ (dolist (spec org-fold--spec-priority-list)
+ (let ((spec-to (org-fold-get-folding-spec spec (min to (1- (point-max)))))
+ (spec-from (org-fold-get-folding-spec spec (max (point-min) (1- from)))))
+ (when (and spec-from spec-to (eq spec-to spec-from))
+ (org-fold-region from to t (or spec-from spec-to))))))
+ ;; Re-hide text inserted right in front (but not at the back) of a
+ ;; folded region.
+ ;; Examples: beginning of a folded drawer, first line of folded
+ ;; headline (schedule). However, do not hide headline text.
+ (unless (equal from to)
+ (when (or
+ ;; Prepending to folded headline, block, or drawer.
+ (and (not (org-fold-folded-p (max (point-min) (1- from))))
+ (org-fold-folded-p to)
+ (not (org-at-heading-p)))
+ ;; Appending to folded headline. We cannot append to
+ ;; folded block or drawer though.
+ (and (org-fold-get-folding-spec (org-fold-get-folding-spec-for-element 'headline) (max (point-min) (1- from)))
+ (not (org-fold-folded-p to))))
+ (org-fold-region from to t (or
+ ;; Only headline spec for appended text.
+ (org-fold-get-folding-spec (org-fold-get-folding-spec-for-element 'headline) (max (point-min) (1- from)))
+ (org-fold-get-folding-spec nil to)))))
+ ;; Reveal the whole region if inserted in the middle of
+ ;; visible text. This is needed, for example, when one is
+ ;; trying to copy text from indirect buffer to main buffer. If
+ ;; the text is unfolded in the indirect buffer, but folded in
+ ;; the main buffer, the text properties responsible for
+ ;; folding will be activated as soon as the text is pasted
+ ;; into the main buffer. Thus, we need to unfold the inserted
+ ;; text to make org-mode behave as expected (the inserted text
+ ;; is visible).
+ ;; FIXME: this breaks when replacing buffer/region contents - we do not need to unfold in that case
+ ;; (unless (equal from to)
+ ;; (when (and (not (org-fold-folded-p (max (point-min) (1- from)))) (not (org-fold-folded-p to)))
+ ;; (org-fold-region from to nil)))
+ ;; Process all the folded text between `from' and `to'.
+ (org-with-wide-buffer
+ ;; If the edit is done in the first line of a folded drawer/block,
+ ;; the folded text is only starting from the next line and needs to
+ ;; be checked.
+ (setq to (save-excursion (goto-char to) (line-beginning-position 2)))
+ ;; If the ":END:"