Skip to content

Instantly share code, notes, and snippets.

@yantar92

yantar92/featuredrawertextprop.patch

Last active September 23, 2020 06:44
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save yantar92/6447754415457927293acda43a7fcaef to your computer and use it in GitHub Desktop.
Save yantar92/6447754415457927293acda43a7fcaef to your computer and use it in GitHub Desktop.
Download ZIP
Against aea1109ef
Raw
featuredrawertextprop.patch
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:" line of the drawer is deleted, the folded text is
+ ;; only ending at the previous line and needs to be checked.
+ (setq from (save-excursion (goto-char from) (line-beginning-position 0)))
+ ;; Expand the considered region to include partially present folded
+ ;; drawer/block.
+ (when (org-fold-get-folding-spec (org-fold-get-folding-spec-for-element 'drawer) from)
+ (setq from (org-fold-previous-folding-state-change (org-fold-get-folding-spec-for-element 'drawer) from)))
+ (when (org-fold-get-folding-spec (org-fold-get-folding-spec-for-element 'block) from)
+ (setq from (org-fold-previous-folding-state-change (org-fold-get-folding-spec-for-element 'block) from)))
+ (when (org-fold-get-folding-spec (org-fold-get-folding-spec-for-element 'drawer) to)
+ (setq to (org-fold-next-folding-state-change (org-fold-get-folding-spec-for-element 'drawer) to)))
+ (when (org-fold-get-folding-spec (org-fold-get-folding-spec-for-element 'block) to)
+ (setq from (org-fold-next-folding-state-change (org-fold-get-folding-spec-for-element 'block) to)))
+ ;; Check folded drawers and blocks.
+ (dolist (spec (list (org-fold-get-folding-spec-for-element 'drawer) (org-fold-get-folding-spec-for-element 'block)))
+ (let ((pos from)
+ (begin-re (cond
+ ((eq spec (org-fold-get-folding-spec-for-element 'drawer))
+ org-drawer-regexp)
+ ;; Group one below contains the type of the block.
+ ((eq spec (org-fold-get-folding-spec-for-element 'block))
+ (rx bol (zero-or-more (any " " "\t"))
+ "#+begin"
+ (or ":"
+ (seq "_"
+ (group (one-or-more (not (syntax whitespace))))))))))
+ ;; To be determined later. May depend on `begin-re' match (i.e. for blocks).
+ end-re)
+ ;; Move to the first hidden drawer/block.
+ (unless (org-fold-get-folding-spec spec pos)
+ (setq pos (org-fold-next-folding-state-change spec pos to)))
+ ;; Cycle over all the hidden drawers/blocks.
+ (while (< pos to)
+ (save-match-data ; we should not clobber match-data in after-change-functions
+ (let ((fold-begin (and (org-fold-get-folding-spec spec pos)
+ pos))
+ (fold-end (org-fold-next-folding-state-change spec pos to)))
+ (when (and fold-begin fold-end)
+ (let (unfold?)
+ (catch :exit
+ ;; The line before folded text should be beginning of
+ ;; the drawer/block.
+ (save-excursion
+ (goto-char fold-begin)
+ ;; The line before beginning of the fold should be the
+ ;; first line of the drawer/block.
+ (backward-char)
+ (beginning-of-line)
+ (unless (let ((case-fold-search t))
+ (looking-at begin-re)) ; the match-data will be used later
+ (throw :exit (setq unfold? t))))
+ ;; Set `end-re' for the current drawer/block.
+ (setq end-re
+ (cond
+ ((eq spec (org-fold-get-folding-spec-for-element 'drawer))
+ org-property-end-re)
+ ((eq spec (org-fold-get-folding-spec-for-element 'block))
+ (let ((block-type (match-string 1))) ; the last match is from `begin-re'
+ (concat (rx bol (zero-or-more (any " " "\t")) "#+end")
+ (if block-type
+ (concat "_"
+ (regexp-quote block-type)
+ (rx (zero-or-more (any " " "\t")) eol))
+ (rx (opt ":") (zero-or-more (any " " "\t")) eol)))))))
+ ;; The last line of the folded text should match `end-re'.
+ (save-excursion
+ (goto-char fold-end)
+ (beginning-of-line)
+ (unless (let ((case-fold-search t))
+ (looking-at end-re))
+ (throw :exit (setq unfold? t))))
+ ;; there should be no `end-re' or
+ ;; `org-outline-regexp-bol' anywhere in the
+ ;; drawer/block body.
+ (save-excursion
+ (goto-char fold-begin)
+ (when (save-excursion
+ (let ((case-fold-search t))
+ (re-search-forward (rx (or (regex end-re)
+ (regex org-outline-regexp-bol)))
+ (max (point)
+ (1- (save-excursion
+ (goto-char fold-end)
+ (line-beginning-position))))
+ 't)))
+ (throw :exit (setq unfold? t)))))
+ (when unfold?
+ (org-fold-region fold-begin fold-end nil spec)))
+ (goto-char fold-end))))
+ ;; Move to next hidden drawer/block.
+ (setq pos
+ (org-fold-next-folding-state-change spec to))))))))
+
+;; Catching user edits inside invisible text
+(defun org-fold-check-before-invisible-edit (kind)
+ "Check is editing if kind KIND would be dangerous with invisible text around.
+The detailed reaction depends on the user option `org-fold-catch-invisible-edits'."
+ ;; First, try to get out of here as quickly as possible, to reduce overhead
+ (when (and org-fold-catch-invisible-edits
+ (or (not (boundp 'visible-mode)) (not visible-mode))
+ (or (org-invisible-p)
+ (org-invisible-p (max (point-min) (1- (point))))))
+ ;; OK, we need to take a closer look. Only consider invisibility
+ ;; caused by folding, not by fontification (e.g., link
+ ;; fontification), as it cannot be toggled.
+ (let* ((invisible-at-point (org-fold-folded-p))
+ ;; Assume that point cannot land in the middle of an
+ ;; overlay, or between two overlays.
+ (invisible-before-point
+ (and (not invisible-at-point)
+ (not (bobp))
+ (org-fold-folded-p (1- (point)))))
+ (border-and-ok-direction
+ (or
+ ;; Check if we are acting predictably before invisible
+ ;; text.
+ (and invisible-at-point
+ (memq kind '(insert delete-backward)))
+ ;; Check if we are acting predictably after invisible text
+ ;; This works not well, and I have turned it off. It seems
+ ;; better to always show and stop after invisible text.
+ ;; (and (not invisible-at-point) invisible-before-point
+ ;; (memq kind '(insert delete)))
+ )))
+ (when (or invisible-at-point invisible-before-point)
+ (when (eq org-fold-catch-invisible-edits 'error)
+ (user-error "Editing in invisible areas is prohibited, make them visible first"))
+ (if (and org-custom-properties-hidden-p
+ (y-or-n-p "Display invisible properties in this buffer? "))
+ (org-toggle-custom-properties-visibility)
+ ;; Make the area visible
+ (save-excursion
+ (org-fold-show-context 'minimal))
+ (cond
+ ((eq org-fold-catch-invisible-edits 'show)
+ ;; That's it, we do the edit after showing
+ (message
+ "Unfolding invisible region around point before editing")
+ (sit-for 1))
+ ((and (eq org-fold-catch-invisible-edits 'smart)
+ border-and-ok-direction)
+ (message "Unfolding invisible region around point before editing"))
+ (t
+ ;; Don't do the edit, make the user repeat it in full visibility
+ (user-error "Edit in invisible region aborted, repeat to confirm with text visible"))))))))
+
+(provide 'org-fold)
+
+;;; org-fold.el ends here
diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el
index 14b0a2a00..dc4156e2c 100644
--- a/lisp/org-footnote.el
+++ b/lisp/org-footnote.el
@@ -51,7 +51,7 @@
(declare-function org-inside-LaTeX-fragment-p "org" ())
(declare-function org-inside-latex-macro-p "org" ())
(declare-function org-mark-ring-push "org" (&optional pos buffer))
-(declare-function org-show-context "org" (&optional key))
+(declare-function org-fold-show-context "org-fold" (&optional key))
(declare-function outline-next-heading "outline")
(defvar electric-indent-mode)
@@ -546,7 +546,7 @@ value if point was successfully moved."
(goto-char def-start)
(looking-at (format "\\[fn:%s[]:]" (regexp-quote label)))
(goto-char (match-end 0))
- (org-show-context 'link-search)
+ (org-fold-show-context 'link-search)
(when (derived-mode-p 'org-mode)
(message "%s" (substitute-command-keys
"Edit definition and go back with \
@@ -572,7 +572,7 @@ value if point was successfully moved."
(user-error "Reference is outside narrowed part of buffer")))
(org-mark-ring-push)
(goto-char start)
- (org-show-context 'link-search)))
+ (org-fold-show-context 'link-search)))
;;;; Getters
diff --git a/lisp/org-goto.el b/lisp/org-goto.el
index 56786696e..0a86c867d 100644
--- a/lisp/org-goto.el
+++ b/lisp/org-goto.el
@@ -238,9 +238,9 @@ position or nil."
(error (make-indirect-buffer (current-buffer) "*org-goto*" t))))
(let (temp-buffer-show-function temp-buffer-show-hook)
(with-output-to-temp-buffer "*Org Help*"
- (princ (format help (if org-goto-auto-isearch
- " Just type for auto-isearch."
- " n/p/f/b/u to navigate, q to quit.")))))
+ (princ (format help (if org-goto-auto-isearch
+ " Just type for auto-isearch."
+ " n/p/f/b/u to navigate, q to quit.")))))
(org-fit-window-to-buffer (get-buffer-window "*Org Help*"))
(org-overview)
(setq buffer-read-only t)
@@ -248,7 +248,7 @@ position or nil."
(integer-or-marker-p org-goto-start-pos))
(progn (goto-char org-goto-start-pos)
(when (org-invisible-p)
- (org-show-set-visibility 'lineage)))
+ (org-fold-show-set-visibility 'lineage)))
(goto-char (point-min)))
(let (org-special-ctrl-a/e) (org-beginning-of-line))
(message "Select location and press RET")
@@ -299,7 +299,7 @@ With a prefix argument, use the alternative interface: e.g., if
(org-mark-ring-push org-goto-start-pos)
(goto-char selected-point)
(when (or (org-invisible-p) (org-invisible-p2))
- (org-show-context 'org-goto)))
+ (org-fold-show-context 'org-goto)))
(message "Quit"))))
(provide 'org-goto)
diff --git a/lisp/org-id.el b/lisp/org-id.el
index f8af52964..526d7b7e4 100644
--- a/lisp/org-id.el
+++ b/lisp/org-id.el
@@ -323,7 +323,7 @@ Move the cursor to that entry in that buffer."
(pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
(move-marker m nil)
- (org-show-context)))
+ (org-fold-show-context)))
;;;###autoload
(defun org-id-find (id &optional markerp)
@@ -716,7 +716,7 @@ optional argument MARKERP, return the position as a new marker."
(funcall cmd (marker-buffer m)))
(goto-char m)
(move-marker m nil)
- (org-show-context)))
+ (org-fold-show-context)))
(org-link-set-parameters "id" :follow #'org-id-open)
diff --git a/lisp/org-inlinetask.el b/lisp/org-inlinetask.el
index 60e3e0cc5..d6ec6e1f7 100644
--- a/lisp/org-inlinetask.el
+++ b/lisp/org-inlinetask.el
@@ -311,9 +311,9 @@ If the task has an end part, also demote it."
;; Nothing to show/hide.
((= end start))
;; Inlinetask was folded: expand it.
- ((eq (get-char-property (1+ start) 'invisible) 'outline)
- (org-flag-region start end nil 'outline))
- (t (org-flag-region start end t 'outline)))))
+ ((org-fold-get-folding-spec (org-fold-get-folding-spec-for-element 'headline) (1+ start))
+ (org-fold-region start end nil (org-fold-get-folding-spec-for-element 'headline)))
+ (t (org-fold-region start end t (org-fold-get-folding-spec-for-element 'headline))))))
(defun org-inlinetask-hide-tasks (state)
"Hide inline tasks in buffer when STATE is `contents' or `children'.
diff --git a/lisp/org-keys.el b/lisp/org-keys.el
index 37df29983..0313672be 100644
--- a/lisp/org-keys.el
+++ b/lisp/org-keys.el
@@ -149,7 +149,7 @@
(declare-function org-resolve-clocks "org" (&optional only-dangling-p prompt-fn last-valid))
(declare-function org-return "org" (&optional indent))
(declare-function org-return-and-maybe-indent "org" ())
-(declare-function org-reveal "org" (&optional siblings))
+(declare-function org-fold-reveal "org-fold" (&optional siblings))
(declare-function org-schedule "org" (arg &optional time))
(declare-function org-self-insert-command "org" (N))
(declare-function org-set-effort "org" (&optional increment value))
@@ -169,9 +169,9 @@
(declare-function org-shiftright "org" (&optional arg))
(declare-function org-shifttab "org" (&optional arg))
(declare-function org-shiftup "org" (&optional arg))
-(declare-function org-show-all "org" (&optional types))
-(declare-function org-show-children "org" (&optional level))
-(declare-function org-show-subtree "org" ())
+(declare-function org-fold-show-all "org-fold" (&optional types))
+(declare-function org-fold-show-children "org-fold" (&optional level))
+(declare-function org-fold-show-subtree "org-fold" ())
(declare-function org-sort "org" (&optional with-case))
(declare-function org-sparse-tree "org" (&optional arg type))
(declare-function org-table-blank-field "org" ())
@@ -423,7 +423,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
(define-key org-mode-map [menu-bar show] 'undefined)
(define-key org-mode-map [remap outline-mark-subtree] #'org-mark-subtree)
-(define-key org-mode-map [remap outline-show-subtree] #'org-show-subtree)
+(define-key org-mode-map [remap outline-show-subtree] #'org-fold-show-subtree)
(define-key org-mode-map [remap outline-forward-same-level]
#'org-forward-heading-same-level)
(define-key org-mode-map [remap outline-backward-same-level]
@@ -437,7 +437,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
#'org-next-visible-heading)
(define-key org-mode-map [remap outline-previous-visible-heading]
#'org-previous-visible-heading)
-(define-key org-mode-map [remap show-children] #'org-show-children)
+(define-key org-mode-map [remap outline-show-children] #'org-fold-show-children)
;;;; Make `C-c C-x' a prefix key
(org-defkey org-mode-map (kbd "C-c C-x") (make-sparse-keymap))
@@ -554,7 +554,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
;;;; All the other keys
(org-defkey org-mode-map (kbd "|") #'org-force-self-insert)
-(org-defkey org-mode-map (kbd "C-c C-r") #'org-reveal)
+(org-defkey org-mode-map (kbd "C-c C-r") #'org-fold-reveal)
(org-defkey org-mode-map (kbd "C-M-t") #'org-transpose-element)
(org-defkey org-mode-map (kbd "M-}") #'org-forward-element)
(org-defkey org-mode-map (kbd "ESC }") #'org-forward-element)
diff --git a/lisp/org-lint.el b/lisp/org-lint.el
index 79ad640e4..1637e96c9 100644
--- a/lisp/org-lint.el
+++ b/lisp/org-lint.el
@@ -1200,7 +1200,7 @@ CHECKERS is the list of checkers used."
(let ((l (org-lint--current-line)))
(switch-to-buffer-other-window org-lint--source-buffer)
(org-goto-line l)
- (org-show-set-visibility 'local)
+ (org-fold-show-set-visibility 'local)
(recenter)))
(defun org-lint--show-source ()
diff --git a/lisp/org-list.el b/lisp/org-list.el
index b8383283b..ed2ae77ef 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -2036,8 +2036,8 @@ Possible values are: `folded', `children' or `subtree'. See
((eq view 'folded)
(let ((item-end (org-list-get-item-end-before-blank item struct)))
;; Hide from eol
- (org-flag-region (save-excursion (goto-char item) (line-end-position))
- item-end t 'outline)))
+ (org-fold-region (save-excursion (goto-char item) (line-end-position))
+ item-end t (org-fold-get-folding-spec-for-element 'headline))))
((eq view 'children)
;; First show everything.
(org-list-set-item-visibility item struct 'subtree)
@@ -2049,7 +2049,7 @@ Possible values are: `folded', `children' or `subtree'. See
((eq view 'subtree)
;; Show everything
(let ((item-end (org-list-get-item-end item struct)))
- (org-flag-region item item-end nil 'outline)))))
+ (org-fold-region item item-end nil (org-fold-get-folding-spec-for-element 'headline))))))
(defun org-list-item-body-column (item)
"Return column at which body of ITEM should start."
@@ -2462,7 +2462,7 @@ subtree, ignoring planning line and any drawer following it."
(save-restriction
(save-excursion
(org-narrow-to-subtree)
- (org-show-subtree)
+ (org-fold-show-subtree)
(goto-char (point-min))
(let ((end (point-max)))
(while (< (point) end)
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index f25efe07f..701134c9b 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -122,28 +122,32 @@ means that the buffer may change while running BODY, but it also
means that the buffer should stay alive during the operation,
because otherwise all these markers will point to nowhere."
(declare (debug (form body)) (indent 1))
- (org-with-gensyms (data invisible-types markers?)
- `(let* ((,invisible-types '(org-hide-block outline))
+ (org-with-gensyms (data invisible-specs markers?)
+ `(let* ((,invisible-specs '(,(org-fold-get-folding-spec-for-element 'block)
+ ,(org-fold-get-folding-spec-for-element 'headline)))
(,markers? ,use-markers)
(,data
- (mapcar (lambda (o)
- (let ((beg (overlay-start o))
- (end (overlay-end o))
- (type (overlay-get o 'invisible)))
- (and beg end
- (> end beg)
- (memq type ,invisible-types)
- (list (if ,markers? (copy-marker beg) beg)
- (if ,markers? (copy-marker end t) end)
- type))))
- (org-with-wide-buffer
- (overlays-in (point-min) (point-max))))))
+ (org-with-wide-buffer
+ (let ((pos (point-min))
+ data-val)
+ (while (< pos (point-max))
+ (dolist (spec (org-fold-get-folding-spec 'all pos))
+ (when (memq type ,invisible-specs)
+ (let ((region (org-fold-get-region-at-point spec pos)))
+ (if ,markers?
+ (push (list (copy-marker (car region))
+ (copy-marker (cdr region) t)
+ spec)
+ data-val)
+ (push (list (car region) (cdr region) spec)
+ data-val)))))
+ (setq pos (org-fold-next-folding-state-change nil pos)))))))
(unwind-protect (progn ,@body)
(org-with-wide-buffer
- (dolist (type ,invisible-types)
- (remove-overlays (point-min) (point-max) 'invisible type))
- (pcase-dolist (`(,beg ,end ,type) (delq nil ,data))
- (org-flag-region beg end t type)
+ (dolist (spec ,invisible-specs)
+ (org-fold-region (point-min) (point-max) nil spec))
+ (pcase-dolist (`(,beg ,end ,spec) (delq nil ,data))
+ (org-fold-region beg end t spec)
(when ,markers?
(set-marker beg nil)
(set-marker end nil))))))))
@@ -194,16 +198,8 @@ because otherwise all these markers will point to nowhere."
(when local-variables
(org-with-wide-buffer
(goto-char (point-max))
- ;; If last section is folded, make sure to also hide file
- ;; local variables after inserting them back.
- (let ((overlay
- (cl-find-if (lambda (o)
- (eq 'outline (overlay-get o 'invisible)))
- (overlays-at (1- (point))))))
- (unless (bolp) (insert "\n"))
- (insert local-variables)
- (when overlay
- (move-overlay overlay (overlay-start overlay) (point-max)))))))))
+ (unless (bolp) (insert "\n"))
+ (insert local-variables))))))
(defmacro org-no-popups (&rest body)
"Suppress popup windows and evaluate BODY."
@@ -249,6 +245,44 @@ ignored in this case."
(shrink-window-if-larger-than-buffer window)))
(or window (selected-window)))
+(defun org-buffer-list (&optional predicate exclude-tmp)
+ "Return a list of Org buffers.
+PREDICATE can be `export', `files' or `agenda'.
+
+export restrict the list to Export buffers.
+files restrict the list to buffers visiting Org files.
+agenda restrict the list to buffers visiting agenda files.
+
+If EXCLUDE-TMP is non-nil, ignore temporary buffers."
+ (let* ((bfn nil)
+ (agenda-files (and (eq predicate 'agenda)
+ (mapcar 'file-truename (org-agenda-files t))))
+ (filter
+ (cond
+ ((eq predicate 'files)
+ (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode))))
+ ((eq predicate 'export)
+ (lambda (b) (string-match "\\*Org .*Export" (buffer-name b))))
+ ((eq predicate 'agenda)
+ (lambda (b)
+ (with-current-buffer b
+ (and (derived-mode-p 'org-mode)
+ (setq bfn (buffer-file-name b))
+ (member (file-truename bfn) agenda-files)))))
+ (t (lambda (b) (with-current-buffer b
+ (or (derived-mode-p 'org-mode)
+ (string-match "\\*Org .*Export"
+ (buffer-name b)))))))))
+ (delq nil
+ (mapcar
+ (lambda(b)
+ (if (and (funcall filter b)
+ (or (not exclude-tmp)
+ (not (string-match "tmp" (buffer-name b)))))
+ b
+ nil))
+ (buffer-list)))))
+
;;; File
@@ -683,7 +717,7 @@ When NEXT is non-nil, check the next line instead."
-;;; Overlays
+;;; Overlays and text properties
(defun org-overlay-display (ovl text &optional face evap)
"Make overlay OVL display TEXT with face FACE."
@@ -706,20 +740,22 @@ If DELETE is non-nil, delete all those overlays."
(delete (delete-overlay ov))
(t (push ov found))))))
-(defun org-flag-region (from to flag spec)
- "Hide or show lines from FROM to TO, according to FLAG.
-SPEC is the invisibility spec, as a symbol."
- (remove-overlays from to 'invisible spec)
- ;; Use `front-advance' since text right before to the beginning of
- ;; the overlay belongs to the visible line than to the contents.
- (when flag
- (let ((o (make-overlay from to nil 'front-advance)))
- (overlay-put o 'evaporate t)
- (overlay-put o 'invisible spec)
- (overlay-put o
- 'isearch-open-invisible
- (lambda (&rest _) (org-show-context 'isearch))))))
-
+(defun org-find-text-property-region (pos prop)
+ "Find a region around POS containing same non-nil value of PROP text property.
+Return nil when PROP is not set at POS."
+ (let* ((beg (and (get-text-property pos prop) pos))
+ (end beg))
+ (when beg
+ (unless (or (equal beg (point-min))
+ (not (eq (get-text-property beg prop)
+ (get-text-property (1- beg) prop))))
+ (setq beg (previous-single-property-change pos prop nil (point-min))))
+ (unless (or (equal end (point-max))
+ (not (eq (get-text-property end prop)
+ (get-text-property (1+ end) prop))))
+ (setq end (next-single-property-change pos prop nil (point-max))))
+ (unless (eq beg end)
+ (cons beg end)))))
;;; Regexp matching
@@ -1089,15 +1125,16 @@ the value in cdr."
(get-text-property (or (next-single-property-change 0 prop s) 0)
prop s)))
+;; FIXME: move to org-fold
(defun org-invisible-p (&optional pos folding-only)
"Non-nil if the character after POS is invisible.
If POS is nil, use `point' instead. When optional argument
FOLDING-ONLY is non-nil, only consider invisible parts due to
folding of a headline, a block or a drawer, i.e., not because of
fontification."
- (let ((value (get-char-property (or pos (point)) 'invisible)))
+ (let ((value (invisible-p (or pos (point)))))
(cond ((not value) nil)
- (folding-only (memq value '(org-hide-block outline)))
+ (folding-only (org-fold-folded-p (or pos (point))))
(t value))))
(defun org-truely-invisible-p ()
@@ -1119,14 +1156,14 @@ move it back by one char before doing this check."
(defun org-find-visible ()
"Return closest visible buffer position, or `point-max'"
(if (org-invisible-p)
- (next-single-char-property-change (point) 'invisible)
+ (org-fold-next-visibility-change (point))
(point)))
(defun org-find-invisible ()
"Return closest invisible buffer position, or `point-max'"
(if (org-invisible-p)
(point)
- (next-single-char-property-change (point) 'invisible)))
+ (org-fold-next-visibility-change (point))))
;;; Time
diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el
index 6df567d63..da87dc321 100644
--- a/lisp/org-mobile.el
+++ b/lisp/org-mobile.el
@@ -1064,7 +1064,7 @@ be returned that indicates what went wrong."
(progn
;; Workaround a `org-insert-heading-respect-content' bug
;; which prevents correct insertion when point is invisible
- (org-show-subtree)
+ (org-fold-show-subtree)
(end-of-line 1)
(org-insert-heading-respect-content t)
(org-demote))
diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el
index d88776302..0ae9c00f8 100644
--- a/lisp/org-mouse.el
+++ b/lisp/org-mouse.el
@@ -1005,10 +1005,10 @@ This means, between the beginning of line and the point."
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-hidden-entry)
+ (org-fold-show-hidden-entry)
(save-excursion
(and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
+ (org-fold-heading nil))) ; show the next heading
(org-back-to-heading)
(setq marker (point-marker))
(goto-char (max (point-at-bol) (- (point-at-eol) anticol)))
diff --git a/lisp/org-refile.el b/lisp/org-refile.el
index 7eb0a9643..99e7be13e 100644
--- a/lisp/org-refile.el
+++ b/lisp/org-refile.el
@@ -500,7 +500,7 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(goto-char (cond (pos)
((org-notes-order-reversed-p) (point-min))
(t (point-max))))
- (org-show-context 'org-goto))
+ (org-fold-show-context 'org-goto))
(if regionp
(progn
(org-kill-new (buffer-substring region-start region-end))
diff --git a/lisp/org-src.el b/lisp/org-src.el
index 28733d011..2aa42cc81 100644
--- a/lisp/org-src.el
+++ b/lisp/org-src.el
@@ -1243,8 +1243,7 @@ Throw an error if there is no such buffer."
(goto-char beg)
(cond
;; Block is hidden; move at start of block.
- ((cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block))
- (overlays-at (point)))
+ ((org-fold-get-folding-spec (org-fold-get-folding-spec-for-element 'block))
(beginning-of-line 0))
(write-back (org-src--goto-coordinates coordinates beg end))))
;; Clean up left-over markers and restore window configuration.
diff --git a/lisp/org-timer.el b/lisp/org-timer.el
index 251e3c86b..78c12a645 100644
--- a/lisp/org-timer.el
+++ b/lisp/org-timer.el
@@ -477,7 +477,7 @@ Try to use an Org header, otherwise use the buffer name."
(with-current-buffer (marker-buffer marker)
(org-with-wide-buffer
(goto-char hdmarker)
- (org-show-entry)
+ (org-fold-show-entry)
(or (ignore-errors (org-get-heading))
(buffer-name (buffer-base-buffer))))))))
((derived-mode-p 'org-mode)
diff --git a/lisp/org.el b/lisp/org.el
index a9fdc7b77..0abce58bd 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -94,6 +94,8 @@
(require 'org-keys)
(require 'ol)
(require 'org-table)
+(require 'org-fold)
+(require 'org-cycle)
;; `org-outline-regexp' ought to be a defconst but is let-bound in
;; some places -- e.g. see the macro `org-with-limited-levels'.
@@ -1155,87 +1157,6 @@ are matched against file names, and values."
:tag "Org Structure"
:group 'org)
-(defgroup org-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-reveal' (`\\[org-reveal]') to show
-more context."
- :group 'org-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))))))
-
(defcustom org-indirect-buffer-display 'other-window
"How should indirect tree buffers be displayed?
@@ -1678,29 +1599,6 @@ OK to kill that hidden subtree. When nil, kill without remorse."
:group 'org-edit-structure
:type 'boolean)
-(defcustom org-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)))
-
(defcustom org-yank-folded-subtrees t
"Non-nil means when yanking subtrees, fold them.
If the kill is a single subtree, or a sequence of subtrees, i.e. if
@@ -3970,6 +3868,19 @@ Otherwise, these types are allowed:
:package-version '(Org . "8.3")
:group 'org-sparse-trees)
+(defun org-fold-hide-archived-subtrees (beg end)
+ "Re-hide all archived subtrees after a visibility state change."
+ (org-with-wide-buffer
+ (let ((case-fold-search nil)
+ (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":")))
+ (goto-char beg)
+ ;; Include headline point is currently on.
+ (beginning-of-line)
+ (while (and (< (point) end) (re-search-forward re end t))
+ (when (member org-archive-tag (org-get-tags nil t))
+ (org-fold-subtree t)
+ (org-end-of-subtree t))))))
+
(defun org-cycle-hide-archived-subtrees (state)
"Re-hide all archived subtrees after a visibility state change.
STATE should be one of the symbols listed in the docstring of
@@ -3980,7 +3891,7 @@ STATE should be one of the symbols listed in the docstring of
(let* ((globalp (memq state '(contents all)))
(beg (if globalp (point-min) (point)))
(end (if globalp (point-max) (org-end-of-subtree t))))
- (org-hide-archived-subtrees beg end)
+ (org-fold-hide-archived-subtrees beg end)
(goto-char beg)
(when (looking-at-p (concat ".*:" org-archive-tag ":"))
(message "%s" (substitute-command-keys
@@ -3994,27 +3905,6 @@ STATE should be one of the symbols listed in the docstring of
(let ((org-cycle-open-archived-trees t))
(call-interactively 'org-cycle)))
-(defun org-hide-archived-subtrees (beg end)
- "Re-hide all archived subtrees after a visibility state change."
- (org-with-wide-buffer
- (let ((case-fold-search nil)
- (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":")))
- (goto-char beg)
- ;; Include headline point is currently on.
- (beginning-of-line)
- (while (and (< (point) end) (re-search-forward re end t))
- (when (member org-archive-tag (org-get-tags nil t))
- (org-flag-subtree t)
- (org-end-of-subtree t))))))
-
-(defun org-flag-subtree (flag)
- (save-excursion
- (org-back-to-heading t)
- (org-flag-region (line-end-position)
- (progn (org-end-of-subtree t) (point))
- flag
- 'outline)))
-
(defalias 'org-advertized-archive-subtree 'org-archive-subtree)
;; Declare Column View Code
@@ -4790,7 +4680,7 @@ The following commands are available:
(org-load-modules-maybe)
(org-install-agenda-files-menu)
(when org-link-descriptive (add-to-invisibility-spec '(org-link)))
- (add-to-invisibility-spec '(org-hide-block . t))
+ (org-fold-initialize)
(setq-local outline-regexp org-outline-regexp)
(setq-local outline-level 'org-outline-level)
(setq bidi-paragraph-direction 'left-to-right)
@@ -4895,7 +4785,7 @@ The following commands are available:
t))
(when org-startup-with-inline-images (org-display-inline-images))
(when org-startup-with-latex-preview (org-latex-preview '(16)))
- (unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility))
+ (unless org-inhibit-startup-visibility-stuff (org-cycle-set-startup-visibility))
(when org-startup-truncated (setq truncate-lines t))
(when org-startup-numerated (require 'org-num) (org-num-mode 1))
(when org-startup-indented (require 'org-indent) (org-indent-mode 1))))
@@ -5379,8 +5269,8 @@ by a #."
(end-re "\\(\\\\\\]\\|\\(#\\+end_\\|\\\\end{\\)\\S-+\\)")
(extend (lambda (r1 r2 dir)
(let ((re (replace-regexp-in-string "\\(begin\\|end\\)" r1
- (replace-regexp-in-string "[][]" r2
- (match-string-no-properties 0)))))
+ (replace-regexp-in-string "[][]" r2
+ (match-string-no-properties 0)))))
(re-search-forward (regexp-quote re) nil t dir)))))
(save-match-data
(save-excursion
@@ -5727,35 +5617,56 @@ needs to be inserted at a specific position in the font-lock sequence.")
(decompose-region (point-min) (point-max))
(message "Entities are now displayed as plain text"))))
-(defvar-local org-custom-properties-overlays nil
- "List of overlays used for custom properties.")
+(defvar-local org-custom-properties-hidden-p nil
+ "Non-nil when custom properties are hidden.")
+
+(defcustom org-custom-properties-hide-emptied-drawers nil
+ "Non-nil means that drawers containing only `org-custom-properties' will be hidden together with the properties."
+ :group 'org
+ :type '(choice
+ (const :tag "Don't hide emptied drawers" nil)
+ (const :tag "Hide emptied drawers" t)))
(defun org-toggle-custom-properties-visibility ()
"Display or hide properties in `org-custom-properties'."
(interactive)
- (if org-custom-properties-overlays
- (progn (mapc #'delete-overlay org-custom-properties-overlays)
- (setq org-custom-properties-overlays nil))
+ (require 'org-macs)
+ (org-fold-add-folding-spec 'org-hide-custom-property nil 'no-ellipsis)
+ (if org-custom-properties-hidden-p
+ (let (match)
+ (setq org-custom-properties-hidden-p nil)
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (with-silent-modifications
+ (while (setq match (org-fold-search-forward 'org-hide-custom-property))
+ (org-fold-region (prop-match-beginning match)
+ (prop-match-end match)
+ nil 'org-hide-custom-property)))))
(when org-custom-properties
+ (setq org-custom-properties-hidden-p t)
(org-with-wide-buffer
- (goto-char (point-min))
- (let ((regexp (org-re-property (regexp-opt org-custom-properties) t t)))
+ (let* ((regexp (org-re-property (regexp-opt org-custom-properties) t t))
+ (regexp-drawer (format "%s\n\\(?:%s\\)+\n%s"
+ (replace-regexp-in-string "\\$$" "" org-drawer-regexp)
+ (replace-regexp-in-string "\\(^\\^\\|\\$$\\)" "" regexp)
+ (replace-regexp-in-string "^\\^" "" org-property-end-re))))
+ (when org-custom-properties-hide-emptied-drawers
+ (goto-char (point-min))
+ (while (re-search-forward regexp-drawer nil t)
+ (with-silent-modifications
+ (org-fold-region (1- (match-beginning 0)) (match-end 0) t 'org-hide-custom-property))))
+ (goto-char (point-min))
(while (re-search-forward regexp nil t)
(let ((end (cdr (save-match-data (org-get-property-block)))))
(when (and end (< (point) end))
;; Hide first custom property in current drawer.
- (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0)))))
- (overlay-put o 'invisible t)
- (overlay-put o 'org-custom-property t)
- (push o org-custom-properties-overlays))
- ;; Hide additional custom properties in the same drawer.
- (while (re-search-forward regexp end t)
- (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0)))))
- (overlay-put o 'invisible t)
- (overlay-put o 'org-custom-property t)
- (push o org-custom-properties-overlays)))))
- ;; Each entry is limited to a single property drawer.
- (outline-next-heading)))))))
+ (with-silent-modifications
+ (org-fold-region (match-beginning 0) (1+ (match-end 0)) t 'org-hide-custom-property)
+ ;; Hide additional custom properties in the same drawer.
+ (while (re-search-forward regexp end t)
+ (org-fold-region (match-beginning 0) (1+ (match-end 0)) t 'org-hide-custom-property))))))
+ ;; Each entry is limited to a single property drawer.
+ (outline-next-heading))))))
(defun org-fontify-entities (limit)
"Find an entity to fontify."
@@ -5971,808 +5882,11 @@ open and agenda-wise Org files."
(set-window-start window (line-beginning-position))))))
-;;; Visibility (headlines, blocks, drawers)
-
-;;;; Headlines visibility
-
-(defun org-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-flag-region
- (line-end-position 0)
- (save-excursion
- (if (re-search-forward
- (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t)
- (match-beginning 1)
- (point-max)))
- nil
- 'outline)
- (org-cycle-hide-drawers 'children)))
-
-(defun org-hide-entry ()
- "Hide the body directly following its heading."
- (interactive)
- (save-excursion
- (org-back-to-heading-or-point-min t)
- (when (org-at-heading-p) (forward-line))
- (org-flag-region
- (line-end-position 0)
- (save-excursion
- (if (re-search-forward
- (concat "[\r\n]" org-outline-regexp) nil t)
- (line-end-position 0)
- (point-max)))
- t
- 'outline)))
-
-(defun org-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-flag-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-flag-heading nil))))))
-
-(defun org-show-subtree ()
- "Show everything after this heading at deeper levels."
- (interactive)
- (org-flag-region
- (point) (save-excursion (org-end-of-subtree t t)) nil 'outline))
-
-;;;; Blocks and drawers visibility
-
-(defun org--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 (if (eq category 'block) 'org-hide-block 'outline))
- (flag
- (cond ((eq force 'off) nil)
- (force t)
- ((eq spec (get-char-property start 'invisible)) nil)
- (t t))))
- (org-flag-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-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--hide-wrapper-toggle
- (or element (org-element-at-point)) 'block force no-error))
-
-(defun org-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--hide-wrapper-toggle
- (or element (org-element-at-point)) 'drawer force no-error))
-
-(defun org-hide-block-all ()
- "Fold all blocks in the current buffer."
- (interactive)
- (org-show-all '(blocks))
- (org-block-map 'org-hide-block-toggle))
-
-(defun org-hide-drawer-all ()
- "Fold all drawers in the current buffer."
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward org-drawer-regexp nil t)
- (let* ((pair (get-char-property-and-overlay (line-beginning-position)
- 'invisible))
- (o (cdr-safe pair)))
- (if (overlayp o) (goto-char (overlay-end o)) ;invisible drawer
- (pcase (get-char-property-and-overlay (point) 'invisible)
- (`(outline . ,o) (goto-char (overlay-end o))) ;already folded
- (_
- (let* ((drawer (org-element-at-point))
- (type (org-element-type drawer)))
- (when (memq type '(drawer property-drawer))
- (org-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)))))))))))
-
-(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)
- (pcase (get-char-property-and-overlay (point) 'invisible)
- ;; Do not fold already folded drawers.
- (`(outline . ,o) (goto-char (overlay-end o)))
- (_
- (let ((drawer (org-element-at-point)))
- (when (memq (org-element-type drawer) '(drawer property-drawer))
- (org-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)))))))))))
-
-;;;; Visibility cycling
-
-(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-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 TYPE is a list of symbols among `blocks',
-`drawers' and `headings', to only expand one specific type."
- (interactive)
- (let ((types (or types '(blocks drawers headings))))
- (when (memq 'blocks types)
- (org-flag-region (point-min) (point-max) nil 'org-hide-block))
- (cond
- ;; Fast path. Since headings and drawers share the same
- ;; invisible spec, clear everything in one go.
- ((and (memq 'headings types)
- (memq 'drawers types))
- (org-flag-region (point-min) (point-max) nil 'outline))
- ((memq 'headings types)
- (org-flag-region (point-min) (point-max) nil 'outline)
- (org-cycle-hide-drawers 'all))
- ((memq 'drawers types)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward org-drawer-regexp nil t)
- (let* ((pair (get-char-property-and-overlay (line-beginning-position)
- 'invisible))
- (o (cdr-safe pair)))
- (if (overlayp o) (goto-char (overlay-end o))
- (pcase (get-char-property-and-overlay (point) 'invisible)
- (`(outline . ,o)
- (goto-char (overlay-end o))
- (delete-overlay o))
- (_ nil))))))))))
-
-;;;###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-set-startup-visibility)
- (org-unlogged-message "Startup visibility, plus VISIBILITY properties"))
- ((equal arg '(64))
- (org-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-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-hide-block-toggle nil t element))
- ;; Try toggling visibility for drawer at point.
- ((org-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-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)))))
+;; FIXME: It was in the middle of visibility section. Where should it go to?
(defvar org-called-with-limited-levels nil
"Non-nil when `org-with-limited-levels' is currently active.")
-(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'
- (get-char-property (1- (point)) 'invisible))
- (goto-char (next-single-char-property-change (point) 'invisible))
- (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)
- (outline-next-heading)
- (when (org-invisible-p) (org-flag-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-show-entry)
- (org-with-limited-levels (org-show-children))
- (org-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)
- (outline-next-heading)
- (when (org-invisible-p) (org-flag-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-flag-region eoh eos nil 'outline)
- (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-flag-region eoh eos t 'outline)
- (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-set-startup-visibility)
- (org-unlogged-message "Startup visibility, plus VISIBILITY properties."))
- (t
- (org-cycle '(4)))))
-
-(defun org-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-show-all)))
- (unless (eq org-startup-folded 'showeverything)
- (when org-hide-block-startup (org-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-flag-subtree t)
- (org-reveal)
- (pcase state
- ("folded"
- (org-flag-subtree t))
- ("children"
- (org-show-hidden-entry)
- (org-show-children))
- ("content"
- (save-excursion
- (save-restriction
- (org-narrow-to-subtree)
- (org-content))))
- ((or "all" "showall")
- (outline-show-subtree))
- (_ nil)))
- (org-end-of-subtree)))))))
-
-(defun org-overview ()
- "Switch to overview mode, showing only top-level headlines."
- (interactive)
- (org-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-flag-region last (line-end-position 0) t 'outline)
- (setq last (line-end-position))
- (setq level (- (match-end 0) (match-beginning 0) 1))
- (setq regexp (format "^\\*\\{1,%d\\} " level)))
- (org-flag-region last (point) t 'outline)))))
-
-(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-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-flag-region (line-end-position) last t 'outline)
- (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)))
- (outline-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 (get-char-property (match-end 1) 'invisible)
- (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-flag-region b e nil 'outline))))))))
- ;; 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-flag-region (point) (match-end 0) nil 'outline))))
-
-;;;; Reveal point location
-
-(defun org-show-context (&optional key)
- "Make sure point and context are visible.
-Optional argument KEY, when non-nil, is a symbol. See
-`org-show-context-detail' for allowed values and how much is to
-be shown."
- (org-show-set-visibility
- (cond ((symbolp org-show-context-detail) org-show-context-detail)
- ((cdr (assq key org-show-context-detail)))
- (t (cdr (assq 'default org-show-context-detail))))))
-
-(defun org-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-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-flag-heading nil)
- (org-show-entry)
- ;; If point is hidden within a drawer or a block, make sure to
- ;; expose it.
- (dolist (o (overlays-at (point)))
- (when (memq (overlay-get o 'invisible) '(org-hide-block outline))
- (delete-overlay o)))
- (unless (org-before-first-heading-p)
- (org-with-limited-levels
- (cl-case detail
- ((tree canonical t) (org-show-children))
- ((nil minimal ancestors))
- (t (save-excursion
- (outline-next-heading)
- (org-flag-heading nil)))))))
- ;; Show all siblings.
- (when (eq detail 'lineage) (org-show-siblings))
- ;; Show ancestors, possibly with their children.
- (when (memq detail '(ancestors lineage tree canonical t))
- (save-excursion
- (while (org-up-heading-safe)
- (org-flag-heading nil)
- (when (memq detail '(canonical t)) (org-show-entry))
- (when (memq detail '(tree canonical t)) (org-show-children))))))
-
-(defvar org-reveal-start-hook nil
- "Hook run before revealing a location.")
-
-(defun org-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-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-reveal-start-hook)
- (cond ((equal siblings '(4)) (org-show-set-visibility 'canonical))
- ((equal siblings '(16))
- (save-excursion
- (when (org-up-heading-safe)
- (org-show-subtree)
- (run-hook-with-args 'org-cycle-hook 'subtree))))
- (t (org-show-set-visibility 'lineage))))
-
;;; Indirect buffer display of subtrees
@@ -6841,7 +5955,7 @@ frame is not changed."
(pop-to-buffer ibuf))
(t (error "Invalid value")))
(narrow-to-region beg end)
- (org-show-all '(headings drawers blocks))
+ (org-fold-show-all '(headings drawers blocks))
(goto-char pos)
(run-hook-with-args 'org-cycle-hook 'all)
(and (window-live-p cwin) (select-window cwin))))
@@ -6945,10 +6059,10 @@ unconditionally."
;; When INVISIBLE-OK is non-nil, ensure newly created headline
;; is visible.
(unless invisible-ok
- (pcase (get-char-property-and-overlay (point) 'invisible)
- (`(outline . ,o)
- (move-overlay o (overlay-start o) (line-end-position 0)))
- (_ nil))))
+ (cond
+ ((eq (org-fold-get-folding-spec nil (line-beginning-position)) (org-fold-get-folding-spec-for-element 'headline))
+ (org-fold-region (line-end-position 0) (line-end-position) nil (org-fold-get-folding-spec-for-element 'headline)))
+ (t nil))))
;; At a headline...
((org-at-heading-p)
(cond ((bolp)
@@ -7483,7 +6597,7 @@ case."
(goto-char (point-min))
;; First check if there are no even levels
(when (re-search-forward "^\\(\\*\\*\\)+ " nil t)
- (org-show-set-visibility 'canonical)
+ (org-fold-show-set-visibility 'canonical)
(error "Not all levels are odd in this file. Conversion not possible"))
(when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
(let ((outline-regexp org-outline-regexp)
@@ -7546,9 +6660,8 @@ case."
(setq txt (buffer-substring beg end))
(org-save-markers-in-region beg end)
(delete-region beg end)
- (org-remove-empty-overlays-at beg)
- (unless (= beg (point-min)) (org-flag-region (1- beg) beg nil 'outline))
- (unless (bobp) (org-flag-region (1- (point)) (point) nil 'outline))
+ (unless (= beg (point-min)) (org-fold-region (1- beg) beg nil (org-fold-get-folding-spec-for-element 'headline)))
+ (unless (bobp) (org-fold-region (1- (point)) (point) nil (org-fold-get-folding-spec-for-element 'headline)))
(and (not (bolp)) (looking-at "\n") (forward-char 1))
(let ((bbb (point)))
(insert-before-markers txt)
@@ -7559,9 +6672,9 @@ case."
(org-skip-whitespace)
(move-marker ins-point nil)
(if folded
- (org-flag-subtree t)
- (org-show-entry)
- (org-show-children))
+ (org-fold-subtree t)
+ (org-fold-show-entry)
+ (org-fold-show-children))
(org-clean-visibility-after-subtree-move)
;; move back to the initial column we were at
(move-to-column col))))
@@ -7708,7 +6821,7 @@ When REMOVE is non-nil, remove the subtree from the clipboard."
(skip-chars-forward " \t\n\r")
(setq beg (point))
(when (and (org-invisible-p) visp)
- (save-excursion (outline-show-heading)))
+ (save-excursion (org-fold-heading nil)))
;; Shift if necessary.
(unless (= shift 0)
(save-restriction
@@ -7725,7 +6838,7 @@ When REMOVE is non-nil, remove the subtree from the clipboard."
(equal org-subtree-clip (current-kill 0))
org-subtree-clip-folded)
;; The tree was folded before it was killed/copied
- (org-flag-subtree t))
+ (org-fold-subtree t))
(when for-yank (goto-char newend))
(when remove (pop kill-ring)))))
@@ -7904,7 +7017,7 @@ with the original repeater."
(insert template)
(org-mode)
(goto-char (point-min))
- (org-show-subtree)
+ (org-fold-show-subtree)
(and idprop (if org-clone-delete-id
(org-entry-delete nil "ID")
(org-id-get-create t)))
@@ -8153,7 +7266,7 @@ function is being called interactively."
(point))
what "children")
(goto-char start)
- (outline-show-subtree)
+ (org-fold-show-subtree)
(outline-next-heading))
(t
;; we will sort the top-level entries in this file
@@ -8169,7 +7282,7 @@ function is being called interactively."
(setq end (point-max))
(setq what "top-level")
(goto-char start)
- (org-show-all '(headings drawers blocks))))
+ (org-fold-show-all '(headings drawers blocks))))
(setq beg (point))
(when (>= beg end) (goto-char start) (user-error "Nothing to sort"))
@@ -8469,12 +7582,13 @@ the whole buffer."
(org-end-of-subtree t t))
((outline-next-heading))
((point-max))))))
- (if (symbolp tprop)
- ;; TPROP is a text property symbol.
- (put-text-property start end tprop p)
- ;; TPROP is an alist with (property . function) elements.
- (pcase-dolist (`(,prop . ,f) tprop)
- (put-text-property start end prop (funcall f p)))))))
+ (with-silent-modifications
+ (if (symbolp tprop)
+ ;; TPROP is a text property symbol.
+ (put-text-property start end tprop p)
+ ;; TPROP is an alist with (property . function) elements.
+ (pcase-dolist (`(,prop . ,f) tprop)
+ (put-text-property start end prop (funcall f p))))))))
(defun org-refresh-category-properties ()
"Refresh category text properties in the buffer."
@@ -8735,7 +7849,7 @@ If the file does not exist, throw an error."
(funcall (cdr (assq 'file org-link-frame-setup)) file)
(widen)
(cond (line (org-goto-line line)
- (when (derived-mode-p 'org-mode) (org-reveal)))
+ (when (derived-mode-p 'org-mode) (org-fold-reveal)))
(search (condition-case err
(org-link-search search)
;; Save position before error-ing out so user
@@ -9029,7 +8143,7 @@ or to another Org file, automatically push the old position onto the ring."
(setq m (car p))
(pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
- (when (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
+ (when (or (org-invisible-p) (org-invisible-p2)) (org-fold-show-context 'mark-goto))))
;;; Following specific links
@@ -10769,7 +9883,8 @@ narrowing."
(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 'drawer)))
(end-of-line -1)))))
(t
(org-end-of-meta-data org-log-state-notes-insert-after-drawers)
@@ -10834,19 +9949,19 @@ EXTRA is additional text that will be inserted into the notes buffer."
(insert (format "# Insert note for %s.
# Finish with C-c C-c, or cancel with C-c C-k.\n\n"
(cl-case org-log-note-purpose
- (clock-out "stopped clock")
- (done "closed todo item")
- (reschedule "rescheduling")
- (delschedule "no longer scheduled")
- (redeadline "changing deadline")
- (deldeadline "removing deadline")
- (refile "refiling")
- (note "this entry")
- (state
- (format "state change from \"%s\" to \"%s\""
- (or org-log-note-previous-state "")
- (or org-log-note-state "")))
- (t (error "This should not happen")))))
+ (clock-out "stopped clock")
+ (done "closed todo item")
+ (reschedule "rescheduling")
+ (delschedule "no longer scheduled")
+ (redeadline "changing deadline")
+ (deldeadline "removing deadline")
+ (refile "refiling")
+ (note "this entry")
+ (state
+ (format "state change from \"%s\" to \"%s\""
+ (or org-log-note-previous-state "")
+ (or org-log-note-state "")))
+ (t (error "This should not happen")))))
(when org-log-note-extra (insert org-log-note-extra))
(setq-local org-finish-function 'org-store-log-note)
(run-hooks 'org-log-buffer-setup-hook)))
@@ -11030,7 +10145,7 @@ as well.")
"Make a compact tree showing all matches of REGEXP.
The tree will show the lines where the regexp matches, and any other context
-defined in `org-show-context-detail', which see.
+defined in `org-fold-show-context-detail', which see.
When optional argument KEEP-PREVIOUS is non-nil, highlighting and exposing
done by a previous call to `org-occur' will be kept, to allow stacking of
@@ -11062,12 +10177,12 @@ The function must neither move point nor alter narrowing."
(setq cnt (1+ cnt))
(when org-highlight-sparse-tree-matches
(org-highlight-new-match (match-beginning 0) (match-end 0)))
- (org-show-context 'occur-tree)))))
+ (org-fold-show-context 'occur-tree)))))
(when org-remove-highlights-with-change
(add-hook 'before-change-functions 'org-remove-occur-highlights
nil 'local))
(unless org-sparse-tree-open-archived-trees
- (org-hide-archived-subtrees (point-min) (point-max)))
+ (org-fold-hide-archived-subtrees (point-min) (point-max)))
(run-hooks 'org-occur-hook)
(when (called-interactively-p 'interactive)
(message "%d match(es) for regexp %s" cnt regexp))
@@ -11180,9 +10295,9 @@ or a character."
(number-to-string org-priority-highest)
(number-to-string org-priority-lowest))))
(progn (message "Priority %c-%c, SPC to remove: "
- org-priority-highest org-priority-lowest)
- (save-match-data
- (setq new (read-char-exclusive)))))))
+ org-priority-highest org-priority-lowest)
+ (save-match-data
+ (setq new (read-char-exclusive)))))))
(when (and (= (upcase org-priority-highest) org-priority-highest)
(= (upcase org-priority-lowest) org-priority-lowest))
(setq new (upcase new)))
@@ -11422,7 +10537,7 @@ headlines matching this string."
(org-get-heading) (match-end 0)
(org-highlight-new-match
(match-beginning 1) (match-end 1)))
- (org-show-context 'tags-tree))
+ (org-fold-show-context 'tags-tree))
((eq action 'agenda)
(setq txt (org-agenda-format-item
""
@@ -11460,7 +10575,7 @@ headlines matching this string."
(and (= (point) lspos) (end-of-line 1)))))
(when (and (eq action 'sparse-tree)
(not org-sparse-tree-open-archived-trees))
- (org-hide-archived-subtrees (point-min) (point-max)))
+ (org-fold-hide-archived-subtrees (point-min) (point-max)))
(nreverse rtn)))
(defun org-remove-uninherited-tags (tags)
@@ -11987,7 +11102,7 @@ This function assumes point is on a headline."
;; boundary, it can be inadvertently sucked into
;; invisibility.
(unless (org-invisible-p (line-beginning-position))
- (org-flag-region (point) (line-end-position) nil 'outline))))
+ (org-fold-region (point) (line-end-position) nil (org-fold-get-folding-spec-for-element 'headline)))))
;; Align tags, if any.
(when tags (org-align-tags))
(when tags-change? (run-hooks 'org-after-tags-change-hook)))))
@@ -12528,12 +11643,12 @@ it will be found. If the drawer does not exist, create it if
FORCE is non-nil, or return nil."
(org-with-wide-buffer
(let ((beg (cond (beg (goto-char beg))
- ((or (not (featurep 'org-inlinetask))
- (org-inlinetask-in-task-p))
- (org-back-to-heading-or-point-min t) (point))
- (t (org-with-limited-levels
- (org-back-to-heading-or-point-min t))
- (point)))))
+ ((or (not (featurep 'org-inlinetask))
+ (org-inlinetask-in-task-p))
+ (org-back-to-heading-or-point-min t) (point))
+ (t (org-with-limited-levels
+ (org-back-to-heading-or-point-min t))
+ (point)))))
;; Move point to its position according to its positional rules.
(cond ((org-before-first-heading-p)
(while (and (org-at-comment-p) (bolp)) (forward-line)))
@@ -13223,7 +12338,7 @@ drawer is immediately hidden."
(inhibit-read-only t))
(unless (bobp) (insert "\n"))
(insert ":PROPERTIES:\n:END:")
- (org-flag-region (line-end-position 0) (point) t 'outline)
+ (org-fold-region (line-end-position 0) (point) t (org-fold-get-folding-spec-for-element 'drawer))
(when (or (eobp) (= begin (point-min))) (insert "\n"))
(org-indent-region begin (point))))))
@@ -15038,7 +14153,7 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like
(message "No clock to adjust")
(save-excursion
(org-goto-marker-or-bmk clfixpos)
- (org-show-subtree)
+ (org-fold-show-subtree)
(when (re-search-forward clrgx nil t)
(goto-char (match-beginning 1))
(let (org-clock-adjust-closest)
@@ -15241,44 +14356,6 @@ prefix, restrict available buffers to agenda files."
(mapcar #'list (mapcar #'buffer-name blist))
nil t))))
-(defun org-buffer-list (&optional predicate exclude-tmp)
- "Return a list of Org buffers.
-PREDICATE can be `export', `files' or `agenda'.
-
-export restrict the list to Export buffers.
-files restrict the list to buffers visiting Org files.
-agenda restrict the list to buffers visiting agenda files.
-
-If EXCLUDE-TMP is non-nil, ignore temporary buffers."
- (let* ((bfn nil)
- (agenda-files (and (eq predicate 'agenda)
- (mapcar 'file-truename (org-agenda-files t))))
- (filter
- (cond
- ((eq predicate 'files)
- (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode))))
- ((eq predicate 'export)
- (lambda (b) (string-match "\\*Org .*Export" (buffer-name b))))
- ((eq predicate 'agenda)
- (lambda (b)
- (with-current-buffer b
- (and (derived-mode-p 'org-mode)
- (setq bfn (buffer-file-name b))
- (member (file-truename bfn) agenda-files)))))
- (t (lambda (b) (with-current-buffer b
- (or (derived-mode-p 'org-mode)
- (string-match "\\*Org .*Export"
- (buffer-name b)))))))))
- (delq nil
- (mapcar
- (lambda(b)
- (if (and (funcall filter b)
- (or (not exclude-tmp)
- (not (string-match "tmp" (buffer-name b)))))
- b
- nil))
- (buffer-list)))))
-
(defun org-agenda-files (&optional unrestricted archives)
"Get the list of agenda files.
Optional UNRESTRICTED means return the full list even if a restriction
@@ -16494,12 +15571,20 @@ buffer boundaries with possible narrowing."
(defvar org-self-insert-command-undo-counter 0)
(defvar org-speed-command nil)
+(defun org-fix-tags-on-the-fly ()
+ "Align tags in headline at point.
+Unlike `org-align-tags', this function does nothing if point is
+either not currently on a tagged headline or on a tag."
+ (when (and (org-match-line org-tag-line-re)
+ (< (point) (match-beginning 1)))
+ (org-align-tags)))
+
(defun org-self-insert-command (N)
"Like `self-insert-command', use overwrite-mode for whitespace in tables.
If the cursor is in a table looking at whitespace, the whitespace is
overwritten, and the table is not marked as requiring realignment."
(interactive "p")
- (org-check-before-invisible-edit 'insert)
+ (org-fold-check-before-invisible-edit 'insert)
(cond
((and org-use-speed-commands
(let ((kv (this-command-keys-vector)))
@@ -16561,80 +15646,6 @@ overwritten, and the table is not marked as requiring realignment."
(setq org-self-insert-command-undo-counter
(1+ org-self-insert-command-undo-counter))))))))
-(defun org-check-before-invisible-edit (kind)
- "Check is editing if kind KIND would be dangerous with invisible text around.
-The detailed reaction depends on the user option `org-catch-invisible-edits'."
- ;; First, try to get out of here as quickly as possible, to reduce overhead
- (when (and org-catch-invisible-edits
- (or (not (boundp 'visible-mode)) (not visible-mode))
- (or (get-char-property (point) 'invisible)
- (get-char-property (max (point-min) (1- (point))) 'invisible)))
- ;; OK, we need to take a closer look. Do not consider
- ;; invisibility obtained through text properties (e.g., link
- ;; fontification), as it cannot be toggled.
- (let* ((invisible-at-point
- (pcase (get-char-property-and-overlay (point) 'invisible)
- (`(,_ . ,(and (pred overlayp) o)) o)))
- ;; Assume that point cannot land in the middle of an
- ;; overlay, or between two overlays.
- (invisible-before-point
- (and (not invisible-at-point)
- (not (bobp))
- (pcase (get-char-property-and-overlay (1- (point)) 'invisible)
- (`(,_ . ,(and (pred overlayp) o)) o))))
- (border-and-ok-direction
- (or
- ;; Check if we are acting predictably before invisible
- ;; text.
- (and invisible-at-point
- (memq kind '(insert delete-backward)))
- ;; Check if we are acting predictably after invisible text
- ;; This works not well, and I have turned it off. It seems
- ;; better to always show and stop after invisible text.
- ;; (and (not invisible-at-point) invisible-before-point
- ;; (memq kind '(insert delete)))
- )))
- (when (or invisible-at-point invisible-before-point)
- (when (eq org-catch-invisible-edits 'error)
- (user-error "Editing in invisible areas is prohibited, make them visible first"))
- (if (and org-custom-properties-overlays
- (y-or-n-p "Display invisible properties in this buffer? "))
- (org-toggle-custom-properties-visibility)
- ;; Make the area visible
- (save-excursion
- (when invisible-before-point
- (goto-char
- (previous-single-char-property-change (point) 'invisible)))
- ;; Remove whatever overlay is currently making yet-to-be
- ;; edited text invisible. Also remove nested invisibility
- ;; related overlays.
- (delete-overlay (or invisible-at-point invisible-before-point))
- (let ((origin (if invisible-at-point (point) (1- (point)))))
- (while (pcase (get-char-property-and-overlay origin 'invisible)
- (`(,_ . ,(and (pred overlayp) o))
- (delete-overlay o)
- t)))))
- (cond
- ((eq org-catch-invisible-edits 'show)
- ;; That's it, we do the edit after showing
- (message
- "Unfolding invisible region around point before editing")
- (sit-for 1))
- ((and (eq org-catch-invisible-edits 'smart)
- border-and-ok-direction)
- (message "Unfolding invisible region around point before editing"))
- (t
- ;; Don't do the edit, make the user repeat it in full visibility
- (user-error "Edit in invisible region aborted, repeat to confirm with text visible"))))))))
-
-(defun org-fix-tags-on-the-fly ()
- "Align tags in headline at point.
-Unlike `org-align-tags', this function does nothing if point is
-either not currently on a tagged headline or on a tag."
- (when (and (org-match-line org-tag-line-re)
- (< (point) (match-beginning 1)))
- (org-align-tags)))
-
(defun org-delete-backward-char (N)
"Like `delete-backward-char', insert whitespace at field end in tables.
When deleting backwards, in tables this function will insert whitespace in
@@ -16643,7 +15654,7 @@ still be marked for re-alignment if the field did fill the entire column,
because, in this case the deletion might narrow the column."
(interactive "p")
(save-match-data
- (org-check-before-invisible-edit 'delete-backward)
+ (org-fold-check-before-invisible-edit 'delete-backward)
(if (and (= N 1)
(not overwrite-mode)
(not (org-region-active-p))
@@ -16663,7 +15674,7 @@ still be marked for re-alignment if the field did fill the entire column,
because, in this case the deletion might narrow the column."
(interactive "p")
(save-match-data
- (org-check-before-invisible-edit 'delete)
+ (org-fold-check-before-invisible-edit 'delete)
(cond
((or (/= N 1)
(eq (char-after) ?|)
@@ -17015,14 +16026,14 @@ this function returns t, nil otherwise."
(setq beg (point-at-bol))
(beginning-of-line 2)
(while (and (not (eobp)) ;; this is like `next-line'
- (get-char-property (1- (point)) 'invisible))
+ (org-invisible-p (1- (point))))
(beginning-of-line 2))
(setq end (point))
(goto-char beg)
(goto-char (point-at-eol))
(setq end (max end (point)))
(while (re-search-forward re end t)
- (when (get-char-property (match-beginning 0) 'invisible)
+ (when (org-invisible-p (match-beginning 0))
(throw 'exit t))))
nil))))
@@ -17304,9 +16315,9 @@ this numeric value."
(interactive "r")
(let ((result ""))
(while (/= beg end)
- (when (get-char-property beg 'invisible)
- (setq beg (next-single-char-property-change beg 'invisible nil end)))
- (let ((next (next-single-char-property-change beg 'invisible nil end)))
+ (while (org-invisible-p beg)
+ (setq beg (org-fold-next-visibility-change beg end)))
+ (let ((next (org-fold-next-visibility-change beg end)))
(setq result (concat result (buffer-substring beg next)))
(setq beg next)))
(setq deactivate-mark t)
@@ -17669,39 +16680,20 @@ Use `\\[org-edit-special]' to edit table.el tables"))
(org-reset-file-cache))
(message "%s restarted" major-mode))
-(defun org-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-flag-region 1 (1- (point)) (not arg) 'outline)))
-
-(defun org-show-branches-buffer ()
- "Show all branches in the buffer."
- (org-flag-above-first-heading)
- (outline-hide-sublevels 1)
- (unless (eobp)
- (outline-show-branches)
- (while (outline-get-next-sibling)
- (outline-show-branches)))
- (goto-char (point-min)))
-
(defun org-kill-note-or-show-branches ()
"Abort storing current note, or show just branches."
(interactive)
(cond (org-finish-function
(let ((org-note-abort t)) (funcall org-finish-function)))
((org-before-first-heading-p)
- (org-show-branches-buffer)
- (org-hide-archived-subtrees (point-min) (point-max)))
+ (org-fold-show-branches-buffer)
+ (org-fold-hide-archived-subtrees (point-min) (point-max)))
(t
(let ((beg (progn (org-back-to-heading) (point)))
(end (save-excursion (org-end-of-subtree t t) (point))))
- (outline-hide-subtree)
- (outline-show-branches)
- (org-hide-archived-subtrees beg end)))))
+ (org-fold-hide-subtree)
+ (org-fold-show-branches)
+ (org-fold-hide-archived-subtrees beg end)))))
(defun org-delete-indentation (&optional arg)
"Join current line to previous and fix whitespace at join.
@@ -17823,7 +16815,7 @@ object (e.g., within a comment). In these case, you need to use
(org-auto-align-tags (org-align-tags))
(t (org--align-tags-here tags-column))) ;preserve tags column
(end-of-line)
- (org-show-entry)
+ (org-fold-show-entry)
(org--newline indent arg interactive)
(when string (save-excursion (insert (org-trim string))))))
;; In a list, make sure indenting keeps trailing text within.
@@ -17860,11 +16852,11 @@ level to hide."
(call-interactively #'org-table-toggle-column-width))
((org-before-first-heading-p)
(save-excursion
- (org-flag-above-first-heading)
- (outline-hide-sublevels (or arg 1))))
+ (org-fold-flag-above-first-heading)
+ (org-fold-hide-sublevels (or arg 1))))
(t
- (outline-hide-subtree)
- (org-show-children arg))))
+ (org-fold-hide-subtree)
+ (org-fold-show-children arg))))
(defun org-ctrl-c-star ()
"Compute table, or change heading status of lines.
@@ -18000,7 +16992,7 @@ Calls `org-insert-heading', `org-insert-item' or
`org-table-wrap-region', depending on context. When called with
an argument, unconditionally call `org-insert-heading'."
(interactive "P")
- (org-check-before-invisible-edit 'insert)
+ (org-fold-check-before-invisible-edit 'insert)
(or (run-hook-with-args-until-success 'org-metareturn-hook)
(call-interactively (cond (arg #'org-insert-heading)
((org-at-table-p) #'org-table-wrap-region)
@@ -18020,8 +17012,8 @@ an argument, unconditionally call `org-insert-heading'."
["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))]
["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))]
["Sparse Tree..." org-sparse-tree t]
- ["Reveal Context" org-reveal t]
- ["Show All" org-show-all t]
+ ["Reveal Context" org-fold-reveal t]
+ ["Show All" org-fold-show-all t]
"--"
["Subtree to indirect buffer" org-tree-to-indirect-buffer t])
"--"
@@ -18483,7 +17475,7 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(when (or (> marker (point-max)) (< marker (point-min)))
(widen))
(goto-char marker)
- (org-show-context 'org-goto))
+ (org-fold-show-context 'org-goto))
(if bookmark
(bookmark-jump bookmark)
(error "Cannot find location"))))
@@ -18718,7 +17710,7 @@ block from point."
regexp)))
(add-hook 'occur-mode-find-occurrence-hook
- (lambda () (when (derived-mode-p 'org-mode) (org-reveal))))
+ (lambda () (when (derived-mode-p 'org-mode) (org-fold-reveal))))
(defun org-occur-link-in-agenda-files ()
"Create a link and search for it in the agendas.
@@ -19626,7 +18618,7 @@ Throw an error if no block is found."
(cl-decf count))))
(if (= count 0)
(prog1 (goto-char (org-element-property :post-affiliated last-element))
- (save-match-data (org-show-context)))
+ (save-match-data (org-fold-show-context)))
(goto-char origin)
(user-error "No %s code blocks" (if backward "previous" "further")))))
@@ -20107,7 +19099,7 @@ depending on context."
((or (not org-special-ctrl-k)
(bolp)
(not (org-at-heading-p)))
- (when (and (get-char-property (line-end-position) 'invisible)
+ (when (and (org-invisible-p (line-end-position))
org-ctrl-k-protect-subtree
(or (eq org-ctrl-k-protect-subtree 'error)
(not (y-or-n-p "Kill hidden subtree along with headline? "))))
@@ -20190,12 +19182,12 @@ interactive command with similar behavior."
(goto-char beg)
(when (and (bolp) subtreep
(not (setq swallowp
- (org-yank-folding-would-swallow-text beg end))))
+ (org-yank-folding-would-swallow-text beg end))))
(org-with-limited-levels
(or (looking-at org-outline-regexp)
(re-search-forward org-outline-regexp-bol end t))
(while (and (< (point) end) (looking-at org-outline-regexp))
- (org-flag-subtree t)
+ (org-fold-subtree t)
(org-cycle-show-empty-lines 'folded)
(condition-case nil
(outline-forward-same-level 1)
@@ -20233,7 +19225,10 @@ interactive command with similar behavior."
(defun org-back-to-heading (&optional invisible-ok)
"Call `outline-back-to-heading', but provide a better error message."
(condition-case nil
- (outline-back-to-heading invisible-ok)
+ (if (and (featurep 'org-inlinetask) (org-inlinetask-in-task-p))
+ (outline-back-to-heading invisible-ok)
+ (org-with-limited-levels
+ (outline-back-to-heading invisible-ok)))
(error
(user-error "Before first headline at position %d in buffer %s"
(point) (current-buffer)))))
@@ -20392,14 +19387,6 @@ move point."
(goto-char pos)
nil))))
-(defun org-show-siblings ()
- "Show all siblings of the current headline."
- (save-excursion
- (while (org-goto-sibling) (org-flag-heading nil)))
- (save-excursion
- (while (org-goto-sibling 'previous)
- (org-flag-heading nil))))
-
(defun org-goto-first-child ()
"Goto the first child, even if it is invisible.
Return t when a child was found. Otherwise don't move point and
@@ -20412,25 +19399,6 @@ return nil."
(progn (goto-char (match-beginning 0)) t)
(goto-char pos) nil))))
-(defun org-show-hidden-entry ()
- "Show an entry where even the heading is hidden."
- (save-excursion
- (org-show-entry)))
-
-(defun org-flag-heading (flag &optional entry)
- "Flag 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-flag-region
- (line-end-position 0) (line-end-position) flag 'outline)
- (org-show-entry)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))))))
-
(defun org-get-next-sibling ()
"Move to next heading of the same level, and return point.
If there is no such heading, return nil.
@@ -20589,20 +19557,16 @@ With ARG, repeats or can move backward if negative."
(end-of-line))
(while (and (< arg 0) (re-search-backward regexp nil :move))
(unless (bobp)
- (while (pcase (get-char-property-and-overlay (point) 'invisible)
- (`(outline . ,o)
- (goto-char (overlay-start o))
- (re-search-backward regexp nil :move))
- (_ nil))))
+ (when (org-fold-folded-p)
+ (goto-char (org-fold-previous-visibility-change))
+ (unless (looking-at-p regexp)
+ (re-search-backward regexp nil :mode))))
(cl-incf arg))
- (while (and (> arg 0) (re-search-forward regexp nil t))
- (while (pcase (get-char-property-and-overlay (point) 'invisible)
- (`(outline . ,o)
- (goto-char (overlay-end o))
- (re-search-forward regexp nil :move))
- (_
- (end-of-line)
- nil))) ;leave the loop
+ (while (and (> arg 0) (re-search-forward regexp nil :move))
+ (when (org-fold-folded-p)
+ (goto-char (org-fold-next-visibility-change))
+ (skip-chars-forward " \t\n")
+ (end-of-line))
(cl-decf arg))
(if (> arg 0) (goto-char (point-max)) (beginning-of-line))))
@@ -20747,9 +19711,10 @@ See `org-forward-paragraph'."
(cond
((eobp) nil)
;; When inside a folded part, move out of it.
- ((pcase (get-char-property-and-overlay (point) 'invisible)
- (`(,(or `outline `org-hide-block) . ,o)
- (goto-char (overlay-end o))
+ ((pcase (org-fold-get-folding-spec)
+ ((or (pred (eq (org-fold-get-folding-spec-for-element 'headline)))
+ (pred (eq (org-fold-get-folding-spec-for-element 'block))))
+ (goto-char (cdr (org-fold-get-region-at-point)))
(forward-line)
t)
(_ nil)))
@@ -20765,10 +19730,13 @@ See `org-forward-paragraph'."
(org--forward-paragraph-once))
;; If the element is folded, skip it altogether.
((pcase (org-with-point-at post-affiliated
- (get-char-property-and-overlay (line-end-position)
- 'invisible))
- (`(,(or `outline `org-hide-block) . ,o)
- (goto-char (overlay-end o))
+ (org-fold-get-folding-spec nil (line-end-position)))
+ ((or (pred (eq (org-fold-get-folding-spec-for-element 'headline)))
+ (pred (eq (org-fold-get-folding-spec-for-element 'block))))
+ (goto-char (cdr (org-fold-get-region-at-point
+ nil
+ (org-with-point-at post-affiliated
+ (line-end-position)))))
(forward-line)
t)
(_ nil)))
@@ -20823,9 +19791,10 @@ See `org-backward-paragraph'."
(save-excursion (skip-chars-backward " \t\n") (bobp)))
(goto-char (point-min)))
;; When inside a folded part, move out of it.
- ((pcase (get-char-property-and-overlay (1- (point)) 'invisible)
- (`(,(or `outline `org-hide-block) . ,o)
- (goto-char (1- (overlay-start o)))
+ ((pcase (org-fold-get-folding-spec nil (1- (point)))
+ ((or (pred (eq (org-fold-get-folding-spec-for-element 'headline)))
+ (pred (eq (org-fold-get-folding-spec-for-element 'block))))
+ (goto-char (1- (car (org-fold-get-region-at-point nil (1- (point))))))
(org--backward-paragraph-once)
t)
(_ nil)))
@@ -21205,7 +20174,7 @@ Started from `gnus-info-find-node'."
(add-hook 'org-mode-hook ;remove overlays when changing major mode
(lambda () (add-hook 'change-major-mode-hook
- 'org-show-all 'append 'local)))
+ 'org-fold-show-all 'append 'local)))
(provide 'org)
diff --git a/lisp/ox-org.el b/lisp/ox-org.el
index 740419e0e..5823905a5 100644
--- a/lisp/ox-org.el
+++ b/lisp/ox-org.el
@@ -328,7 +328,7 @@ Return output file name."
newbuf)
(with-current-buffer work-buffer
(org-font-lock-ensure)
- (org-show-all)
+ (org-fold-show-all)
(setq newbuf (htmlize-buffer)))
(with-current-buffer newbuf
(when org-org-htmlized-css-url
diff --git a/lisp/ox.el b/lisp/ox.el
index 9852cfd21..5b7aecca6 100644
--- a/lisp/ox.el
+++ b/lisp/ox.el
@@ -2576,7 +2576,9 @@ The function assumes BUFFER's major mode is `org-mode'."
(or (memq var
'(default-directory
buffer-file-name
- buffer-file-coding-system))
+ buffer-file-coding-system
+ ;; Needed to preserve folding state
+ char-property-alias-alist))
(assq var bound-variables)
(string-match "^\\(org-\\|orgtbl-\\)"
(symbol-name var)))
diff --git a/testing/lisp/test-org-list.el b/testing/lisp/test-org-list.el
index 078e59655..e8d8ee59f 100644
--- a/testing/lisp/test-org-list.el
+++ b/testing/lisp/test-org-list.el
@@ -582,7 +582,7 @@ b. Item 2<point>"
;; Preserve item visibility.
(should
(equal
- '(outline outline)
+ (make-list 2 (org-fold-get-folding-spec-for-element 'headline))
(org-test-with-temp-text
"* Headline\n<point>- item 1\n body 1\n- item 2\n body 2"
(let ((org-cycle-include-plain-lists t))
@@ -592,10 +592,10 @@ b. Item 2<point>"
(search-backward "- item 1")
(org-move-item-down)
(forward-line)
- (list (org-invisible-p2)
+ (list (org-fold-get-folding-spec)
(progn
(search-backward " body 2")
- (org-invisible-p2))))))
+ (org-fold-get-folding-spec))))))
;; Preserve children visibility.
(org-test-with-temp-text "* Headline
- item 1
@@ -871,15 +871,15 @@ b. Item 2<point>"
;; Preserve list visibility when inserting an item.
(should
(equal
- '(outline outline)
+ `(,(org-fold-get-folding-spec-for-element 'headline) ,(org-fold-get-folding-spec-for-element 'headline))
(org-test-with-temp-text "- A\n - B\n- C\n - D"
(let ((org-cycle-include-plain-lists t))
(org-cycle)
(forward-line 2)
(org-cycle)
(org-insert-item)
- (list (get-char-property (line-beginning-position 0) 'invisible)
- (get-char-property (line-end-position 2) 'invisible))))))
+ (list (org-fold-get-folding-spec nil (line-beginning-position 0))
+ (org-fold-get-folding-spec nil (line-end-position 2)))))))
;; Test insertion in area after a sub-list. In particular, if point
;; is right at the end of the previous sub-list, still insert
;; a sub-item in that list.
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 38bab1af9..543c3c486 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -3693,7 +3693,7 @@ SCHEDULED: <2017-05-06 Sat>
(should-not
(org-test-with-temp-text "#+BEGIN_CENTER\nContents\n#+END_CENTER"
(let ((org-special-ctrl-a/e t))
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(org-end-of-line)
(eobp))))
;; Get past invisible characters at the end of line.
@@ -3841,7 +3841,7 @@ SCHEDULED: <2017-05-06 Sat>
(should
(= 6
(org-test-with-temp-text "#+begin_center\nP1\n\nP2\n#+end_center\nP3"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(org-forward-paragraph)
(org-current-line))))
;; On an item or a footnote definition, move past the first element
@@ -3961,7 +3961,7 @@ SCHEDULED: <2017-05-06 Sat>
(bobp)))
(should
(org-test-with-temp-text "#+begin_center\nP1\n\nP2\n#+end_center\n"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(goto-char (point-max))
(org-backward-paragraph)
(bobp)))
@@ -4376,8 +4376,15 @@ Text.
(while (search-forward "BEGIN_" nil t) (org-cycle))
(search-backward "- item 1")
(org-drag-element-backward)
- (mapcar (lambda (ov) (cons (overlay-start ov) (overlay-end ov)))
- (overlays-in (point-min) (point-max))))))
+ (let (regions)
+ (goto-char (point-min))
+ (while (< (point) (point-max))
+ (let ((region (org-fold-get-region-at-point)))
+ (if (not region)
+ (goto-char (org-fold-next-folding-state-change))
+ (goto-char (cdr region))
+ (push region regions))))
+ regions))))
;; Pathological case: handle call with point in blank lines right
;; after a headline.
(should
@@ -4428,8 +4435,15 @@ Text.
(should
(equal
'((63 . 82) (26 . 48))
- (mapcar (lambda (ov) (cons (overlay-start ov) (overlay-end ov)))
- (overlays-in (point-min) (point-max)))))))
+ (let (regions)
+ (goto-char (point-min))
+ (while (< (point) (point-max))
+ (let ((region (org-fold-get-region-at-point)))
+ (if (not region)
+ (goto-char (org-fold-next-folding-state-change))
+ (goto-char (cdr region))
+ (push region regions))))
+ regions)))))
(ert-deftest test-org/next-block ()
"Test `org-next-block' specifications."
@@ -7748,108 +7762,108 @@ CLOCK: [2012-03-29 Thu 10:00]--[2012-03-29 Thu 16:40] => 6:40"
;;; Visibility
(ert-deftest test-org/hide-drawer-toggle ()
- "Test `org-hide-drawer-toggle' specifications."
+ "Test `org-fold-hide-drawer-toggle' specifications."
;; Error when not at a drawer.
(should-error
(org-test-with-temp-text ":fake-drawer:\ncontents"
- (org-hide-drawer-toggle 'off)
+ (org-fold-hide-drawer-toggle 'off)
(get-char-property (line-end-position) 'invisible)))
(should-error
(org-test-with-temp-text
"#+begin_example\n<point>:D:\nc\n:END:\n#+end_example"
- (org-hide-drawer-toggle t)))
+ (org-fold-hide-drawer-toggle t)))
;; Hide drawer.
(should
(org-test-with-temp-text ":drawer:\ncontents\n:end:"
- (org-hide-drawer-toggle)
+ (org-fold-hide-drawer-toggle)
(get-char-property (line-end-position) 'invisible)))
;; Show drawer unconditionally when optional argument is `off'.
(should-not
(org-test-with-temp-text ":drawer:\ncontents\n:end:"
- (org-hide-drawer-toggle)
- (org-hide-drawer-toggle 'off)
+ (org-fold-hide-drawer-toggle)
+ (org-fold-hide-drawer-toggle 'off)
(get-char-property (line-end-position) 'invisible)))
;; Hide drawer unconditionally when optional argument is non-nil.
(should
(org-test-with-temp-text ":drawer:\ncontents\n:end:"
- (org-hide-drawer-toggle t)
+ (org-fold-hide-drawer-toggle t)
(get-char-property (line-end-position) 'invisible)))
;; Do not hide drawer when called from final blank lines.
(should-not
(org-test-with-temp-text ":drawer:\ncontents\n:end:\n\n<point>"
- (org-hide-drawer-toggle)
+ (org-fold-hide-drawer-toggle)
(goto-char (point-min))
(get-char-property (line-end-position) 'invisible)))
;; Don't leave point in an invisible part of the buffer when hiding
;; a drawer away.
(should-not
(org-test-with-temp-text ":drawer:\ncontents\n<point>:end:"
- (org-hide-drawer-toggle)
+ (org-fold-hide-drawer-toggle)
(get-char-property (point) 'invisible))))
(ert-deftest test-org/hide-block-toggle ()
- "Test `org-hide-block-toggle' specifications."
+ "Test `org-fold-hide-block-toggle' specifications."
;; Error when not at a block.
(should-error
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents"
- (org-hide-block-toggle 'off)
+ (org-fold-hide-block-toggle 'off)
(get-char-property (line-end-position) 'invisible)))
;; Hide block.
(should
(org-test-with-temp-text "#+BEGIN_CENTER\ncontents\n#+END_CENTER"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(get-char-property (line-end-position) 'invisible)))
(should
(org-test-with-temp-text "#+BEGIN_EXAMPLE\ncontents\n#+END_EXAMPLE"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(get-char-property (line-end-position) 'invisible)))
;; Show block unconditionally when optional argument is `off'.
(should-not
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
- (org-hide-block-toggle)
- (org-hide-block-toggle 'off)
+ (org-fold-hide-block-toggle)
+ (org-fold-hide-block-toggle 'off)
(get-char-property (line-end-position) 'invisible)))
(should-not
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
- (org-hide-block-toggle 'off)
+ (org-fold-hide-block-toggle 'off)
(get-char-property (line-end-position) 'invisible)))
;; Hide block unconditionally when optional argument is non-nil.
(should
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
- (org-hide-block-toggle t)
+ (org-fold-hide-block-toggle t)
(get-char-property (line-end-position) 'invisible)))
(should
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
- (org-hide-block-toggle)
- (org-hide-block-toggle t)
+ (org-fold-hide-block-toggle)
+ (org-fold-hide-block-toggle t)
(get-char-property (line-end-position) 'invisible)))
;; Do not hide block when called from final blank lines.
(should-not
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE\n\n<point>"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(goto-char (point-min))
(get-char-property (line-end-position) 'invisible)))
;; Don't leave point in an invisible part of the buffer when hiding
;; a block away.
(should-not
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n<point>#+END_QUOTE"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(get-char-property (point) 'invisible))))
(ert-deftest test-org/hide-block-toggle-maybe ()
- "Test `org-hide-block-toggle-maybe' specifications."
+ "Test `org-fold-hide-block-toggle' specifications."
(should
(org-test-with-temp-text "#+BEGIN: dynamic\nContents\n#+END:"
- (org-hide-block-toggle-maybe)))
- (should-not
- (org-test-with-temp-text "Paragraph" (org-hide-block-toggle-maybe))))
+ (org-hide-block-toggle)))
+ (should-error
+ (org-test-with-temp-text "Paragraph" (org-hide-block-toggle))))
(ert-deftest test-org/show-set-visibility ()
- "Test `org-show-set-visibility' specifications."
+ "Test `org-fold-show-set-visibility' specifications."
;; Do not throw an error before first heading.
(should
(org-test-with-temp-text "Preamble\n* Headline"
- (org-show-set-visibility 'tree)
+ (org-fold-show-set-visibility 'tree)
t))
;; Test all visibility spans, both on headline and in entry.
(let ((list-visible-lines
@@ -7871,7 +7885,7 @@ CLOCK: [2012-03-29 Thu 10:00]--[2012-03-29 Thu 16:40] => 6:40"
"
(org-cycle t)
(search-forward (if headerp "Self" "Match"))
- (org-show-set-visibility state)
+ (org-fold-show-set-visibility state)
(goto-char (point-min))
(let (result (line 0))
(while (not (eobp))
@@ -7898,24 +7912,24 @@ CLOCK: [2012-03-29 Thu 10:00]--[2012-03-29 Thu 16:40] => 6:40"
;; visible.
(should-not
(org-test-with-temp-text "#+BEGIN_QUOTE\nText\n#+END_QUOTE"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(search-forward "Text")
- (org-show-set-visibility 'minimal)
+ (org-fold-show-set-visibility 'minimal)
(org-invisible-p2)))
(should-not
(org-test-with-temp-text ":DRAWER:\nText\n:END:"
- (org-hide-drawer-toggle)
+ (org-fold-hide-drawer-toggle)
(search-forward "Text")
- (org-show-set-visibility 'minimal)
+ (org-fold-show-set-visibility 'minimal)
(org-invisible-p2)))
(should-not
(org-test-with-temp-text
"#+BEGIN_QUOTE\n<point>:DRAWER:\nText\n:END:\n#+END_QUOTE"
- (org-hide-drawer-toggle)
+ (org-fold-hide-drawer-toggle)
(forward-line -1)
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(search-forward "Text")
- (org-show-set-visibility 'minimal)
+ (org-fold-show-set-visibility 'minimal)
(org-invisible-p2))))
(defun test-org/copy-visible ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment