Last active
September 23, 2020 06:44
-
-
Save yantar92/6447754415457927293acda43a7fcaef to your computer and use it in GitHub Desktop.
Against aea1109ef
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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)) | |