* [PATCH 02/35] Separate folding functions from org.el into new library: org-fold
@ 2022-01-29 11:37 13% ` Ihor Radchenko
2022-01-29 11:38 12% ` [PATCH 09/35] Rename old function call to use org-fold Ihor Radchenko
2022-01-29 11:38 12% ` [PATCH 17/35] org-compat: Work around some third-party packages using outline-* functions Ihor Radchenko
2 siblings, 0 replies; 25+ results
From: Ihor Radchenko @ 2022-01-29 11:37 UTC (permalink / raw)
To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit,
Christian Heinrich, emacs-orgmode
Cc: Ihor Radchenko
[-- Attachment #1: Type: text/plain, Size: 150 bytes --]
---
lisp/org-fold.el | 1135 ++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 1135 insertions(+)
create mode 100644 lisp/org-fold.el
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-Separate-folding-functions-from-org.el-into-new-libr.patch --]
[-- Type: text/x-patch; name="0002-Separate-folding-functions-from-org.el-into-new-libr.patch", Size: 49902 bytes --]
diff --git a/lisp/org-fold.el b/lisp/org-fold.el
new file mode 100644
index 000000000..52717fd86
--- /dev/null
+++ b/lisp/org-fold.el
@@ -0,0 +1,1135 @@
+;;; org-fold.el --- Folding of Org entries -*- lexical-binding: t; -*-
+;;
+;; Copyright (C) 2020-2020 Free Software Foundation, Inc.
+;;
+;; Author: Ihor Radchenko <yantar92 at gmail dot com>
+;; 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 folding is implemented using generic org-fold-core library. This file
+;; contains org-specific implementation of the folding. Also, various
+;; useful functions from org-fold-core are aliased under shorted `org-fold'
+;; prefix.
+
+;; The following features are implemented:
+;; - Folding/unfolding various Org mode elements and regions of Org buffers:
+;; + Region before first heading;
+;; + Org headings, their text, children (subtree), siblings, parents, etc;
+;; + Org blocks and drawers
+;; - Revealing Org structure around invisible point location
+;; - Revealing folded Org elements broken by user edits
+
+;;; Code:
+
+(require 'org-macs)
+(require 'org-fold-core)
+
+(defvar org-inlinetask-min-level)
+(defvar org-link--link-folding-spec)
+(defvar org-link--description-folding-spec)
+(defvar org-odd-levels-only)
+(defvar org-drawer-regexp)
+(defvar org-property-end-re)
+(defvar org-link-descriptive)
+(defvar org-outline-regexp-bol)
+(defvar org-custom-properties-hidden-p)
+(defvar org-archive-tag)
+
+;; Needed for overlays only
+(defvar org-custom-properties-overlays)
+
+(declare-function isearch-filter-visible "isearch" (beg end))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element--current-element "org-element" (limit &optional granularity mode structure))
+(declare-function org-element--cache-active-p "org-element" ())
+(declare-function org-toggle-custom-properties-visibility "org" ())
+(declare-function org-item-re "org-list" ())
+(declare-function org-up-heading-safe "org" ())
+(declare-function org-get-tags "org" (&optional pos local fontify))
+(declare-function org-get-valid-level "org" (level &optional change))
+(declare-function org-before-first-heading-p "org" ())
+(declare-function org-goto-sibling "org" (&optional previous))
+(declare-function org-block-map "org" (function &optional start end))
+(declare-function org-map-region "org" (fun beg end))
+(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
+(declare-function org-back-to-heading-or-point-min "org" (&optional invisible-ok))
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-at-heading-p "org" (&optional invisible-not-ok))
+(declare-function org-cycle-hide-drawers "org-cycle" (state))
+
+(declare-function outline-show-branches "outline" ())
+(declare-function outline-hide-sublevels "outline" (levels))
+(declare-function outline-get-next-sibling "outline" ())
+(declare-function outline-invisible-p "outline" (&optional pos))
+(declare-function outline-next-heading "outline" ())
+
+;;; 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-fold-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
+
+ ancestors-full show current subtree and its direct ancestors
+
+ 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 ancestors-full)
+ (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 'smart
+ "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
+
+;;; API
+
+;;;; Modifying folding specs
+
+(defalias 'org-fold-folding-spec-p #'org-fold-core-folding-spec-p)
+(defalias 'org-fold-add-folding-spec #'org-fold-core-add-folding-spec)
+(defalias 'org-fold-remove-folding-spec #'org-fold-core-remove-folding-spec)
+
+(defun org-fold-initialize (ellipsis)
+ "Setup folding in current Org buffer."
+ (setq-local org-fold-core-isearch-open-function #'org-fold--isearch-reveal)
+ (setq-local org-fold-core-extend-changed-region-functions (list #'org-fold--extend-changed-region))
+ ;; FIXME: Converting org-link + org-description to overlays when
+ ;; search matches hidden "[[" part of the link, reverses priority of
+ ;; link and description and hides the whole link. Working around
+ ;; this until there will be no need to convert text properties to
+ ;; overlays for isearch.
+ (setq-local org-fold-core--isearch-special-specs '(org-link))
+ (org-fold-core-initialize `((org-fold-outline
+ (:ellipsis . ,ellipsis)
+ (:fragile . ,#'org-fold--reveal-outline-maybe)
+ (:isearch-open . t)
+ ;; This is needed to make sure that inserting a
+ ;; new planning line in folded heading is not
+ ;; revealed.
+ (:front-sticky . t)
+ (:rear-sticky . t)
+ (:font-lock-skip . t)
+ (:alias . (headline heading outline inlinetask plain-list)))
+ (org-fold-block
+ (:ellipsis . ,ellipsis)
+ (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe)
+ (:isearch-open . t)
+ (:front-sticky . t)
+ (:alias . ( block center-block comment-block
+ dynamic-block example-block export-block
+ quote-block special-block src-block
+ verse-block)))
+ (org-fold-drawer
+ (:ellipsis . ,ellipsis)
+ (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe)
+ (:isearch-open . t)
+ (:front-sticky . t)
+ (:alias . (drawer property-drawer)))
+ ,org-link--description-folding-spec
+ ,org-link--link-folding-spec)))
+
+;;;; Searching and examining folded text
+
+(defalias 'org-fold-folded-p #'org-fold-core-folded-p)
+(defalias 'org-fold-get-folding-spec #'org-fold-core-get-folding-spec)
+(defalias 'org-fold-get-folding-specs-in-region #'org-fold-core-get-folding-specs-in-region)
+(defalias 'org-fold-get-region-at-point #'org-fold-core-get-region-at-point)
+(defalias 'org-fold-next-visibility-change #'org-fold-core-next-visibility-change)
+(defalias 'org-fold-previous-visibility-change #'org-fold-core-previous-visibility-change)
+(defalias 'org-fold-next-folding-state-change #'org-fold-core-next-folding-state-change)
+(defalias 'org-fold-previous-folding-state-change #'org-fold-core-previous-folding-state-change)
+(defalias 'org-fold-search-forward #'org-fold-core-search-forward)
+
+;;;;; Macros
+
+(defmacro org-fold-save-outline-visibility--overlays (use-markers &rest body)
+ "Save and restore outline visibility around BODY.
+If USE-MARKERS is non-nil, use markers for the positions. This
+means that the buffer may change while running BODY, but it also
+means that the buffer should stay alive during the operation,
+because otherwise all these markers will point to nowhere."
+ (declare (debug (form body)) (indent 1))
+ (org-with-gensyms (data invisible-types markers?)
+ `(let* ((,invisible-types '(org-hide-block outline))
+ (,markers? ,use-markers)
+ (,data
+ (mapcar (lambda (o)
+ (let ((beg (overlay-start o))
+ (end (overlay-end o))
+ (type (overlay-get o 'invisible)))
+ (and beg end
+ (> end beg)
+ (memq type ,invisible-types)
+ (list (if ,markers? (copy-marker beg) beg)
+ (if ,markers? (copy-marker end t) end)
+ type))))
+ (org-with-wide-buffer
+ (overlays-in (point-min) (point-max))))))
+ (unwind-protect (progn ,@body)
+ (org-with-wide-buffer
+ (dolist (type ,invisible-types)
+ (remove-overlays (point-min) (point-max) 'invisible type))
+ (pcase-dolist (`(,beg ,end ,type) (delq nil ,data))
+ (org-fold-region beg end t type)
+ (when ,markers?
+ (set-marker beg nil)
+ (set-marker end nil))))))))
+(defmacro org-fold-save-outline-visibility--text-properties (use-markers &rest body)
+ "Save and restore outline visibility around BODY.
+If USE-MARKERS is non-nil, use markers for the positions. This
+means that the buffer may change while running BODY, but it also
+means that the buffer should stay alive during the operation,
+because otherwise all these markers will point to nowhere."
+ (declare (debug (form body)) (indent 1))
+ (org-with-gensyms (data specs markers?)
+ `(let* ((,specs ',(org-fold-core-folding-spec-list))
+ (,markers? ,use-markers)
+ (,data
+ (org-with-wide-buffer
+ (let ((pos (point-min))
+ data-val)
+ (while (< pos (point-max))
+ (dolist (spec (org-fold-get-folding-spec 'all pos))
+ (let ((region (org-fold-get-region-at-point spec pos)))
+ (if ,markers?
+ (push (list (copy-marker (car region))
+ (copy-marker (cdr region) t)
+ spec)
+ data-val)
+ (push (list (car region) (cdr region) spec)
+ data-val))))
+ (setq pos (org-fold-next-folding-state-change nil pos)))))))
+ (unwind-protect (progn ,@body)
+ (org-with-wide-buffer
+ (dolist (spec ,specs)
+ (org-fold-region (point-min) (point-max) nil spec))
+ (pcase-dolist (`(,beg ,end ,spec) (delq nil ,data))
+ (org-fold-region beg end t spec)
+ (when ,markers?
+ (set-marker beg nil)
+ (set-marker end nil))))))))
+(defmacro org-fold-save-outline-visibility (use-markers &rest body)
+ "Save and restore outline visibility around BODY.
+If USE-MARKERS is non-nil, use markers for the positions. This
+means that the buffer may change while running BODY, but it also
+means that the buffer should stay alive during the operation,
+because otherwise all these markers will point to nowhere."
+ (declare (debug (form body)) (indent 1))
+ `(when (eq org-fold-core-style 'text-properties)
+ (org-fold-save-outline-visibility--text-properties ,use-markers ,@body)
+ (org-fold-save-outline-visibility--overlays ,use-markers ,@body)))
+
+;;;; Changing visibility (regions, blocks, drawers, headlines)
+
+;;;;; Region visibility
+
+;; (defalias 'org-fold-region #'org-fold-core-region)
+(defun org-fold-region--overlays (from to flag spec)
+ "Hide or show lines from FROM to TO, according to FLAG.
+SPEC is the invisibility spec, as a symbol."
+ (remove-overlays from to 'invisible spec)
+ ;; Use `front-advance' since text right before to the beginning of
+ ;; the overlay belongs to the visible line than to the contents.
+ (when flag
+ (let ((o (make-overlay from to nil 'front-advance)))
+ (overlay-put o 'evaporate t)
+ (overlay-put o 'invisible spec)
+ (overlay-put o
+ 'isearch-open-invisible
+ (lambda (&rest _) (org-fold-show-context 'isearch))))))
+(defsubst org-fold-region (from to flag &optional spec)
+ "Hide or show lines from FROM to TO, according to FLAG.
+SPEC is the invisibility spec, as a symbol."
+ (if (eq org-fold-core-style 'text-properties)
+ (org-fold-core-region from to flag spec)
+ (org-fold-region--overlays from to flag spec)))
+
+(defun org-fold-show-all--text-properties (&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 'block)
+ (`drawers 'drawer)
+ (`headings 'headline)
+ (_ (error "Invalid type: %S" type))))))
+(defun org-fold-show-all--overlays (&optional types)
+ "Show all contents in the visible part of the buffer.
+By default, the function expands headings, blocks and drawers.
+When optional argument TYPE is a list of symbols among `blocks',
+`drawers' and `headings', to only expand one specific type."
+ (interactive)
+ (let ((types (or types '(blocks drawers headings))))
+ (when (memq 'blocks types)
+ (org-fold-region (point-min) (point-max) nil 'org-hide-block))
+ (cond
+ ;; Fast path. Since headings and drawers share the same
+ ;; invisible spec, clear everything in one go.
+ ((and (memq 'headings types)
+ (memq 'drawers types))
+ (org-fold-region (point-min) (point-max) nil 'outline))
+ ((memq 'headings types)
+ (org-fold-region (point-min) (point-max) nil 'outline)
+ (org-cycle-hide-drawers 'all))
+ ((memq 'drawers types)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward org-drawer-regexp nil t)
+ (let* ((pair (get-char-property-and-overlay (line-beginning-position)
+ 'invisible))
+ (o (cdr-safe pair)))
+ (if (overlayp o) (goto-char (overlay-end o))
+ (pcase (get-char-property-and-overlay (point) 'invisible)
+ (`(outline . ,o)
+ (goto-char (overlay-end o))
+ (delete-overlay o))
+ (_ nil))))))))))
+(defsubst 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)
+ (if (eq org-fold-core-style 'text-properties)
+ (org-fold-show-all--text-properties types)
+ (org-fold-show-all--overlays types)))
+
+(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) 'outline)))
+
+;;;;; 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 'outline)
+ (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))
+ (unless (eobp) ; Current headline is empty and ends at the end of buffer.
+ (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
+ 'outline))))
+
+(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
+ 'outline)))
+
+;; Replaces `outline-hide-subtree'.
+(defun org-fold-hide-subtree ()
+ "Hide everything after this heading at deeper levels."
+ (interactive)
+ (org-fold-subtree t))
+
+;; Replaces `outline-hide-sublevels'
+(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 'headline)
+ ;; Then unhide the top level headers.
+ (org-map-region
+ (lambda ()
+ (when (<= (funcall outline-level) levels)
+ (org-fold-heading nil)))
+ 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
+ 'outline)
+ (org-cycle-hide-drawers 'children)))
+
+(defalias 'org-fold-show-hidden-entry #'org-fold-show-entry
+ "Show an entry where even the heading is hidden.")
+
+(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 'outline))
+
+(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--text-properties ()
+ "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)))
+(defun org-fold-show-branches-buffer--overlays ()
+ "Show all branches in the buffer."
+ (org-fold-flag-above-first-heading)
+ (outline-hide-sublevels 1)
+ (unless (eobp)
+ (outline-show-branches)
+ (while (outline-get-next-sibling)
+ (outline-show-branches)))
+ (goto-char (point-min)))
+(defsubst org-fold-show-branches-buffer ()
+ "Show all branches in the buffer."
+ (if (eq org-fold-core-style 'text-properties)
+ (org-fold-show-branches-buffer--text-properties)
+ (org-fold-show-branches-buffer--overlays)))
+
+;;;;; 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 (if (eq org-fold-core-style 'text-properties)
+ category
+ (if (eq category 'block) 'org-hide-block 'outline)))
+ (flag
+ (cond ((eq force 'off) nil)
+ (force t)
+ ((if (eq org-fold-core-style 'text-properties)
+ (org-fold-folded-p start spec)
+ (eq spec (get-char-property start 'invisible)))
+ 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 (format "%s@%s: %s"
+ (buffer-file-name (buffer-base-buffer))
+ (point)
+ (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-block-map (apply-partially #'org-fold-hide-block-toggle 'hide)))
+
+(defun org-fold-hide-drawer-all ()
+ "Fold all drawers in the current buffer."
+ (let ((begin (point-min))
+ (end (point-max)))
+ (org-fold--hide-drawers begin end)))
+
+(defun org-fold--hide-drawers--overlays (begin end)
+ "Hide all drawers between BEGIN and END."
+ (save-excursion
+ (goto-char begin)
+ (while (re-search-forward org-drawer-regexp end t)
+ (let* ((pair (get-char-property-and-overlay (line-beginning-position)
+ 'invisible))
+ (o (cdr-safe pair)))
+ (if (overlayp o) (goto-char (overlay-end o)) ;invisible drawer
+ (pcase (get-char-property-and-overlay (point) 'invisible)
+ (`(outline . ,o) (goto-char (overlay-end o))) ;already folded
+ (_
+ (let* ((drawer (org-element-at-point))
+ (type (org-element-type drawer)))
+ (when (memq type '(drawer property-drawer))
+ (org-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)))))))))))
+(defun org-fold--hide-drawers--text-properties (begin end)
+ "Hide all drawers between BEGIN and END."
+ (save-excursion
+ (goto-char begin)
+ (while (and (< (point) end)
+ (re-search-forward org-drawer-regexp end t))
+ ;; Skip folded drawers
+ (if (org-fold-folded-p nil 'drawer)
+ (goto-char (org-fold-next-folding-state-change 'drawer nil end))
+ (let* ((drawer (org-element-at-point))
+ (type (org-element-type drawer)))
+ (when (memq type '(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))))))))
+(defun org-fold--hide-drawers (begin end)
+ "Hide all drawers between BEGIN and END."
+ (if (eq org-fold-core-style 'text-properties)
+ (org-fold--hide-drawers--text-properties begin end)
+ (org-fold--hide-drawers--overlays begin end)))
+
+(defun org-fold-hide-archived-subtrees (beg end)
+ "Re-hide all archived subtrees after a visibility state change."
+ (org-with-wide-buffer
+ (let ((case-fold-search nil)
+ (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":")))
+ (goto-char beg)
+ ;; Include headline point is currently on.
+ (beginning-of-line)
+ (while (and (< (point) end) (re-search-forward re end t))
+ (when (member org-archive-tag (org-get-tags nil t))
+ (org-fold-subtree t)
+ (org-end-of-subtree t))))))
+
+;;;;; 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--overlays (detail)
+ "Set visibility around point according to DETAIL.
+DETAIL is either nil, `minimal', `local', `ancestors',
+`ancestors-full', `lineage', `tree', `canonical' or t. See
+`org-show-context-detail' for more information."
+ ;; Show current heading and possibly its entry, following headline
+ ;; or all children.
+ (if (and (org-at-heading-p) (not (eq detail 'local)))
+ (org-fold-heading nil)
+ (org-fold-show-entry)
+ ;; If point is hidden within a drawer or a block, make sure to
+ ;; expose it.
+ (dolist (o (overlays-at (point)))
+ (when (memq (overlay-get o 'invisible) '(org-hide-block outline))
+ (delete-overlay o)))
+ (unless (org-before-first-heading-p)
+ (org-with-limited-levels
+ (cl-case detail
+ ((tree canonical t) (org-fold-show-children))
+ ((nil minimal ancestors ancestors-full))
+ (t (save-excursion
+ (outline-next-heading)
+ (org-fold-heading nil)))))))
+ ;; Show whole subtree.
+ (when (eq detail 'ancestors-full) (org-fold-show-subtree))
+ ;; Show all siblings.
+ (when (eq detail 'lineage) (org-fold-show-siblings))
+ ;; Show ancestors, possibly with their children.
+ (when (memq detail '(ancestors ancestors-full 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))))))
+(defvar org-hide-emphasis-markers); Defined in org.el
+(defvar org-pretty-entities); Defined in org.el
+(defun org-fold-show-set-visibility--text-properties (detail)
+ "Set visibility around point according to DETAIL.
+DETAIL is either nil, `minimal', `local', `ancestors',
+`ancestors-full', `lineage', `tree', `canonical' or t. See
+`org-show-context-detail' for more information."
+ ;; Show current heading and possibly its entry, following headline
+ ;; or all children.
+ (if (and (org-at-heading-p) (not (eq detail 'local)))
+ (org-fold-heading nil)
+ (org-fold-show-entry)
+ ;; If point is hidden make sure to expose it.
+ (when (org-invisible-p)
+ ;; FIXME: No clue why, but otherwise the following might not work.
+ (redisplay)
+ (let ((region (org-fold-get-region-at-point)))
+ ;; Reveal emphasis markers.
+ (let (org-hide-emphasis-markers
+ org-link-descriptive
+ org-pretty-entities
+ (region (or (org-find-text-property-region (point) 'org-emphasis)
+ (org-find-text-property-region (point) 'invisible)
+ region)))
+ (when region
+ (org-with-point-at (car region)
+ (beginning-of-line)
+ (let (font-lock-extend-region-functions)
+ (font-lock-fontify-region (1- (car region)) (cdr region))))))
+ (when region
+ (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 ancestors-full))
+ (t (save-excursion
+ (outline-next-heading)
+ (org-fold-heading nil)))))))
+ ;; Show whole subtree.
+ (when (eq detail 'ancestors-full) (org-fold-show-subtree))
+ ;; Show all siblings.
+ (when (eq detail 'lineage) (org-fold-show-siblings))
+ ;; Show ancestors, possibly with their children.
+ (when (memq detail '(ancestors ancestors-full 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-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."
+ (if (eq org-fold-core-style 'text-properties)
+ (org-fold-show-set-visibility--text-properties detail)
+ (org-fold-show-set-visibility--overlays detail)))
+
+(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))))
+
+;;; Make isearch search in some text hidden via text propertoes
+
+(defun org-fold--isearch-reveal (&rest _)
+ "Reveal text at POS found by isearch."
+ (org-fold-show-set-visibility 'isearch))
+
+;;; Handling changes in folded elements
+
+(defun org-fold--extend-changed-region (from to)
+ "Consider folded regions in the next/previous line when fixing
+region visibility.
+This function is intended to be used as a member of
+`org-fold-core-extend-changed-region-functions'."
+ ;; 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)))
+ (cons from to))
+
+(defun org-fold--reveal-outline-maybe (region _)
+ "Reveal folded outline in REGION when needed.
+
+This function is intended to be used as :fragile property of
+`org-fold-outline' spec. See `org-fold-core--specs' for details."
+ (save-match-data
+ (save-excursion
+ (goto-char (car region))
+ ;; The line before beginning of the fold should be either a
+ ;; headline or a list item.
+ (backward-char)
+ (beginning-of-line)
+ ;; Make sure that headline is not partially hidden
+ (unless (org-fold-folded-p nil 'headline) (org-fold-region (max (point-min) (1- (point))) (line-end-position) nil 'headline))
+ ;; Check the validity of headline
+ (unless (let ((case-fold-search t))
+ (looking-at (rx-to-string `(or (regex ,(org-item-re))
+ (regex ,org-outline-regexp-bol))))) ; the match-data will be used later
+ t))))
+
+(defun org-fold--reveal-drawer-or-block-maybe (region spec)
+ "Reveal folded drawer/block (according to SPEC) in REGION when needed.
+
+This function is intended to be used as :fragile property of
+`org-fold-drawer' or `org-fold-block' spec."
+ (let ((begin-re (cond
+ ((eq spec (org-fold-core-get-folding-spec-from-alias 'drawer))
+ org-drawer-regexp)
+ ;; Group one below contains the type of the block.
+ ((eq spec (org-fold-core-get-folding-spec-from-alias '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)
+ (save-match-data ; we should not clobber match-data in after-change-functions
+ (let ((fold-begin (car region))
+ (fold-end (cdr region)))
+ (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-core-get-folding-spec-from-alias 'drawer))
+ org-property-end-re)
+ ((eq spec (org-fold-core-get-folding-spec-from-alias '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-to-string `(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)))))
+ unfold?)))))
+
+;; Catching user edits inside invisible text
+(defun org-fold-check-before-invisible-edit--overlays (kind)
+ "Check if editing KIND is 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 (get-char-property (point) 'invisible)
+ (get-char-property (max (point-min) (1- (point))) 'invisible)))
+ ;; OK, we need to take a closer look. Do not consider
+ ;; invisibility obtained through text properties (e.g., link
+ ;; fontification), as it cannot be toggled.
+ (let* ((invisible-at-point
+ (pcase (get-char-property-and-overlay (point) 'invisible)
+ (`(,_ . ,(and (pred overlayp) o)) o)))
+ ;; Assume that point cannot land in the middle of an
+ ;; overlay, or between two overlays.
+ (invisible-before-point
+ (and (not invisible-at-point)
+ (not (bobp))
+ (pcase (get-char-property-and-overlay (1- (point)) 'invisible)
+ (`(,_ . ,(and (pred overlayp) o)) o))))
+ (border-and-ok-direction
+ (or
+ ;; Check if we are acting predictably before invisible
+ ;; text.
+ (and invisible-at-point
+ (memq kind '(insert delete-backward)))
+ ;; Check if we are acting predictably after invisible text
+ ;; This works not well, and I have turned it off. It seems
+ ;; better to always show and stop after invisible text.
+ ;; (and (not invisible-at-point) invisible-before-point
+ ;; (memq kind '(insert delete)))
+ )))
+ (when (or invisible-at-point invisible-before-point)
+ (when (eq org-fold-catch-invisible-edits 'error)
+ (user-error "Editing in invisible areas is prohibited, make them visible first"))
+ (if (and org-custom-properties-overlays
+ (y-or-n-p "Display invisible properties in this buffer? "))
+ (org-toggle-custom-properties-visibility)
+ ;; Make the area visible
+ (save-excursion
+ (when invisible-before-point
+ (goto-char
+ (previous-single-char-property-change (point) 'invisible)))
+ ;; Remove whatever overlay is currently making yet-to-be
+ ;; edited text invisible. Also remove nested invisibility
+ ;; related overlays.
+ (delete-overlay (or invisible-at-point invisible-before-point))
+ (let ((origin (if invisible-at-point (point) (1- (point)))))
+ (while (pcase (get-char-property-and-overlay origin 'invisible)
+ (`(,_ . ,(and (pred overlayp) o))
+ (delete-overlay o)
+ t)))))
+ (cond
+ ((eq org-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"))))))))
+(defun org-fold-check-before-invisible-edit--text-properties (kind)
+ "Check if editing KIND is 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.
+ (let* ((invisible-at-point (org-invisible-p))
+ (invisible-before-point
+ (and (not (bobp))
+ (org-invisible-p (1- (point)))))
+ (border-and-ok-direction
+ (or
+ ;; Check if we are acting predictably before invisible
+ ;; text.
+ (and invisible-at-point (not invisible-before-point)
+ (memq kind '(insert delete-backward)))
+ (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-set-visibility 'local))
+ (when invisible-before-point
+ (org-with-point-at (1- (point)) (org-fold-show-set-visibility 'local)))
+ (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"))))))))
+(defsubst org-fold-check-before-invisible-edit (kind)
+ "Check if editing KIND is 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
+ (if (eq org-fold-core-style 'text-properties)
+ (org-fold-check-before-invisible-edit--text-properties kind)
+ (org-fold-check-before-invisible-edit--overlays kind)))
+
+(provide 'org-fold)
+
+;;; org-fold.el ends here
^ permalink raw reply related [relevance 13%]
* [PATCH 09/35] Rename old function call to use org-fold
2022-01-29 11:37 13% ` [PATCH 02/35] Separate folding functions from org.el into new library: org-fold Ihor Radchenko
@ 2022-01-29 11:38 12% ` Ihor Radchenko
2022-01-29 11:38 12% ` [PATCH 17/35] org-compat: Work around some third-party packages using outline-* functions Ihor Radchenko
2 siblings, 0 replies; 25+ results
From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw)
To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit,
Christian Heinrich, emacs-orgmode
Cc: Ihor Radchenko
[-- Attachment #1: Type: text/plain, Size: 1302 bytes --]
---
lisp/ob-core.el | 14 ++--
lisp/ob-lilypond.el | 4 +-
lisp/ob-ref.el | 4 +-
lisp/ol.el | 13 ++--
lisp/org-agenda.el | 43 +++++------
lisp/org-archive.el | 12 +--
lisp/org-capture.el | 2 +-
lisp/org-clock.el | 10 +--
lisp/org-colview.el | 6 +-
lisp/org-compat.el | 29 +++----
lisp/org-crypt.el | 8 +-
lisp/org-element.el | 1 +
lisp/org-feed.el | 4 +-
lisp/org-footnote.el | 6 +-
lisp/org-goto.el | 6 +-
lisp/org-id.el | 4 +-
lisp/org-keys.el | 26 +++----
lisp/org-lint.el | 3 +-
lisp/org-list.el | 10 ++-
lisp/org-macs.el | 40 ++--------
lisp/org-mobile.el | 2 +-
lisp/org-mouse.el | 4 +-
lisp/org-refile.el | 2 +-
lisp/org-src.el | 6 +-
lisp/org-timer.el | 2 +-
lisp/org.el | 137 +++++++++++++++++++---------------
lisp/ox-org.el | 2 +-
testing/lisp/test-org-list.el | 2 +-
testing/lisp/test-org.el | 78 +++++++++----------
29 files changed, 242 insertions(+), 238 deletions(-)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0009-Rename-old-function-call-to-use-org-fold.patch --]
[-- Type: text/x-patch; name="0009-Rename-old-function-call-to-use-org-fold.patch", Size: 71466 bytes --]
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 239a57f96..6590eeee7 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -26,7 +26,9 @@ ;;; Code:
(require 'cl-lib)
(require 'ob-eval)
(require 'org-macs)
+(require 'org-fold)
(require 'org-compat)
+(require 'org-cycle)
(defconst org-babel-exeext
(if (memq system-type '(windows-nt cygwin))
@@ -50,7 +52,7 @@ (declare-function org-babel-ref-resolve "ob-ref" (ref))
(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info))
(declare-function org-current-level "org" ())
-(declare-function org-cycle "org" (&optional arg))
+(declare-function org-cycle "org-cycle" (&optional arg))
(declare-function org-edit-src-code "org-src" (&optional code edit-buffer-name))
(declare-function org-edit-src-exit "org-src" ())
(declare-function org-element-at-point "org-element" (&optional pom cached-only))
@@ -75,7 +77,7 @@ (declare-function org-narrow-to-subtree "org" (&optional element))
(declare-function org-next-block "org" (arg &optional backward block-regexp))
(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer))
(declare-function org-previous-block "org" (arg &optional block-regexp))
-(declare-function org-show-context "org" (&optional key))
+(declare-function org-fold-show-context "org-fold" (&optional key))
(declare-function org-src-coderef-format "org-src" (&optional element))
(declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
(declare-function org-src-get-lang-mode "org-src" (lang))
@@ -945,7 +947,7 @@ (defun org-babel-enter-header-arg-w-completion (&optional lang)
(insert (concat header " " (or arg "")))
(cons header arg)))
-(add-hook 'org-tab-first-hook 'org-babel-header-arg-expand)
+(add-hook 'org-cycle-tab-first-hook 'org-babel-header-arg-expand)
;;;###autoload
(defun org-babel-load-in-session (&optional _arg info)
@@ -1469,7 +1471,7 @@ (defun org-babel-hide-result-toggle (&optional force)
(push ov org-babel-hide-result-overlays)))))
;; org-tab-after-check-for-cycling-hook
-(add-hook 'org-tab-first-hook #'org-babel-hide-result-toggle-maybe)
+(add-hook 'org-cycle-tab-first-hook #'org-babel-hide-result-toggle-maybe)
;; Remove overlays when changing major mode
(add-hook 'org-mode-hook
(lambda () (add-hook 'change-major-mode-hook
@@ -1817,7 +1819,7 @@ (defun org-babel-goto-named-src-block (name)
(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)
@@ -1857,7 +1859,7 @@ (defun org-babel-goto-named-result (name)
(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-lilypond.el b/lisp/ob-lilypond.el
index 15538b503..df128441a 100644
--- a/lisp/ob-lilypond.el
+++ b/lisp/ob-lilypond.el
@@ -34,7 +34,7 @@ ;;; Commentary:
;;; Code:
(require 'ob)
-(declare-function org-show-all "org" (&optional types))
+(declare-function org-fold-show-all "org-fold" (&optional types))
(defalias 'lilypond-mode 'LilyPond-mode)
@@ -279,7 +279,7 @@ (defun org-babel-lilypond-mark-error-line (file-name line)
(setq case-fold-search nil)
(if (search-forward line nil t)
(progn
- (org-show-all)
+ (org-fold-show-all)
(set-mark (point))
(goto-char (- (point) (length line))))
(goto-char temp))))
diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el
index db8ced6b6..1a77e39b1 100644
--- a/lisp/ob-ref.el
+++ b/lisp/ob-ref.el
@@ -62,8 +62,8 @@ (declare-function org-find-property "org" (property &optional value))
(declare-function org-id-find-id-file "org-id" (id))
(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp))
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
-(declare-function org-show-context "org" (&optional key))
(declare-function org-narrow-to-subtree "org" (&optional element))
+(declare-function org-fold-show-context "org-fold" (&optional key))
(defvar org-babel-update-intermediate nil
"Update the in-buffer results of code blocks executed to resolve references.")
@@ -104,7 +104,7 @@ (defun org-babel-ref-goto-headline-id (id)
(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 b80f943b2..21bd854e9 100644
--- a/lisp/ol.el
+++ b/lisp/ol.el
@@ -29,6 +29,7 @@ ;;; Code:
(require 'org-compat)
(require 'org-macs)
+(require 'org-fold)
(defvar clean-buffer-list-kill-buffer-names)
(defvar org-agenda-buffer-name)
@@ -66,10 +67,10 @@ (declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function org-mode "org" ())
(declare-function org-occur "org" (regexp &optional keep-previous callback))
(declare-function org-open-file "org" (path &optional in-emacs line search))
-(declare-function org-overview "org" ())
+(declare-function org-cycle-overview "org-cycle" ())
(declare-function org-restart-font-lock "org" ())
(declare-function org-run-like-in-org-mode "org" (cmd))
-(declare-function org-show-context "org" (&optional key))
+(declare-function org-fold-show-context "org-fold" (&optional key))
(declare-function org-src-coderef-format "org-src" (&optional element))
(declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
(declare-function org-src-edit-buffer-p "org-src" (&optional buffer))
@@ -700,7 +701,7 @@ (defun org-link--buffer-for-internals ()
(make-indirect-buffer (current-buffer)
indirect-buffer-name
'clone))))
- (with-current-buffer indirect-buffer (org-overview))
+ (with-current-buffer indirect-buffer (org-cycle-overview))
indirect-buffer))))
(defun org-link--search-radio-target (target)
@@ -718,7 +719,7 @@ (defun org-link--search-radio-target (target)
(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))))
@@ -1257,7 +1258,7 @@ (defun org-link-search (s &optional avoid-pos stealth)
(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)
@@ -1430,7 +1431,7 @@ (defun org-next-link (&optional search-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 cc7cb5527..2802e8636 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -47,6 +47,7 @@ ;;; Code:
(require 'cl-lib)
(require 'ol)
+(require 'org-fold-core)
(require 'org)
(require 'org-macs)
(require 'org-refile)
@@ -9392,7 +9393,7 @@ (defun org-agenda-goto (&optional highlight)
(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))
@@ -9681,7 +9682,7 @@ (defun org-agenda-switch-to (&optional delete-other-windows)
(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)
@@ -9697,7 +9698,7 @@ (defun org-agenda-show (&optional full-entry)
(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)
@@ -9716,12 +9717,12 @@ (defun org-agenda-show-and-scroll-up (&optional arg)
(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)))
@@ -9752,7 +9753,7 @@ (defun org-agenda-show-1 (&optional more)
(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))
@@ -9760,20 +9761,20 @@ (defun org-agenda-show-1 (&optional more)
((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)))
@@ -9905,7 +9906,7 @@ (defun org-agenda-todo (&optional arg)
(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)
;; Make sure that log is recorded in current undo.
@@ -9946,7 +9947,7 @@ (defun org-agenda-add-note (&optional _arg)
(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
@@ -10095,7 +10096,7 @@ (defun org-agenda-priority (&optional force-direction)
(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)))
@@ -10119,7 +10120,7 @@ (defun org-agenda-set-tags (&optional tag onoff)
(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))
@@ -10144,7 +10145,7 @@ (defun org-agenda-set-property ()
(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 ()
@@ -10163,7 +10164,7 @@ (defun org-agenda-set-effort ()
(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)))
@@ -10185,7 +10186,7 @@ (defun org-agenda-toggle-archive-tag ()
(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)))
@@ -10395,7 +10396,7 @@ (defun org-agenda-clock-in (&optional arg)
(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))
@@ -10484,7 +10485,7 @@ (defun org-agenda-diary-entry-in-org-file ()
(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
@@ -10586,7 +10587,7 @@ (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2)
(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)
@@ -10624,7 +10625,7 @@ (defun org-agenda-insert-diary-make-new-entry (text)
(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 6ea16f8c1..1026a295e 100644
--- a/lisp/org-archive.el
+++ b/lisp/org-archive.el
@@ -324,7 +324,7 @@ (defun org-archive-subtree (&optional find-done)
(org-todo-regexp tr-org-todo-regexp)
(org-todo-line-regexp tr-org-todo-line-regexp))
(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
@@ -339,7 +339,7 @@ (defun org-archive-subtree (&optional find-done)
(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)
@@ -417,7 +417,7 @@ (defun org-archive-subtree (&optional find-done)
(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))))
@@ -487,13 +487,13 @@ (defun org-archive-to-archive-sibling ()
(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))))
@@ -602,7 +602,7 @@ (defun org-toggle-archive-tag (&optional find-done)
(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 5195b785e..1d4d6e877 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -1129,7 +1129,7 @@ (defun org-capture-place-template (&optional inhibit-wconf-store)
(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 6f441c18e..583b30237 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -1035,7 +1035,7 @@ (defun org-clock-jump-to-current-clock (&optional effective-clock)
(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)
@@ -1843,10 +1843,10 @@ (defun org-clock-goto (&optional select)
(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)))
@@ -2140,7 +2140,7 @@ (defun org-clock-report (&optional arg)
(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
@@ -3125,7 +3125,7 @@ (defun org-clock-load ()
(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)))))
(defun org-clock-kill-emacs-query ()
diff --git a/lisp/org-colview.el b/lisp/org-colview.el
index 15cab35f0..c8443c135 100644
--- a/lisp/org-colview.el
+++ b/lisp/org-colview.el
@@ -159,8 +159,8 @@ (defconst org-columns-summary-types-default
(defun org-columns-content ()
"Switch to contents view while in columns view."
(interactive)
- (org-overview)
- (org-content))
+ (org-cycle-overview)
+ (org-cycle-content))
(org-defkey org-columns-map "c" #'org-columns-content)
(org-defkey org-columns-map "o" #'org-overview)
@@ -701,7 +701,7 @@ (defun org-columns--call (fun)
(move-beginning-of-line 2)
(org-at-heading-p)))))
(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 38d330de6..772ef37f9 100644
--- a/lisp/org-compat.el
+++ b/lisp/org-compat.el
@@ -50,18 +50,20 @@ (declare-function org-element-property "org-element" (property element))
(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))
(declare-function table--at-cell-p "table" (position &optional object at-column))
+(declare-function org-fold-region "org-fold" (from to flag &optional spec))
+(declare-function org-fold-show-all "org-fold" (&optional types))
(defvar calendar-mode-map)
(defvar org-complex-heading-regexp)
@@ -72,6 +74,7 @@ (defvar org-table-any-border-regexp)
(defvar org-table-dataline-regexp)
(defvar org-table-tab-recognizes-table.el)
(defvar org-table1-hline-regexp)
+(defvar org-fold-core-style)
\f
;;; Emacs < 28.1 compatibility
@@ -627,7 +630,7 @@ (make-obsolete 'org-capture-import-remember-templates
(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."
@@ -670,7 +673,7 @@ (defun org-flag-drawer (flag &optional element beg end)
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." "9.4"))
- (if (and beg end) (org-flag-region beg end flag 'outline)
+ (if (and beg end) (org-fold-region beg end flag (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))
(let ((drawer
(or element
(and (save-excursion
@@ -679,12 +682,12 @@ (defun org-flag-drawer (flag &optional element beg end)
(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 (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))
;; 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)))
@@ -696,7 +699,7 @@ (defun org-hide-block-toggle-maybe ()
an error. Return a non-nil value when toggling is successful."
(declare (obsolete "use `org-hide-block-toggle' instead." "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."
@@ -712,7 +715,7 @@ (defun org-hide-block-toggle-all ()
(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.
@@ -941,7 +944,7 @@ (eval-after-load 'imenu
(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)))))
@@ -1006,7 +1009,7 @@ (eval-after-load 'speedbar
(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
@@ -1120,7 +1123,7 @@ (defun org-bookmark-jump-unhide ()
(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.
(add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
@@ -1188,7 +1191,7 @@ (eval-after-load 'ecb
'(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
@@ -1196,7 +1199,7 @@ (defun org-mark-jump-unhide ()
"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 41813cb18..b2542ab43 100644
--- a/lisp/org-crypt.el
+++ b/lisp/org-crypt.el
@@ -73,7 +73,7 @@ (declare-function org-before-first-heading-p "org" ())
(declare-function org-end-of-meta-data "org" (&optional full))
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
-(declare-function org-flag-subtree "org" (flag))
+(declare-function org-fold-subtree "org-fold" (flag))
(declare-function org-make-tags-matcher "org" (match))
(declare-function org-previous-visible-heading "org" (arg))
(declare-function org-scan-tags "org" (action matcher todo-only &optional start-level))
@@ -243,7 +243,7 @@ (defun org-encrypt-entry ()
(error (error-message-string err)))))
(when folded-heading
(goto-char folded-heading)
- (org-flag-subtree t))
+ (org-fold-subtree t))
nil)))))
;;;###autoload
@@ -280,7 +280,7 @@ (defun org-decrypt-entry ()
'org-crypt-text encrypted-text))
(when folded-heading
(goto-char folded-heading)
- (org-flag-subtree t))
+ (org-fold-subtree t))
nil)))
(_ nil)))
@@ -313,7 +313,7 @@ (defun org-crypt-use-before-save-magic ()
'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-element.el b/lisp/org-element.el
index 77a9fc6e3..99999fb32 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -70,6 +70,7 @@ (require 'org-footnote)
(require 'org-list)
(require 'org-macs)
(require 'org-table)
+(require 'org-fold-core)
(declare-function org-at-heading-p "org" (&optional _))
(declare-function org-escape-code-in-string "org-src" (s))
diff --git a/lisp/org-feed.el b/lisp/org-feed.el
index a5fea0888..d634f9c41 100644
--- a/lisp/org-feed.el
+++ b/lisp/org-feed.el
@@ -412,8 +412,8 @@ (defun org-feed-update (feed &optional retrieve-only)
;; 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-footnote.el b/lisp/org-footnote.el
index b55f6d98e..a4c9ae770 100644
--- a/lisp/org-footnote.el
+++ b/lisp/org-footnote.el
@@ -52,7 +52,7 @@ (declare-function org-in-verbatim-emphasis "org" ())
(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)
@@ -555,7 +555,7 @@ (defun org-footnote-goto-definition (label &optional location)
(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 \
@@ -581,7 +581,7 @@ (defun org-footnote-goto-previous-reference (label)
(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)))
\f
;;;; Getters
diff --git a/lisp/org-goto.el b/lisp/org-goto.el
index 860b0a3de..cd5000037 100644
--- a/lisp/org-goto.el
+++ b/lisp/org-goto.el
@@ -222,13 +222,13 @@ (defun org-goto-location (&optional _buf help)
" 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)
+ (org-cycle-overview)
(setq buffer-read-only t)
(if (and (boundp 'org-goto-start-pos)
(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")
@@ -279,7 +279,7 @@ (defun org-goto (&optional alternative-interface)
(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 b4acec7bd..780907cfa 100644
--- a/lisp/org-id.el
+++ b/lisp/org-id.el
@@ -331,7 +331,7 @@ (defun org-id-goto (id)
(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)
@@ -742,7 +742,7 @@ (defun org-id-open (id _)
(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-keys.el b/lisp/org-keys.el
index b8e9ddd93..782ffa871 100644
--- a/lisp/org-keys.el
+++ b/lisp/org-keys.el
@@ -67,8 +67,8 @@ (declare-function org-ctrl-c-star "org" ())
(declare-function org-ctrl-c-tab "org" (&optional arg))
(declare-function org-cut-special "org" ())
(declare-function org-cut-subtree "org" (&optional n))
-(declare-function org-cycle "org" (&optional arg))
-(declare-function org-cycle-agenda-files "org" ())
+(declare-function org-cycle "org-cycle" (&optional arg))
+(declare-function org-cycle-agenda-files "org-cycle" ())
(declare-function org-date-from-calendar "org" ())
(declare-function org-dynamic-block-insert-dblock "org" (&optional arg))
(declare-function org-dblock-update "org" (&optional arg))
@@ -94,7 +94,7 @@ (declare-function org-feed-update-all "org" ())
(declare-function org-fill-paragraph "org" (&optional justify region))
(declare-function org-find-file-at-mouse "org" (ev))
(declare-function org-footnote-action "org" (&optional special))
-(declare-function org-force-cycle-archived "org" ())
+(declare-function org-cycle-force-archived "org-cycle" ())
(declare-function org-force-self-insert "org" (n))
(declare-function org-forward-element "org" ())
(declare-function org-forward-heading-same-level "org" (arg &optional invisible-ok))
@@ -143,8 +143,8 @@ (declare-function org-previous-visible-heading "org" (arg))
(declare-function org-priority "org" (&optional action show))
(declare-function org-promote-subtree "org" ())
(declare-function org-redisplay-inline-images "org" ())
-(declare-function org-refile "org" (&optional arg1 default-buffer rfloc msg))
-(declare-function org-refile-copy "org" ())
+(declare-function org-refile "org-refile" (&optional arg1 default-buffer rfloc msg))
+(declare-function org-refile-copy "org-refile" ())
(declare-function org-refile-reverse "org-refile" (&optional arg default-buffer rfloc msg))
(declare-function org-reftex-citation "org" ())
(declare-function org-reload "org" (&optional arg1))
@@ -152,7 +152,7 @@ (declare-function org-remove-file "org" (&optional file))
(declare-function org-resolve-clocks "org" (&optional only-dangling-p prompt-fn last-valid))
(declare-function org-return "org" (&optional indent))
(declare-function org-return-and-maybe-indent "org" ())
-(declare-function org-reveal "org" (&optional siblings))
+(declare-function org-fold-reveal "org-fold" (&optional siblings))
(declare-function org-schedule "org" (arg &optional time))
(declare-function org-self-insert-command "org" (N))
(declare-function org-set-effort "org" (&optional increment value))
@@ -172,9 +172,9 @@ (declare-function org-shiftmetaup "org" (&optional arg))
(declare-function org-shiftright "org" (&optional arg))
(declare-function org-shifttab "org" (&optional arg))
(declare-function org-shiftup "org" (&optional arg))
-(declare-function org-show-all "org" (&optional types))
-(declare-function org-show-children "org" (&optional level))
-(declare-function org-show-subtree "org" ())
+(declare-function org-fold-show-all "org-fold" (&optional types))
+(declare-function org-fold-show-children "org-fold" (&optional level))
+(declare-function org-fold-show-subtree "org-fold" ())
(declare-function org-sort "org" (&optional with-case))
(declare-function org-sparse-tree "org" (&optional arg type))
(declare-function org-table-copy-down "org" (n))
@@ -423,7 +423,7 @@ (define-key org-mode-map [menu-bar hide] 'undefined)
(define-key org-mode-map [menu-bar show] 'undefined)
(define-key org-mode-map [remap outline-mark-subtree] #'org-mark-subtree)
-(define-key org-mode-map [remap outline-show-subtree] #'org-show-subtree)
+(define-key org-mode-map [remap outline-show-subtree] #'org-fold-show-subtree)
(define-key org-mode-map [remap outline-forward-same-level]
#'org-forward-heading-same-level)
(define-key org-mode-map [remap outline-backward-same-level]
@@ -437,14 +437,14 @@ (define-key org-mode-map [remap outline-next-visible-heading]
#'org-next-visible-heading)
(define-key org-mode-map [remap outline-previous-visible-heading]
#'org-previous-visible-heading)
-(define-key org-mode-map [remap show-children] #'org-show-children)
+(define-key org-mode-map [remap outline-show-children] #'org-fold-show-children)
;;;; Make `C-c C-x' a prefix key
(org-defkey org-mode-map (kbd "C-c C-x") (make-sparse-keymap))
;;;; TAB key with modifiers
(org-defkey org-mode-map (kbd "TAB") #'org-cycle)
-(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-force-cycle-archived)
+(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-cycle-force-archived)
;; Override text-mode binding to expose `complete-symbol' for
;; pcomplete functionality.
(org-defkey org-mode-map (kbd "M-TAB") nil)
@@ -544,7 +544,7 @@ (org-remap org-mode-map
;;;; All the other keys
(org-defkey org-mode-map (kbd "|") #'org-force-self-insert)
-(org-defkey org-mode-map (kbd "C-c C-r") #'org-reveal)
+(org-defkey org-mode-map (kbd "C-c C-r") #'org-fold-reveal)
(org-defkey org-mode-map (kbd "C-M-t") #'org-transpose-element)
(org-defkey org-mode-map (kbd "M-}") #'org-forward-element)
(org-defkey org-mode-map (kbd "ESC }") #'org-forward-element)
diff --git a/lisp/org-lint.el b/lisp/org-lint.el
index 10b9a3589..3518edeb1 100644
--- a/lisp/org-lint.el
+++ b/lisp/org-lint.el
@@ -91,6 +91,7 @@ (require 'oc)
(require 'ol)
(require 'org-attach)
(require 'org-macro)
+(require 'org-fold)
(require 'ox)
(require 'seq)
@@ -264,7 +265,7 @@ (defun org-lint--jump-to-source ()
(let ((l (org-lint--current-line)))
(switch-to-buffer-other-window org-lint--source-buffer)
(org-goto-line l)
- (org-show-set-visibility 'local)
+ (org-fold-show-set-visibility 'local)
(recenter)))
(defun org-lint--show-source ()
diff --git a/lisp/org-list.el b/lisp/org-list.el
index 3533c8319..187e9a9ff 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -79,6 +79,7 @@ ;;; Code:
(require 'cl-lib)
(require 'org-macs)
(require 'org-compat)
+(require 'org-fold-core)
(defvar org-M-RET-may-split-line)
(defvar org-adapt-indentation)
@@ -138,7 +139,8 @@ (declare-function org-outline-level "org" ())
(declare-function org-previous-line-empty-p "org" ())
(declare-function org-reduced-level "org" (L))
(declare-function org-set-tags "org" (tags))
-(declare-function org-show-subtree "org" ())
+(declare-function org-fold-show-subtree "org-fold" ())
+(declare-function org-fold-region "org-fold" (from to flag &optional spec))
(declare-function org-sort-remove-invisible "org" (S))
(declare-function org-time-string-to-seconds "org" (s))
(declare-function org-timer-hms-to-secs "org-timer" (hms))
@@ -2029,7 +2031,7 @@ (defun org-list-set-item-visibility (item struct view)
((eq view 'folded)
(let ((item-end (org-list-get-item-end-before-blank item struct)))
;; Hide from eol
- (org-flag-region (save-excursion (goto-char item) (line-end-position))
+ (org-fold-region (save-excursion (goto-char item) (line-end-position))
item-end t 'outline)))
((eq view 'children)
;; First show everything.
@@ -2042,7 +2044,7 @@ (defun org-list-set-item-visibility (item struct view)
((eq view 'subtree)
;; Show everything
(let ((item-end (org-list-get-item-end item struct)))
- (org-flag-region item item-end nil 'outline)))))
+ (org-fold-region item item-end nil 'outline)))))
(defun org-list-item-body-column (item)
"Return column at which body of ITEM should start."
@@ -2455,7 +2457,7 @@ (defun org-reset-checkbox-state-subtree ()
(save-restriction
(save-excursion
(org-narrow-to-subtree)
- (org-show-subtree)
+ (org-fold-show-subtree)
(goto-char (point-min))
(let ((end (point-max)))
(while (< (point) end)
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index 8d156fa2f..2968e2ba5 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -35,11 +35,16 @@ (require 'cl-lib)
(require 'format-spec)
(declare-function org-mode "org" ())
-(declare-function org-show-context "org" (&optional key))
+(declare-function org-agenda-files "org" (&optional unrestricted archives))
+(declare-function org-fold-show-context "org-fold" (&optional key))
+(declare-function org-fold-save-outline-visibility "org-fold" (use-markers &rest body))
+(declare-function org-fold-next-visibility-change "org-fold" (&optional pos limit ignore-hidden-p previous-p))
+(declare-function org-fold-folded-p "org-fold" (&optional pos limit ignore-hidden-p previous-p))
(declare-function string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case))
(defvar org-ts-regexp0)
(defvar ffap-url-regexp)
+(defvar org-fold-core-style)
\f
;;; Macros
@@ -117,38 +122,7 @@ (defmacro org-no-read-only (&rest body)
(declare (debug (body)))
`(let ((inhibit-read-only t)) ,@body))
-(defmacro org-save-outline-visibility (use-markers &rest body)
- "Save and restore outline visibility around BODY.
-If USE-MARKERS is non-nil, use markers for the positions. This
-means that the buffer may change while running BODY, but it also
-means that the buffer should stay alive during the operation,
-because otherwise all these markers will point to nowhere."
- (declare (debug (form body)) (indent 1))
- (org-with-gensyms (data invisible-types markers?)
- `(let* ((,invisible-types '(org-hide-block outline))
- (,markers? ,use-markers)
- (,data
- (mapcar (lambda (o)
- (let ((beg (overlay-start o))
- (end (overlay-end o))
- (type (overlay-get o 'invisible)))
- (and beg end
- (> end beg)
- (memq type ,invisible-types)
- (list (if ,markers? (copy-marker beg) beg)
- (if ,markers? (copy-marker end t) end)
- type))))
- (org-with-wide-buffer
- (overlays-in (point-min) (point-max))))))
- (unwind-protect (progn ,@body)
- (org-with-wide-buffer
- (dolist (type ,invisible-types)
- (remove-overlays (point-min) (point-max) 'invisible type))
- (pcase-dolist (`(,beg ,end ,type) (delq nil ,data))
- (org-flag-region beg end t type)
- (when ,markers?
- (set-marker beg nil)
- (set-marker end nil))))))))
+(defalias 'org-save-outline-visibility #'org-fold-save-outline-visibility)
(defmacro org-with-wide-buffer (&rest body)
"Execute body while temporarily widening the buffer."
diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el
index 5cfaa7fe0..dd5333399 100644
--- a/lisp/org-mobile.el
+++ b/lisp/org-mobile.el
@@ -1064,7 +1064,7 @@ (defun org-mobile-edit (what old new)
(progn
;; Workaround a `org-insert-heading-respect-content' bug
;; which prevents correct insertion when point is invisible
- (org-show-subtree)
+ (org-fold-show-subtree)
(end-of-line 1)
(org-insert-heading-respect-content t)
(org-demote))
diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el
index 8d5be4254..fadd38848 100644
--- a/lisp/org-mouse.el
+++ b/lisp/org-mouse.el
@@ -1003,10 +1003,10 @@ (defun org-mouse-do-remotely (command)
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-hidden-entry)
+ (org-fold-show-hidden-entry)
(save-excursion
(and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
+ (org-fold-heading nil))) ; show the next heading
(org-back-to-heading)
(setq marker (point-marker))
(goto-char (max (point-at-bol) (- (point-at-eol) anticol)))
diff --git a/lisp/org-refile.el b/lisp/org-refile.el
index 5dfffe785..d68760623 100644
--- a/lisp/org-refile.el
+++ b/lisp/org-refile.el
@@ -521,7 +521,7 @@ (defun org-refile (&optional arg default-buffer rfloc msg)
(goto-char (cond (pos)
((org-notes-order-reversed-p) (point-min))
(t (point-max))))
- (org-show-context 'org-goto))
+ (org-fold-show-context 'org-goto))
(if regionp
(progn
(org-kill-new (buffer-substring region-start region-end))
diff --git a/lisp/org-src.el b/lisp/org-src.el
index 4fac93400..1197540d1 100644
--- a/lisp/org-src.el
+++ b/lisp/org-src.el
@@ -1356,8 +1356,10 @@ (defun org-edit-src-exit ()
(goto-char beg)
(cond
;; Block is hidden; move at start of block.
- ((cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block))
- (overlays-at (point)))
+ ((if (eq org-fold-core-style 'text-properties)
+ (org-fold-folded-p nil 'block)
+ (cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block))
+ (overlays-at (point))))
(beginning-of-line 0))
(write-back (org-src--goto-coordinates coordinates beg end))))
;; Clean up left-over markers and restore window configuration.
diff --git a/lisp/org-timer.el b/lisp/org-timer.el
index a6f3648fa..0c9350e76 100644
--- a/lisp/org-timer.el
+++ b/lisp/org-timer.el
@@ -478,7 +478,7 @@ (defun org-timer--get-timer-title ()
(with-current-buffer (marker-buffer marker)
(org-with-wide-buffer
(goto-char hdmarker)
- (org-show-entry)
+ (org-fold-show-entry)
(or (ignore-errors (org-get-heading))
(buffer-name (buffer-base-buffer))))))))
((derived-mode-p 'org-mode)
diff --git a/lisp/org.el b/lisp/org.el
index b17a5477c..ebc9d81db 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -96,6 +96,9 @@ (require 'org-keys)
(require 'ol)
(require 'oc)
(require 'org-table)
+(require 'org-fold)
+
+(require 'org-cycle)
;; `org-outline-regexp' ought to be a defconst but is let-bound in
;; some places -- e.g. see the macro `org-with-limited-levels'.
@@ -4669,7 +4672,7 @@ (define-derived-mode org-mode outline-mode "Org"
t))
(when org-startup-with-inline-images (org-display-inline-images))
(when org-startup-with-latex-preview (org-latex-preview '(16)))
- (unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility))
+ (unless org-inhibit-startup-visibility-stuff (org-cycle-set-startup-visibility))
(when org-startup-truncated (setq truncate-lines t))
(when org-startup-numerated (require 'org-num) (org-num-mode 1))
(when org-startup-indented (require 'org-indent) (org-indent-mode 1))))
@@ -5864,7 +5867,7 @@ (defun org-tree-to-indirect-buffer (&optional arg)
(pop-to-buffer ibuf))
(t (error "Invalid value")))
(narrow-to-region beg end)
- (org-show-all '(headings drawers blocks))
+ (org-fold-show-all '(headings drawers blocks))
(goto-char pos)
(run-hook-with-args 'org-cycle-hook 'all)
(and (window-live-p cwin) (select-window cwin))))
@@ -5976,10 +5979,15 @@ (defun org-insert-heading (&optional arg invisible-ok top)
;; When INVISIBLE-OK is non-nil, ensure newly created headline
;; is visible.
(unless invisible-ok
- (pcase (get-char-property-and-overlay (point) 'invisible)
- (`(outline . ,o)
- (move-overlay o (overlay-start o) (line-end-position 0)))
- (_ nil))))
+ (if (eq org-fold-core-style 'text-properties)
+ (cond
+ ((org-fold-folded-p (line-beginning-position) 'headline)
+ (org-fold-region (line-end-position 0) (line-end-position) nil 'headline))
+ (t nil))
+ (pcase (get-char-property-and-overlay (point) 'invisible)
+ (`(outline . ,o)
+ (move-overlay o (overlay-start o) (line-end-position 0)))
+ (_ nil)))))
;; At a headline...
((org-at-heading-p)
(cond ((bolp)
@@ -6521,7 +6529,7 @@ (defun org-convert-to-oddeven-levels ()
(goto-char (point-min))
;; First check if there are no even levels
(when (re-search-forward "^\\(\\*\\*\\)+ " nil t)
- (org-show-set-visibility 'canonical)
+ (org-fold-show-set-visibility 'canonical)
(error "Not all levels are odd in this file. Conversion not possible"))
(when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
(let ((outline-regexp org-outline-regexp)
@@ -6614,9 +6622,9 @@ (defun org-move-subtree-down (&optional arg)
(setq txt (buffer-substring beg end))
(org-save-markers-in-region beg end)
(delete-region beg end)
- (org-remove-empty-overlays-at beg)
- (unless (= beg (point-min)) (org-flag-region (1- beg) beg nil 'outline))
- (unless (bobp) (org-flag-region (1- (point)) (point) nil 'outline))
+ (when (eq org-fold-core-style 'overlays) (org-remove-empty-overlays-at beg))
+ (unless (= beg (point-min)) (org-fold-region (1- beg) beg nil 'outline))
+ (unless (bobp) (org-fold-region (1- (point)) (point) nil 'outline))
(and (not (bolp)) (looking-at "\n") (forward-char 1))
(let ((bbb (point)))
(insert-before-markers txt)
@@ -6627,9 +6635,9 @@ (defun org-move-subtree-down (&optional arg)
(org-skip-whitespace)
(move-marker ins-point nil)
(if folded
- (org-flag-subtree t)
- (org-show-entry)
- (org-show-children))
+ (org-fold-subtree t)
+ (org-fold-show-entry)
+ (org-fold-show-children))
(org-clean-visibility-after-subtree-move)
;; move back to the initial column we were at
(move-to-column col))))
@@ -6987,7 +6995,7 @@ (defun org-clone-subtree-with-time-shift (n &optional shift)
(insert template)
(org-mode)
(goto-char (point-min))
- (org-show-subtree)
+ (org-fold-show-subtree)
(and idprop (if org-clone-delete-id
(org-entry-delete nil "ID")
(org-id-get-create t)))
@@ -7259,7 +7267,7 @@ (defun org-sort-entries
(point))
what "children")
(goto-char start)
- (outline-show-subtree)
+ (org-fold-show-subtree)
(outline-next-heading))
(t
;; we will sort the top-level entries in this file
@@ -7275,7 +7283,7 @@ (defun org-sort-entries
(setq end (point-max))
(setq what "top-level")
(goto-char start)
- (org-show-all '(headings drawers blocks))))
+ (org-fold-show-all '(headings drawers blocks))))
(setq beg (point))
(when (>= beg end) (goto-char start) (user-error "Nothing to sort"))
@@ -7858,7 +7866,7 @@ (defun org-open-file (path &optional in-emacs line search)
(funcall (cdr (assq 'file org-link-frame-setup)) file)
(widen)
(cond (line (org-goto-line line)
- (when (derived-mode-p 'org-mode) (org-reveal)))
+ (when (derived-mode-p 'org-mode) (org-fold-reveal)))
(search (condition-case err
(org-link-search search)
;; Save position before error-ing out so user
@@ -8154,7 +8162,7 @@ (defun org-mark-ring-goto (&optional n)
(setq m (car p))
(pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
- (when (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
+ (when (or (org-invisible-p) (org-invisible-p2)) (org-fold-show-context 'mark-goto))))
;;; Following specific links
@@ -10165,7 +10173,7 @@ (defun org-occur (regexp &optional keep-previous callback)
"Make a compact tree showing all matches of REGEXP.
The tree will show the lines where the regexp matches, and any other context
-defined in `org-show-context-detail', which see.
+defined in `org-fold-show-context-detail', which see.
When optional argument KEEP-PREVIOUS is non-nil, highlighting and exposing
done by a previous call to `org-occur' will be kept, to allow stacking of
@@ -10187,7 +10195,7 @@ (defun org-occur (regexp &optional keep-previous callback)
(when (or (not keep-previous) ; do not want to keep
(not org-occur-highlights)) ; no previous matches
;; hide everything
- (org-overview))
+ (org-cycle-overview))
(let ((case-fold-search (if (eq org-occur-case-fold-search 'smart)
(isearch-no-upper-case-p regexp t)
org-occur-case-fold-search)))
@@ -10197,12 +10205,12 @@ (defun org-occur (regexp &optional keep-previous callback)
(setq cnt (1+ cnt))
(when org-highlight-sparse-tree-matches
(org-highlight-new-match (match-beginning 0) (match-end 0)))
- (org-show-context 'occur-tree)))))
+ (org-fold-show-context 'occur-tree)))))
(when org-remove-highlights-with-change
(add-hook 'before-change-functions 'org-remove-occur-highlights
nil 'local))
(unless org-sparse-tree-open-archived-trees
- (org-hide-archived-subtrees (point-min) (point-max)))
+ (org-fold-hide-archived-subtrees (point-min) (point-max)))
(run-hooks 'org-occur-hook)
(when (called-interactively-p 'interactive)
(message "%d match(es) for regexp %s" cnt regexp))
@@ -10486,7 +10494,7 @@ (defun org-scan-tags (action matcher todo-only &optional start-level)
(save-excursion
(goto-char (point-min))
(when (eq action 'sparse-tree)
- (org-overview)
+ (org-cycle-overview)
(org-remove-occur-highlights))
(if (org-element--cache-active-p)
(let ((fast-re (concat "^"
@@ -10535,7 +10543,7 @@ (defun org-scan-tags (action matcher todo-only &optional start-level)
(org-get-heading) (match-end 0)
(org-highlight-new-match
(match-beginning 1) (match-end 1)))
- (org-show-context 'tags-tree))
+ (org-fold-show-context 'tags-tree))
((eq action 'agenda)
(let* ((effort (org-entry-get (point) org-effort-property))
(effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))))
@@ -10661,7 +10669,7 @@ (defun org-scan-tags (action matcher todo-only &optional start-level)
(org-get-heading) (match-end 0)
(org-highlight-new-match
(match-beginning 1) (match-end 1)))
- (org-show-context 'tags-tree))
+ (org-fold-show-context 'tags-tree))
((eq action 'agenda)
(setq txt (org-agenda-format-item
""
@@ -10699,7 +10707,7 @@ (defun org-scan-tags (action matcher todo-only &optional start-level)
(and (= (point) lspos) (end-of-line 1))))))
(when (and (eq action 'sparse-tree)
(not org-sparse-tree-open-archived-trees))
- (org-hide-archived-subtrees (point-min) (point-max)))
+ (org-fold-hide-archived-subtrees (point-min) (point-max)))
(nreverse rtn)))
(defun org-remove-uninherited-tags (tags)
@@ -12548,7 +12556,7 @@ (defun org-insert-property-drawer ()
(inhibit-read-only t))
(unless (bobp) (insert "\n"))
(insert ":PROPERTIES:\n:END:")
- (org-flag-region (line-end-position 0) (point) t 'outline)
+ (org-fold-region (line-end-position 0) (point) t (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))
(when (or (eobp) (= begin (point-min))) (insert "\n"))
(org-indent-region begin (point))))))
@@ -14379,7 +14387,7 @@ (defun org-timestamp-change (n &optional what updown suppress-tmp-delay)
(message "No clock to adjust")
(save-excursion
(org-goto-marker-or-bmk clfixpos)
- (org-show-subtree)
+ (org-fold-show-subtree)
(when (re-search-forward clrgx nil t)
(goto-char (match-beginning 1))
(let (org-clock-adjust-closest)
@@ -15877,7 +15885,7 @@ (defun org-self-insert-command (N)
If the cursor is in a table looking at whitespace, the whitespace is
overwritten, and the table is not marked as requiring realignment."
(interactive "p")
- (org-check-before-invisible-edit 'insert)
+ (org-fold-check-before-invisible-edit 'insert)
(cond
((and org-use-speed-commands
(let ((kv (this-command-keys-vector)))
@@ -15947,7 +15955,7 @@ (defun org-delete-backward-char (N)
because, in this case the deletion might narrow the column."
(interactive "p")
(save-match-data
- (org-check-before-invisible-edit 'delete-backward)
+ (org-fold-check-before-invisible-edit 'delete-backward)
(if (and (= N 1)
(not overwrite-mode)
(not (org-region-active-p))
@@ -15967,7 +15975,7 @@ (defun org-delete-char (N)
because, in this case the deletion might narrow the column."
(interactive "p")
(save-match-data
- (org-check-before-invisible-edit 'delete)
+ (org-fold-check-before-invisible-edit 'delete)
(cond
((or (/= N 1)
(eq (char-after) ?|)
@@ -16153,11 +16161,11 @@ (defun org-shifttab (&optional arg)
((integerp arg)
(let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg)))
(message "Content view to level: %d" arg)
- (org-content (prefix-numeric-value arg2))
+ (org-cycle-content (prefix-numeric-value arg2))
(org-cycle-show-empty-lines t)
(setq org-cycle-global-status 'overview)
(run-hook-with-args 'org-cycle-hook 'overview)))
- (t (call-interactively 'org-global-cycle))))
+ (t (call-interactively 'org-cycle-global))))
(defun org-shiftmetaleft ()
"Promote subtree or delete table column.
@@ -16311,14 +16319,14 @@ (defun org-check-for-hidden (what)
(setq beg (point-at-bol))
(beginning-of-line 2)
(while (and (not (eobp)) ;; this is like `next-line'
- (get-char-property (1- (point)) 'invisible))
+ (org-invisible-p (1- (point))))
(beginning-of-line 2))
(setq end (point))
(goto-char beg)
(goto-char (point-at-eol))
(setq end (max end (point)))
(while (re-search-forward re end t)
- (when (get-char-property (match-beginning 0) 'invisible)
+ (when (org-invisible-p (match-beginning 0))
(throw 'exit t))))
nil))))
@@ -16606,11 +16614,18 @@ (defun org-copy-visible (beg end)
(interactive "r")
(let ((result ""))
(while (/= beg end)
- (when (get-char-property beg 'invisible)
- (setq beg (next-single-char-property-change beg 'invisible nil end)))
- (let ((next (next-single-char-property-change beg 'invisible nil end)))
- (setq result (concat result (buffer-substring beg next)))
- (setq beg next)))
+ (if (eq org-fold-core-style 'text-properties)
+ (progn
+ (while (org-invisible-p beg)
+ (setq beg (org-fold-next-visibility-change beg end)))
+ (let ((next (org-fold-next-visibility-change beg end)))
+ (setq result (concat result (buffer-substring beg next)))
+ (setq beg next)))
+ (when (get-char-property beg 'invisible)
+ (setq beg (next-single-char-property-change beg 'invisible nil end)))
+ (let ((next (next-single-char-property-change beg 'invisible nil end)))
+ (setq result (concat result (buffer-substring beg next)))
+ (setq beg next))))
(setq deactivate-mark t)
(kill-new result)
(message "Visible strings have been copied to the kill ring.")))
@@ -16984,14 +16999,14 @@ (defun org-kill-note-or-show-branches ()
(cond (org-finish-function
(let ((org-note-abort t)) (funcall org-finish-function)))
((org-before-first-heading-p)
- (org-show-branches-buffer)
- (org-hide-archived-subtrees (point-min) (point-max)))
+ (org-fold-show-branches-buffer)
+ (org-fold-hide-archived-subtrees (point-min) (point-max)))
(t
(let ((beg (progn (org-back-to-heading) (point)))
(end (save-excursion (org-end-of-subtree t t) (point))))
- (outline-hide-subtree)
- (outline-show-branches)
- (org-hide-archived-subtrees beg end)))))
+ (org-fold-hide-subtree)
+ (org-fold-show-branches)
+ (org-fold-hide-archived-subtrees beg end)))))
(defun org-delete-indentation (&optional arg)
"Join current line to previous and fix whitespace at join.
@@ -17114,7 +17129,7 @@ (defun org-return (&optional indent arg interactive)
(org-auto-align-tags (org-align-tags))
(t (org--align-tags-here tags-column))) ;preserve tags column
(end-of-line)
- (org-show-entry)
+ (org-fold-show-entry)
(org--newline indent arg interactive)
(when string (save-excursion (insert (org-trim string))))))
;; In a list, make sure indenting keeps trailing text within.
@@ -17152,11 +17167,11 @@ (defun org-ctrl-c-tab (&optional arg)
(call-interactively #'org-table-toggle-column-width))
((org-before-first-heading-p)
(save-excursion
- (org-flag-above-first-heading)
- (outline-hide-sublevels (or arg 1))))
+ (org-fold-flag-above-first-heading)
+ (org-fold-hide-sublevels (or arg 1))))
(t
- (outline-hide-subtree)
- (org-show-children arg))))
+ (org-fold-hide-subtree)
+ (org-fold-show-children arg))))
(defun org-ctrl-c-star ()
"Compute table, or change heading status of lines.
@@ -17291,7 +17306,7 @@ (defun org-meta-return (&optional arg)
`org-table-wrap-region', depending on context. When called with
an argument, unconditionally call `org-insert-heading'."
(interactive "P")
- (org-check-before-invisible-edit 'insert)
+ (org-fold-check-before-invisible-edit 'insert)
(or (run-hook-with-args-until-success 'org-metareturn-hook)
(call-interactively (cond (arg #'org-insert-heading)
((org-at-table-p) #'org-table-wrap-region)
@@ -17311,8 +17326,8 @@ (easy-menu-define org-org-menu org-mode-map "Org menu."
["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))]
["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))]
["Sparse Tree..." org-sparse-tree t]
- ["Reveal Context" org-reveal t]
- ["Show All" org-show-all t]
+ ["Reveal Context" org-fold-reveal t]
+ ["Show All" org-fold-show-all t]
"--"
["Subtree to indirect buffer" org-tree-to-indirect-buffer t])
"--"
@@ -17770,7 +17785,7 @@ (defun org-goto-marker-or-bmk (marker &optional bookmark)
(when (or (> marker (point-max)) (< marker (point-min)))
(widen))
(goto-char marker)
- (org-show-context 'org-goto))
+ (org-fold-show-context 'org-goto))
(if bookmark
(bookmark-jump bookmark)
(error "Cannot find location"))))
@@ -18007,7 +18022,7 @@ (defun org-occur-in-agenda-files (regexp &optional _nlines)
regexp)))
(add-hook 'occur-mode-find-occurrence-hook
- (lambda () (when (derived-mode-p 'org-mode) (org-reveal))))
+ (lambda () (when (derived-mode-p 'org-mode) (org-fold-reveal))))
(defun org-occur-link-in-agenda-files ()
"Create a link and search for it in the agendas.
@@ -18943,7 +18958,7 @@ (defun org-next-block (arg &optional backward block-regexp)
(cl-decf count))))
(if (= count 0)
(prog1 (goto-char (org-element-property :post-affiliated last-element))
- (save-match-data (org-show-context)))
+ (save-match-data (org-fold-show-context)))
(goto-char origin)
(user-error "No %s code blocks" (if backward "previous" "further")))))
@@ -19424,7 +19439,7 @@ (defun org-kill-line (&optional _arg)
((or (not org-special-ctrl-k)
(bolp)
(not (org-at-heading-p)))
- (when (and (get-char-property (line-end-position) 'invisible)
+ (when (and (org-invisible-p (line-end-position))
org-ctrl-k-protect-subtree
(or (eq org-ctrl-k-protect-subtree 'error)
(not (y-or-n-p "Kill hidden subtree along with headline? "))))
@@ -19512,7 +19527,7 @@ (defun org-yank-generic (command arg)
(or (looking-at org-outline-regexp)
(re-search-forward org-outline-regexp-bol end t))
(while (and (< (point) end) (looking-at org-outline-regexp))
- (org-flag-subtree t)
+ (org-fold-subtree t)
(org-cycle-show-empty-lines 'folded)
(condition-case nil
(outline-forward-same-level 1)
@@ -19569,7 +19584,7 @@ (defun org-back-to-heading (&optional invisible-ok)
(fboundp 'org-inlinetask-end-p)
(org-inlinetask-end-p))
(org-inlinetask-goto-beginning)
- (setq found (and (or invisible-ok (not (org-invisible-p)))
+ (setq found (and (or invisible-ok (not (org-fold-folded-p)))
(point))))))
(goto-char found)
found)))
@@ -20606,9 +20621,9 @@ (defun org-info-find-node (&optional nodename)
\f
;;; Finish up
-(add-hook 'org-mode-hook ;remove overlays when changing major mode
+(add-hook 'org-mode-hook ;remove folds when changing major mode
(lambda () (add-hook 'change-major-mode-hook
- 'org-show-all 'append 'local)))
+ 'org-fold-show-all 'append 'local)))
(provide 'org)
diff --git a/lisp/ox-org.el b/lisp/ox-org.el
index 3d3c4fe6a..96d22d178 100644
--- a/lisp/ox-org.el
+++ b/lisp/ox-org.el
@@ -329,7 +329,7 @@ (defun org-org-publish-to-org (plist filename pub-dir)
newbuf)
(with-current-buffer work-buffer
(org-font-lock-ensure)
- (org-show-all)
+ (org-fold-show-all)
(setq newbuf (htmlize-buffer)))
(with-current-buffer newbuf
(when org-org-htmlized-css-url
diff --git a/testing/lisp/test-org-list.el b/testing/lisp/test-org-list.el
index 3689a172f..24d96e58b 100644
--- a/testing/lisp/test-org-list.el
+++ b/testing/lisp/test-org-list.el
@@ -627,7 +627,7 @@ (ert-deftest test-org-list/move-item-down-contents-visibility ()
#+BEGIN_CENTER
Text2
#+END_CENTER"
- (org-hide-block-all)
+ (org-fold-hide-block-all)
(let ((invisible-property-1
(progn
(search-forward "Text1")
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index ce4d7b9dd..273441e0f 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -3787,7 +3787,7 @@ (ert-deftest test-org/end-of-line ()
(should-not
(org-test-with-temp-text "#+BEGIN_CENTER\nContents\n#+END_CENTER"
(let ((org-special-ctrl-a/e t))
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(org-end-of-line)
(eobp))))
;; Get past invisible characters at the end of line.
@@ -3935,7 +3935,7 @@ (ert-deftest test-org/forward-paragraph ()
(should
(= 6
(org-test-with-temp-text "#+begin_center\nP1\n\nP2\n#+end_center\nP3"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(org-forward-paragraph)
(org-current-line))))
;; On an item or a footnote definition, move past the first element
@@ -4055,7 +4055,7 @@ (ert-deftest test-org/backward-paragraph ()
(bobp)))
(should
(org-test-with-temp-text "#+begin_center\nP1\n\nP2\n#+end_center\n"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(goto-char (point-max))
(org-backward-paragraph)
(bobp)))
@@ -8057,108 +8057,110 @@ (ert-deftest test-org/timestamp-to-time ()
;;; Visibility
(ert-deftest test-org/hide-drawer-toggle ()
- "Test `org-hide-drawer-toggle' specifications."
+ "Test `org-fold-hide-drawer-toggle' specifications."
;; Error when not at a drawer.
(should-error
(org-test-with-temp-text ":fake-drawer:\ncontents"
- (org-hide-drawer-toggle 'off)
+ (org-fold-hide-drawer-toggle 'off)
(get-char-property (line-end-position) 'invisible)))
(should-error
(org-test-with-temp-text
"#+begin_example\n<point>:D:\nc\n:END:\n#+end_example"
- (org-hide-drawer-toggle t)))
+ (org-fold-hide-drawer-toggle t)))
;; Hide drawer.
(should
(org-test-with-temp-text ":drawer:\ncontents\n:end:"
- (org-hide-drawer-toggle)
+ (org-fold-show-all)
+ (org-fold-hide-drawer-toggle)
(get-char-property (line-end-position) 'invisible)))
;; Show drawer unconditionally when optional argument is `off'.
(should-not
(org-test-with-temp-text ":drawer:\ncontents\n:end:"
- (org-hide-drawer-toggle)
- (org-hide-drawer-toggle 'off)
+ (org-fold-hide-drawer-toggle)
+ (org-fold-hide-drawer-toggle 'off)
(get-char-property (line-end-position) 'invisible)))
;; Hide drawer unconditionally when optional argument is non-nil.
(should
(org-test-with-temp-text ":drawer:\ncontents\n:end:"
- (org-hide-drawer-toggle t)
+ (org-fold-hide-drawer-toggle t)
(get-char-property (line-end-position) 'invisible)))
;; Do not hide drawer when called from final blank lines.
(should-not
(org-test-with-temp-text ":drawer:\ncontents\n:end:\n\n<point>"
- (org-hide-drawer-toggle)
+ (org-fold-show-all)
+ (org-fold-hide-drawer-toggle)
(goto-char (point-min))
(get-char-property (line-end-position) 'invisible)))
;; Don't leave point in an invisible part of the buffer when hiding
;; a drawer away.
(should-not
(org-test-with-temp-text ":drawer:\ncontents\n<point>:end:"
- (org-hide-drawer-toggle)
+ (org-fold-hide-drawer-toggle)
(get-char-property (point) 'invisible))))
(ert-deftest test-org/hide-block-toggle ()
- "Test `org-hide-block-toggle' specifications."
+ "Test `org-fold-hide-block-toggle' specifications."
;; Error when not at a block.
(should-error
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents"
- (org-hide-block-toggle 'off)
+ (org-fold-hide-block-toggle 'off)
(get-char-property (line-end-position) 'invisible)))
;; Hide block.
(should
(org-test-with-temp-text "#+BEGIN_CENTER\ncontents\n#+END_CENTER"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(get-char-property (line-end-position) 'invisible)))
(should
(org-test-with-temp-text "#+BEGIN_EXAMPLE\ncontents\n#+END_EXAMPLE"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(get-char-property (line-end-position) 'invisible)))
;; Show block unconditionally when optional argument is `off'.
(should-not
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
- (org-hide-block-toggle)
- (org-hide-block-toggle 'off)
+ (org-fold-hide-block-toggle)
+ (org-fold-hide-block-toggle 'off)
(get-char-property (line-end-position) 'invisible)))
(should-not
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
- (org-hide-block-toggle 'off)
+ (org-fold-hide-block-toggle 'off)
(get-char-property (line-end-position) 'invisible)))
;; Hide block unconditionally when optional argument is non-nil.
(should
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
- (org-hide-block-toggle t)
+ (org-fold-hide-block-toggle t)
(get-char-property (line-end-position) 'invisible)))
(should
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
- (org-hide-block-toggle)
- (org-hide-block-toggle t)
+ (org-fold-hide-block-toggle)
+ (org-fold-hide-block-toggle t)
(get-char-property (line-end-position) 'invisible)))
;; Do not hide block when called from final blank lines.
(should-not
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE\n\n<point>"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(goto-char (point-min))
(get-char-property (line-end-position) 'invisible)))
;; Don't leave point in an invisible part of the buffer when hiding
;; a block away.
(should-not
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n<point>#+END_QUOTE"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(get-char-property (point) 'invisible))))
(ert-deftest test-org/hide-block-toggle-maybe ()
- "Test `org-hide-block-toggle-maybe' specifications."
+ "Test `org-fold-hide-block-toggle' specifications."
(should
(org-test-with-temp-text "#+BEGIN: dynamic\nContents\n#+END:"
- (org-hide-block-toggle-maybe)))
- (should-not
- (org-test-with-temp-text "Paragraph" (org-hide-block-toggle-maybe))))
+ (org-hide-block-toggle)))
+ (should-error
+ (org-test-with-temp-text "Paragraph" (org-hide-block-toggle))))
(ert-deftest test-org/show-set-visibility ()
- "Test `org-show-set-visibility' specifications."
+ "Test `org-fold-show-set-visibility' specifications."
;; Do not throw an error before first heading.
(should
(org-test-with-temp-text "Preamble\n* Headline"
- (org-show-set-visibility 'tree)
+ (org-fold-show-set-visibility 'tree)
t))
;; Test all visibility spans, both on headline and in entry.
(let ((list-visible-lines
@@ -8180,7 +8182,7 @@ (ert-deftest test-org/show-set-visibility ()
"
(org-cycle t)
(search-forward (if headerp "Self" "Match"))
- (org-show-set-visibility state)
+ (org-fold-show-set-visibility state)
(goto-char (point-min))
(let (result (line 0))
(while (not (eobp))
@@ -8211,24 +8213,24 @@ (ert-deftest test-org/show-set-visibility ()
;; visible.
(should-not
(org-test-with-temp-text "#+BEGIN_QUOTE\nText\n#+END_QUOTE"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(search-forward "Text")
- (org-show-set-visibility 'minimal)
+ (org-fold-show-set-visibility 'minimal)
(org-invisible-p2)))
(should-not
(org-test-with-temp-text ":DRAWER:\nText\n:END:"
- (org-hide-drawer-toggle)
+ (org-fold-hide-drawer-toggle)
(search-forward "Text")
- (org-show-set-visibility 'minimal)
+ (org-fold-show-set-visibility 'minimal)
(org-invisible-p2)))
(should-not
(org-test-with-temp-text
"#+BEGIN_QUOTE\n<point>:DRAWER:\nText\n:END:\n#+END_QUOTE"
- (org-hide-drawer-toggle)
+ (org-fold-hide-drawer-toggle)
(forward-line -1)
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(search-forward "Text")
- (org-show-set-visibility 'minimal)
+ (org-fold-show-set-visibility 'minimal)
(org-invisible-p2))))
(defun test-org/copy-visible ()
^ permalink raw reply related [relevance 12%]
* [PATCH 17/35] org-compat: Work around some third-party packages using outline-* functions
2022-01-29 11:37 13% ` [PATCH 02/35] Separate folding functions from org.el into new library: org-fold Ihor Radchenko
2022-01-29 11:38 12% ` [PATCH 09/35] Rename old function call to use org-fold Ihor Radchenko
@ 2022-01-29 11:38 12% ` Ihor Radchenko
2 siblings, 0 replies; 25+ results
From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw)
To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit,
Christian Heinrich, emacs-orgmode
Cc: Ihor Radchenko
[-- Attachment #1: Type: text/plain, Size: 126 bytes --]
---
lisp/org-compat.el | 72 +++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 71 insertions(+), 1 deletion(-)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0017-org-compat-Work-around-some-third-party-packages-usi.patch --]
[-- Type: text/x-patch; name="0017-org-compat-Work-around-some-third-party-packages-usi.patch", Size: 3384 bytes --]
diff --git a/lisp/org-compat.el b/lisp/org-compat.el
index 14afb4600..05efeca11 100644
--- a/lisp/org-compat.el
+++ b/lisp/org-compat.el
@@ -1311,11 +1311,81 @@ (defvar session-globals-exclude)
(eval-after-load 'session
'(add-to-list 'session-globals-exclude 'org-mark-ring))
+;;;; outline-mode
+
+;; Folding in outline-mode is not compatible with org-mode folding
+;; anymore. Working around to avoid breakage of external packages
+;; assuming the compatibility.
+(defadvice outline-flag-region (around outline-flag-region@fix-for-org-fold (from to flag) activate)
+ "Run `org-fold-region' when in org-mode."
+ (if (eq major-mode 'org-mode)
+ (setq ad-return-value (org-fold-region (max from (point-min)) (min to (point-max)) flag 'headline))
+ ad-do-it))
+
+(defadvice outline-next-visible-heading (around outline-next-visible-heading@fix-for-org-fold (arg) activate)
+ "Run `org-next-visible-heading' when in org-mode."
+ (interactive "p")
+ (if (eq major-mode 'org-mode)
+ (setq ad-return-value (org-next-visible-heading arg))
+ ad-do-it))
+
+(defadvice outline-back-to-heading (around outline-back-to-heading@fix-for-org-fold (&optional invisible-ok) activate)
+ "Run `org-back-to-heading' when in org-mode."
+ (if (eq major-mode 'org-mode)
+ (setq ad-return-value
+ (progn
+ (beginning-of-line)
+ (or (org-at-heading-p (not invisible-ok))
+ (let (found)
+ (save-excursion
+ (while (not found)
+ (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
+ nil t)
+ (signal 'outline-before-first-heading nil))
+ (setq found (and (or invisible-ok (not (org-fold-folded-p)))
+ (point)))))
+ (goto-char found)
+ found))))
+ ad-do-it))
+
+(defadvice outline-on-heading-p (around outline-on-heading-p@fix-for-org-fold (&optional invisible-ok) activate)
+ "Run `org-at-heading-p' when in org-mode."
+ (if (eq major-mode 'org-mode)
+ (setq ad-return-value (org-at-heading-p (not invisible-ok)))
+ ad-do-it))
+
+(defadvice outline-hide-sublevels (around outline-hide-sublevels@fix-for-org-fold (levels) activate)
+ "Run `org-fold-hide-sublevels' when in org-mode."
+ (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 (eq major-mode 'org-mode)
+ (setq ad-return-value (org-fold-hide-sublevels levels))
+ ad-do-it))
+
+(defadvice outline-toggle-children (around outline-toggle-children@fix-for-org-fold () activate)
+ "Run `org-fold-hide-sublevels' when in org-mode."
+ (interactive)
+ (if (eq major-mode 'org-mode)
+ (setq ad-return-value
+ (save-excursion
+ (org-back-to-heading)
+ (if (not (org-fold-folded-p (line-end-position)))
+ (org-fold-hide-subtree)
+ (org-fold-show-children)
+ (org-fold-show-entry))))
+ ad-do-it))
+
+;; TODO: outline-headers-as-kill
+
;;;; Speed commands
(make-obsolete-variable 'org-speed-commands-user
"configure `org-speed-commands' instead." "9.5")
-
(provide 'org-compat)
;; Local variables:
^ permalink raw reply related [relevance 12%]
* [PATCH v2 02/38] Separate folding functions from org.el into new library: org-fold
@ 2022-04-20 13:24 13% ` Ihor Radchenko
2022-04-20 13:25 12% ` [PATCH v2 09/38] Rename old function call to use org-fold--- Ihor Radchenko
2022-04-20 13:26 12% ` [PATCH v2 17/38] org-compat: Work around some third-party packages using outline-* functions Ihor Radchenko
2 siblings, 0 replies; 25+ results
From: Ihor Radchenko @ 2022-04-20 13:24 UTC (permalink / raw)
To: emacs-orgmode
---
lisp/org-fold.el | 1135 ++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 1135 insertions(+)
create mode 100644 lisp/org-fold.el
diff --git a/lisp/org-fold.el b/lisp/org-fold.el
new file mode 100644
index 000000000..52717fd86
--- /dev/null
+++ b/lisp/org-fold.el
@@ -0,0 +1,1135 @@
+;;; org-fold.el --- Folding of Org entries -*- lexical-binding: t; -*-
+;;
+;; Copyright (C) 2020-2020 Free Software Foundation, Inc.
+;;
+;; Author: Ihor Radchenko <yantar92 at gmail dot com>
+;; 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 folding is implemented using generic org-fold-core library. This file
+;; contains org-specific implementation of the folding. Also, various
+;; useful functions from org-fold-core are aliased under shorted `org-fold'
+;; prefix.
+
+;; The following features are implemented:
+;; - Folding/unfolding various Org mode elements and regions of Org buffers:
+;; + Region before first heading;
+;; + Org headings, their text, children (subtree), siblings, parents, etc;
+;; + Org blocks and drawers
+;; - Revealing Org structure around invisible point location
+;; - Revealing folded Org elements broken by user edits
+
+;;; Code:
+
+(require 'org-macs)
+(require 'org-fold-core)
+
+(defvar org-inlinetask-min-level)
+(defvar org-link--link-folding-spec)
+(defvar org-link--description-folding-spec)
+(defvar org-odd-levels-only)
+(defvar org-drawer-regexp)
+(defvar org-property-end-re)
+(defvar org-link-descriptive)
+(defvar org-outline-regexp-bol)
+(defvar org-custom-properties-hidden-p)
+(defvar org-archive-tag)
+
+;; Needed for overlays only
+(defvar org-custom-properties-overlays)
+
+(declare-function isearch-filter-visible "isearch" (beg end))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element--current-element "org-element" (limit &optional granularity mode structure))
+(declare-function org-element--cache-active-p "org-element" ())
+(declare-function org-toggle-custom-properties-visibility "org" ())
+(declare-function org-item-re "org-list" ())
+(declare-function org-up-heading-safe "org" ())
+(declare-function org-get-tags "org" (&optional pos local fontify))
+(declare-function org-get-valid-level "org" (level &optional change))
+(declare-function org-before-first-heading-p "org" ())
+(declare-function org-goto-sibling "org" (&optional previous))
+(declare-function org-block-map "org" (function &optional start end))
+(declare-function org-map-region "org" (fun beg end))
+(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
+(declare-function org-back-to-heading-or-point-min "org" (&optional invisible-ok))
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-at-heading-p "org" (&optional invisible-not-ok))
+(declare-function org-cycle-hide-drawers "org-cycle" (state))
+
+(declare-function outline-show-branches "outline" ())
+(declare-function outline-hide-sublevels "outline" (levels))
+(declare-function outline-get-next-sibling "outline" ())
+(declare-function outline-invisible-p "outline" (&optional pos))
+(declare-function outline-next-heading "outline" ())
+
+;;; 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-fold-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
+
+ ancestors-full show current subtree and its direct ancestors
+
+ 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 ancestors-full)
+ (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 'smart
+ "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
+
+;;; API
+
+;;;; Modifying folding specs
+
+(defalias 'org-fold-folding-spec-p #'org-fold-core-folding-spec-p)
+(defalias 'org-fold-add-folding-spec #'org-fold-core-add-folding-spec)
+(defalias 'org-fold-remove-folding-spec #'org-fold-core-remove-folding-spec)
+
+(defun org-fold-initialize (ellipsis)
+ "Setup folding in current Org buffer."
+ (setq-local org-fold-core-isearch-open-function #'org-fold--isearch-reveal)
+ (setq-local org-fold-core-extend-changed-region-functions (list #'org-fold--extend-changed-region))
+ ;; FIXME: Converting org-link + org-description to overlays when
+ ;; search matches hidden "[[" part of the link, reverses priority of
+ ;; link and description and hides the whole link. Working around
+ ;; this until there will be no need to convert text properties to
+ ;; overlays for isearch.
+ (setq-local org-fold-core--isearch-special-specs '(org-link))
+ (org-fold-core-initialize `((org-fold-outline
+ (:ellipsis . ,ellipsis)
+ (:fragile . ,#'org-fold--reveal-outline-maybe)
+ (:isearch-open . t)
+ ;; This is needed to make sure that inserting a
+ ;; new planning line in folded heading is not
+ ;; revealed.
+ (:front-sticky . t)
+ (:rear-sticky . t)
+ (:font-lock-skip . t)
+ (:alias . (headline heading outline inlinetask plain-list)))
+ (org-fold-block
+ (:ellipsis . ,ellipsis)
+ (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe)
+ (:isearch-open . t)
+ (:front-sticky . t)
+ (:alias . ( block center-block comment-block
+ dynamic-block example-block export-block
+ quote-block special-block src-block
+ verse-block)))
+ (org-fold-drawer
+ (:ellipsis . ,ellipsis)
+ (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe)
+ (:isearch-open . t)
+ (:front-sticky . t)
+ (:alias . (drawer property-drawer)))
+ ,org-link--description-folding-spec
+ ,org-link--link-folding-spec)))
+
+;;;; Searching and examining folded text
+
+(defalias 'org-fold-folded-p #'org-fold-core-folded-p)
+(defalias 'org-fold-get-folding-spec #'org-fold-core-get-folding-spec)
+(defalias 'org-fold-get-folding-specs-in-region #'org-fold-core-get-folding-specs-in-region)
+(defalias 'org-fold-get-region-at-point #'org-fold-core-get-region-at-point)
+(defalias 'org-fold-next-visibility-change #'org-fold-core-next-visibility-change)
+(defalias 'org-fold-previous-visibility-change #'org-fold-core-previous-visibility-change)
+(defalias 'org-fold-next-folding-state-change #'org-fold-core-next-folding-state-change)
+(defalias 'org-fold-previous-folding-state-change #'org-fold-core-previous-folding-state-change)
+(defalias 'org-fold-search-forward #'org-fold-core-search-forward)
+
+;;;;; Macros
+
+(defmacro org-fold-save-outline-visibility--overlays (use-markers &rest body)
+ "Save and restore outline visibility around BODY.
+If USE-MARKERS is non-nil, use markers for the positions. This
+means that the buffer may change while running BODY, but it also
+means that the buffer should stay alive during the operation,
+because otherwise all these markers will point to nowhere."
+ (declare (debug (form body)) (indent 1))
+ (org-with-gensyms (data invisible-types markers?)
+ `(let* ((,invisible-types '(org-hide-block outline))
+ (,markers? ,use-markers)
+ (,data
+ (mapcar (lambda (o)
+ (let ((beg (overlay-start o))
+ (end (overlay-end o))
+ (type (overlay-get o 'invisible)))
+ (and beg end
+ (> end beg)
+ (memq type ,invisible-types)
+ (list (if ,markers? (copy-marker beg) beg)
+ (if ,markers? (copy-marker end t) end)
+ type))))
+ (org-with-wide-buffer
+ (overlays-in (point-min) (point-max))))))
+ (unwind-protect (progn ,@body)
+ (org-with-wide-buffer
+ (dolist (type ,invisible-types)
+ (remove-overlays (point-min) (point-max) 'invisible type))
+ (pcase-dolist (`(,beg ,end ,type) (delq nil ,data))
+ (org-fold-region beg end t type)
+ (when ,markers?
+ (set-marker beg nil)
+ (set-marker end nil))))))))
+(defmacro org-fold-save-outline-visibility--text-properties (use-markers &rest body)
+ "Save and restore outline visibility around BODY.
+If USE-MARKERS is non-nil, use markers for the positions. This
+means that the buffer may change while running BODY, but it also
+means that the buffer should stay alive during the operation,
+because otherwise all these markers will point to nowhere."
+ (declare (debug (form body)) (indent 1))
+ (org-with-gensyms (data specs markers?)
+ `(let* ((,specs ',(org-fold-core-folding-spec-list))
+ (,markers? ,use-markers)
+ (,data
+ (org-with-wide-buffer
+ (let ((pos (point-min))
+ data-val)
+ (while (< pos (point-max))
+ (dolist (spec (org-fold-get-folding-spec 'all pos))
+ (let ((region (org-fold-get-region-at-point spec pos)))
+ (if ,markers?
+ (push (list (copy-marker (car region))
+ (copy-marker (cdr region) t)
+ spec)
+ data-val)
+ (push (list (car region) (cdr region) spec)
+ data-val))))
+ (setq pos (org-fold-next-folding-state-change nil pos)))))))
+ (unwind-protect (progn ,@body)
+ (org-with-wide-buffer
+ (dolist (spec ,specs)
+ (org-fold-region (point-min) (point-max) nil spec))
+ (pcase-dolist (`(,beg ,end ,spec) (delq nil ,data))
+ (org-fold-region beg end t spec)
+ (when ,markers?
+ (set-marker beg nil)
+ (set-marker end nil))))))))
+(defmacro org-fold-save-outline-visibility (use-markers &rest body)
+ "Save and restore outline visibility around BODY.
+If USE-MARKERS is non-nil, use markers for the positions. This
+means that the buffer may change while running BODY, but it also
+means that the buffer should stay alive during the operation,
+because otherwise all these markers will point to nowhere."
+ (declare (debug (form body)) (indent 1))
+ `(when (eq org-fold-core-style 'text-properties)
+ (org-fold-save-outline-visibility--text-properties ,use-markers ,@body)
+ (org-fold-save-outline-visibility--overlays ,use-markers ,@body)))
+
+;;;; Changing visibility (regions, blocks, drawers, headlines)
+
+;;;;; Region visibility
+
+;; (defalias 'org-fold-region #'org-fold-core-region)
+(defun org-fold-region--overlays (from to flag spec)
+ "Hide or show lines from FROM to TO, according to FLAG.
+SPEC is the invisibility spec, as a symbol."
+ (remove-overlays from to 'invisible spec)
+ ;; Use `front-advance' since text right before to the beginning of
+ ;; the overlay belongs to the visible line than to the contents.
+ (when flag
+ (let ((o (make-overlay from to nil 'front-advance)))
+ (overlay-put o 'evaporate t)
+ (overlay-put o 'invisible spec)
+ (overlay-put o
+ 'isearch-open-invisible
+ (lambda (&rest _) (org-fold-show-context 'isearch))))))
+(defsubst org-fold-region (from to flag &optional spec)
+ "Hide or show lines from FROM to TO, according to FLAG.
+SPEC is the invisibility spec, as a symbol."
+ (if (eq org-fold-core-style 'text-properties)
+ (org-fold-core-region from to flag spec)
+ (org-fold-region--overlays from to flag spec)))
+
+(defun org-fold-show-all--text-properties (&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 'block)
+ (`drawers 'drawer)
+ (`headings 'headline)
+ (_ (error "Invalid type: %S" type))))))
+(defun org-fold-show-all--overlays (&optional types)
+ "Show all contents in the visible part of the buffer.
+By default, the function expands headings, blocks and drawers.
+When optional argument TYPE is a list of symbols among `blocks',
+`drawers' and `headings', to only expand one specific type."
+ (interactive)
+ (let ((types (or types '(blocks drawers headings))))
+ (when (memq 'blocks types)
+ (org-fold-region (point-min) (point-max) nil 'org-hide-block))
+ (cond
+ ;; Fast path. Since headings and drawers share the same
+ ;; invisible spec, clear everything in one go.
+ ((and (memq 'headings types)
+ (memq 'drawers types))
+ (org-fold-region (point-min) (point-max) nil 'outline))
+ ((memq 'headings types)
+ (org-fold-region (point-min) (point-max) nil 'outline)
+ (org-cycle-hide-drawers 'all))
+ ((memq 'drawers types)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward org-drawer-regexp nil t)
+ (let* ((pair (get-char-property-and-overlay (line-beginning-position)
+ 'invisible))
+ (o (cdr-safe pair)))
+ (if (overlayp o) (goto-char (overlay-end o))
+ (pcase (get-char-property-and-overlay (point) 'invisible)
+ (`(outline . ,o)
+ (goto-char (overlay-end o))
+ (delete-overlay o))
+ (_ nil))))))))))
+(defsubst 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)
+ (if (eq org-fold-core-style 'text-properties)
+ (org-fold-show-all--text-properties types)
+ (org-fold-show-all--overlays types)))
+
+(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) 'outline)))
+
+;;;;; 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 'outline)
+ (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))
+ (unless (eobp) ; Current headline is empty and ends at the end of buffer.
+ (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
+ 'outline))))
+
+(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
+ 'outline)))
+
+;; Replaces `outline-hide-subtree'.
+(defun org-fold-hide-subtree ()
+ "Hide everything after this heading at deeper levels."
+ (interactive)
+ (org-fold-subtree t))
+
+;; Replaces `outline-hide-sublevels'
+(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 'headline)
+ ;; Then unhide the top level headers.
+ (org-map-region
+ (lambda ()
+ (when (<= (funcall outline-level) levels)
+ (org-fold-heading nil)))
+ 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
+ 'outline)
+ (org-cycle-hide-drawers 'children)))
+
+(defalias 'org-fold-show-hidden-entry #'org-fold-show-entry
+ "Show an entry where even the heading is hidden.")
+
+(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 'outline))
+
+(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--text-properties ()
+ "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)))
+(defun org-fold-show-branches-buffer--overlays ()
+ "Show all branches in the buffer."
+ (org-fold-flag-above-first-heading)
+ (outline-hide-sublevels 1)
+ (unless (eobp)
+ (outline-show-branches)
+ (while (outline-get-next-sibling)
+ (outline-show-branches)))
+ (goto-char (point-min)))
+(defsubst org-fold-show-branches-buffer ()
+ "Show all branches in the buffer."
+ (if (eq org-fold-core-style 'text-properties)
+ (org-fold-show-branches-buffer--text-properties)
+ (org-fold-show-branches-buffer--overlays)))
+
+;;;;; 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 (if (eq org-fold-core-style 'text-properties)
+ category
+ (if (eq category 'block) 'org-hide-block 'outline)))
+ (flag
+ (cond ((eq force 'off) nil)
+ (force t)
+ ((if (eq org-fold-core-style 'text-properties)
+ (org-fold-folded-p start spec)
+ (eq spec (get-char-property start 'invisible)))
+ 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 (format "%s@%s: %s"
+ (buffer-file-name (buffer-base-buffer))
+ (point)
+ (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-block-map (apply-partially #'org-fold-hide-block-toggle 'hide)))
+
+(defun org-fold-hide-drawer-all ()
+ "Fold all drawers in the current buffer."
+ (let ((begin (point-min))
+ (end (point-max)))
+ (org-fold--hide-drawers begin end)))
+
+(defun org-fold--hide-drawers--overlays (begin end)
+ "Hide all drawers between BEGIN and END."
+ (save-excursion
+ (goto-char begin)
+ (while (re-search-forward org-drawer-regexp end t)
+ (let* ((pair (get-char-property-and-overlay (line-beginning-position)
+ 'invisible))
+ (o (cdr-safe pair)))
+ (if (overlayp o) (goto-char (overlay-end o)) ;invisible drawer
+ (pcase (get-char-property-and-overlay (point) 'invisible)
+ (`(outline . ,o) (goto-char (overlay-end o))) ;already folded
+ (_
+ (let* ((drawer (org-element-at-point))
+ (type (org-element-type drawer)))
+ (when (memq type '(drawer property-drawer))
+ (org-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)))))))))))
+(defun org-fold--hide-drawers--text-properties (begin end)
+ "Hide all drawers between BEGIN and END."
+ (save-excursion
+ (goto-char begin)
+ (while (and (< (point) end)
+ (re-search-forward org-drawer-regexp end t))
+ ;; Skip folded drawers
+ (if (org-fold-folded-p nil 'drawer)
+ (goto-char (org-fold-next-folding-state-change 'drawer nil end))
+ (let* ((drawer (org-element-at-point))
+ (type (org-element-type drawer)))
+ (when (memq type '(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))))))))
+(defun org-fold--hide-drawers (begin end)
+ "Hide all drawers between BEGIN and END."
+ (if (eq org-fold-core-style 'text-properties)
+ (org-fold--hide-drawers--text-properties begin end)
+ (org-fold--hide-drawers--overlays begin end)))
+
+(defun org-fold-hide-archived-subtrees (beg end)
+ "Re-hide all archived subtrees after a visibility state change."
+ (org-with-wide-buffer
+ (let ((case-fold-search nil)
+ (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":")))
+ (goto-char beg)
+ ;; Include headline point is currently on.
+ (beginning-of-line)
+ (while (and (< (point) end) (re-search-forward re end t))
+ (when (member org-archive-tag (org-get-tags nil t))
+ (org-fold-subtree t)
+ (org-end-of-subtree t))))))
+
+;;;;; 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--overlays (detail)
+ "Set visibility around point according to DETAIL.
+DETAIL is either nil, `minimal', `local', `ancestors',
+`ancestors-full', `lineage', `tree', `canonical' or t. See
+`org-show-context-detail' for more information."
+ ;; Show current heading and possibly its entry, following headline
+ ;; or all children.
+ (if (and (org-at-heading-p) (not (eq detail 'local)))
+ (org-fold-heading nil)
+ (org-fold-show-entry)
+ ;; If point is hidden within a drawer or a block, make sure to
+ ;; expose it.
+ (dolist (o (overlays-at (point)))
+ (when (memq (overlay-get o 'invisible) '(org-hide-block outline))
+ (delete-overlay o)))
+ (unless (org-before-first-heading-p)
+ (org-with-limited-levels
+ (cl-case detail
+ ((tree canonical t) (org-fold-show-children))
+ ((nil minimal ancestors ancestors-full))
+ (t (save-excursion
+ (outline-next-heading)
+ (org-fold-heading nil)))))))
+ ;; Show whole subtree.
+ (when (eq detail 'ancestors-full) (org-fold-show-subtree))
+ ;; Show all siblings.
+ (when (eq detail 'lineage) (org-fold-show-siblings))
+ ;; Show ancestors, possibly with their children.
+ (when (memq detail '(ancestors ancestors-full 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))))))
+(defvar org-hide-emphasis-markers); Defined in org.el
+(defvar org-pretty-entities); Defined in org.el
+(defun org-fold-show-set-visibility--text-properties (detail)
+ "Set visibility around point according to DETAIL.
+DETAIL is either nil, `minimal', `local', `ancestors',
+`ancestors-full', `lineage', `tree', `canonical' or t. See
+`org-show-context-detail' for more information."
+ ;; Show current heading and possibly its entry, following headline
+ ;; or all children.
+ (if (and (org-at-heading-p) (not (eq detail 'local)))
+ (org-fold-heading nil)
+ (org-fold-show-entry)
+ ;; If point is hidden make sure to expose it.
+ (when (org-invisible-p)
+ ;; FIXME: No clue why, but otherwise the following might not work.
+ (redisplay)
+ (let ((region (org-fold-get-region-at-point)))
+ ;; Reveal emphasis markers.
+ (let (org-hide-emphasis-markers
+ org-link-descriptive
+ org-pretty-entities
+ (region (or (org-find-text-property-region (point) 'org-emphasis)
+ (org-find-text-property-region (point) 'invisible)
+ region)))
+ (when region
+ (org-with-point-at (car region)
+ (beginning-of-line)
+ (let (font-lock-extend-region-functions)
+ (font-lock-fontify-region (1- (car region)) (cdr region))))))
+ (when region
+ (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 ancestors-full))
+ (t (save-excursion
+ (outline-next-heading)
+ (org-fold-heading nil)))))))
+ ;; Show whole subtree.
+ (when (eq detail 'ancestors-full) (org-fold-show-subtree))
+ ;; Show all siblings.
+ (when (eq detail 'lineage) (org-fold-show-siblings))
+ ;; Show ancestors, possibly with their children.
+ (when (memq detail '(ancestors ancestors-full 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-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."
+ (if (eq org-fold-core-style 'text-properties)
+ (org-fold-show-set-visibility--text-properties detail)
+ (org-fold-show-set-visibility--overlays detail)))
+
+(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))))
+
+;;; Make isearch search in some text hidden via text propertoes
+
+(defun org-fold--isearch-reveal (&rest _)
+ "Reveal text at POS found by isearch."
+ (org-fold-show-set-visibility 'isearch))
+
+;;; Handling changes in folded elements
+
+(defun org-fold--extend-changed-region (from to)
+ "Consider folded regions in the next/previous line when fixing
+region visibility.
+This function is intended to be used as a member of
+`org-fold-core-extend-changed-region-functions'."
+ ;; 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)))
+ (cons from to))
+
+(defun org-fold--reveal-outline-maybe (region _)
+ "Reveal folded outline in REGION when needed.
+
+This function is intended to be used as :fragile property of
+`org-fold-outline' spec. See `org-fold-core--specs' for details."
+ (save-match-data
+ (save-excursion
+ (goto-char (car region))
+ ;; The line before beginning of the fold should be either a
+ ;; headline or a list item.
+ (backward-char)
+ (beginning-of-line)
+ ;; Make sure that headline is not partially hidden
+ (unless (org-fold-folded-p nil 'headline) (org-fold-region (max (point-min) (1- (point))) (line-end-position) nil 'headline))
+ ;; Check the validity of headline
+ (unless (let ((case-fold-search t))
+ (looking-at (rx-to-string `(or (regex ,(org-item-re))
+ (regex ,org-outline-regexp-bol))))) ; the match-data will be used later
+ t))))
+
+(defun org-fold--reveal-drawer-or-block-maybe (region spec)
+ "Reveal folded drawer/block (according to SPEC) in REGION when needed.
+
+This function is intended to be used as :fragile property of
+`org-fold-drawer' or `org-fold-block' spec."
+ (let ((begin-re (cond
+ ((eq spec (org-fold-core-get-folding-spec-from-alias 'drawer))
+ org-drawer-regexp)
+ ;; Group one below contains the type of the block.
+ ((eq spec (org-fold-core-get-folding-spec-from-alias '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)
+ (save-match-data ; we should not clobber match-data in after-change-functions
+ (let ((fold-begin (car region))
+ (fold-end (cdr region)))
+ (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-core-get-folding-spec-from-alias 'drawer))
+ org-property-end-re)
+ ((eq spec (org-fold-core-get-folding-spec-from-alias '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-to-string `(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)))))
+ unfold?)))))
+
+;; Catching user edits inside invisible text
+(defun org-fold-check-before-invisible-edit--overlays (kind)
+ "Check if editing KIND is 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 (get-char-property (point) 'invisible)
+ (get-char-property (max (point-min) (1- (point))) 'invisible)))
+ ;; OK, we need to take a closer look. Do not consider
+ ;; invisibility obtained through text properties (e.g., link
+ ;; fontification), as it cannot be toggled.
+ (let* ((invisible-at-point
+ (pcase (get-char-property-and-overlay (point) 'invisible)
+ (`(,_ . ,(and (pred overlayp) o)) o)))
+ ;; Assume that point cannot land in the middle of an
+ ;; overlay, or between two overlays.
+ (invisible-before-point
+ (and (not invisible-at-point)
+ (not (bobp))
+ (pcase (get-char-property-and-overlay (1- (point)) 'invisible)
+ (`(,_ . ,(and (pred overlayp) o)) o))))
+ (border-and-ok-direction
+ (or
+ ;; Check if we are acting predictably before invisible
+ ;; text.
+ (and invisible-at-point
+ (memq kind '(insert delete-backward)))
+ ;; Check if we are acting predictably after invisible text
+ ;; This works not well, and I have turned it off. It seems
+ ;; better to always show and stop after invisible text.
+ ;; (and (not invisible-at-point) invisible-before-point
+ ;; (memq kind '(insert delete)))
+ )))
+ (when (or invisible-at-point invisible-before-point)
+ (when (eq org-fold-catch-invisible-edits 'error)
+ (user-error "Editing in invisible areas is prohibited, make them visible first"))
+ (if (and org-custom-properties-overlays
+ (y-or-n-p "Display invisible properties in this buffer? "))
+ (org-toggle-custom-properties-visibility)
+ ;; Make the area visible
+ (save-excursion
+ (when invisible-before-point
+ (goto-char
+ (previous-single-char-property-change (point) 'invisible)))
+ ;; Remove whatever overlay is currently making yet-to-be
+ ;; edited text invisible. Also remove nested invisibility
+ ;; related overlays.
+ (delete-overlay (or invisible-at-point invisible-before-point))
+ (let ((origin (if invisible-at-point (point) (1- (point)))))
+ (while (pcase (get-char-property-and-overlay origin 'invisible)
+ (`(,_ . ,(and (pred overlayp) o))
+ (delete-overlay o)
+ t)))))
+ (cond
+ ((eq org-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"))))))))
+(defun org-fold-check-before-invisible-edit--text-properties (kind)
+ "Check if editing KIND is 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.
+ (let* ((invisible-at-point (org-invisible-p))
+ (invisible-before-point
+ (and (not (bobp))
+ (org-invisible-p (1- (point)))))
+ (border-and-ok-direction
+ (or
+ ;; Check if we are acting predictably before invisible
+ ;; text.
+ (and invisible-at-point (not invisible-before-point)
+ (memq kind '(insert delete-backward)))
+ (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-set-visibility 'local))
+ (when invisible-before-point
+ (org-with-point-at (1- (point)) (org-fold-show-set-visibility 'local)))
+ (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"))))))))
+(defsubst org-fold-check-before-invisible-edit (kind)
+ "Check if editing KIND is 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
+ (if (eq org-fold-core-style 'text-properties)
+ (org-fold-check-before-invisible-edit--text-properties kind)
+ (org-fold-check-before-invisible-edit--overlays kind)))
+
+(provide 'org-fold)
+
+;;; org-fold.el ends here
--
2.35.1
--
Ihor Radchenko,
PhD,
Center for Advancing Materials Performance from the Nanoscale (CAMP-nano)
State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China
Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg
^ permalink raw reply related [relevance 13%]
* [PATCH v2 09/38] Rename old function call to use org-fold---
2022-04-20 13:24 13% ` [PATCH v2 02/38] Separate folding functions from org.el into new library: org-fold Ihor Radchenko
@ 2022-04-20 13:25 12% ` Ihor Radchenko
2022-04-20 13:26 12% ` [PATCH v2 17/38] org-compat: Work around some third-party packages using outline-* functions Ihor Radchenko
2 siblings, 0 replies; 25+ results
From: Ihor Radchenko @ 2022-04-20 13:25 UTC (permalink / raw)
To: emacs-orgmode
---
lisp/ob-core.el | 14 ++--
lisp/ob-lilypond.el | 4 +-
lisp/ob-ref.el | 4 +-
lisp/ol.el | 13 ++--
lisp/org-agenda.el | 43 +++++------
lisp/org-archive.el | 12 +--
lisp/org-capture.el | 2 +-
lisp/org-clock.el | 10 +--
lisp/org-colview.el | 6 +-
lisp/org-compat.el | 29 ++++----
lisp/org-crypt.el | 8 +-
lisp/org-element.el | 1 +
lisp/org-feed.el | 4 +-
| 6 +-
lisp/org-goto.el | 6 +-
lisp/org-id.el | 4 +-
lisp/org-keys.el | 26 +++----
lisp/org-lint.el | 3 +-
lisp/org-list.el | 10 ++-
lisp/org-macs.el | 40 ++--------
lisp/org-mobile.el | 2 +-
lisp/org-mouse.el | 4 +-
lisp/org-refile.el | 2 +-
lisp/org-src.el | 6 +-
lisp/org-timer.el | 2 +-
lisp/org.el | 135 +++++++++++++++++++---------------
lisp/ox-org.el | 2 +-
testing/lisp/test-org-list.el | 2 +-
testing/lisp/test-org.el | 78 ++++++++++----------
29 files changed, 241 insertions(+), 237 deletions(-)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 239a57f96..6590eeee7 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -26,7 +26,9 @@ ;;; Code:
(require 'cl-lib)
(require 'ob-eval)
(require 'org-macs)
+(require 'org-fold)
(require 'org-compat)
+(require 'org-cycle)
(defconst org-babel-exeext
(if (memq system-type '(windows-nt cygwin))
@@ -50,7 +52,7 @@ (declare-function org-babel-ref-resolve "ob-ref" (ref))
(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info))
(declare-function org-current-level "org" ())
-(declare-function org-cycle "org" (&optional arg))
+(declare-function org-cycle "org-cycle" (&optional arg))
(declare-function org-edit-src-code "org-src" (&optional code edit-buffer-name))
(declare-function org-edit-src-exit "org-src" ())
(declare-function org-element-at-point "org-element" (&optional pom cached-only))
@@ -75,7 +77,7 @@ (declare-function org-narrow-to-subtree "org" (&optional element))
(declare-function org-next-block "org" (arg &optional backward block-regexp))
(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer))
(declare-function org-previous-block "org" (arg &optional block-regexp))
-(declare-function org-show-context "org" (&optional key))
+(declare-function org-fold-show-context "org-fold" (&optional key))
(declare-function org-src-coderef-format "org-src" (&optional element))
(declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
(declare-function org-src-get-lang-mode "org-src" (lang))
@@ -945,7 +947,7 @@ (defun org-babel-enter-header-arg-w-completion (&optional lang)
(insert (concat header " " (or arg "")))
(cons header arg)))
-(add-hook 'org-tab-first-hook 'org-babel-header-arg-expand)
+(add-hook 'org-cycle-tab-first-hook 'org-babel-header-arg-expand)
;;;###autoload
(defun org-babel-load-in-session (&optional _arg info)
@@ -1469,7 +1471,7 @@ (defun org-babel-hide-result-toggle (&optional force)
(push ov org-babel-hide-result-overlays)))))
;; org-tab-after-check-for-cycling-hook
-(add-hook 'org-tab-first-hook #'org-babel-hide-result-toggle-maybe)
+(add-hook 'org-cycle-tab-first-hook #'org-babel-hide-result-toggle-maybe)
;; Remove overlays when changing major mode
(add-hook 'org-mode-hook
(lambda () (add-hook 'change-major-mode-hook
@@ -1817,7 +1819,7 @@ (defun org-babel-goto-named-src-block (name)
(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)
@@ -1857,7 +1859,7 @@ (defun org-babel-goto-named-result (name)
(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-lilypond.el b/lisp/ob-lilypond.el
index 15538b503..df128441a 100644
--- a/lisp/ob-lilypond.el
+++ b/lisp/ob-lilypond.el
@@ -34,7 +34,7 @@ ;;; Commentary:
;;; Code:
(require 'ob)
-(declare-function org-show-all "org" (&optional types))
+(declare-function org-fold-show-all "org-fold" (&optional types))
(defalias 'lilypond-mode 'LilyPond-mode)
@@ -279,7 +279,7 @@ (defun org-babel-lilypond-mark-error-line (file-name line)
(setq case-fold-search nil)
(if (search-forward line nil t)
(progn
- (org-show-all)
+ (org-fold-show-all)
(set-mark (point))
(goto-char (- (point) (length line))))
(goto-char temp))))
diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el
index db8ced6b6..1a77e39b1 100644
--- a/lisp/ob-ref.el
+++ b/lisp/ob-ref.el
@@ -62,8 +62,8 @@ (declare-function org-find-property "org" (property &optional value))
(declare-function org-id-find-id-file "org-id" (id))
(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp))
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
-(declare-function org-show-context "org" (&optional key))
(declare-function org-narrow-to-subtree "org" (&optional element))
+(declare-function org-fold-show-context "org-fold" (&optional key))
(defvar org-babel-update-intermediate nil
"Update the in-buffer results of code blocks executed to resolve references.")
@@ -104,7 +104,7 @@ (defun org-babel-ref-goto-headline-id (id)
(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 1b2bb9a9a..4cc813d5b 100644
--- a/lisp/ol.el
+++ b/lisp/ol.el
@@ -29,6 +29,7 @@ ;;; Code:
(require 'org-compat)
(require 'org-macs)
+(require 'org-fold)
(defvar clean-buffer-list-kill-buffer-names)
(defvar org-agenda-buffer-name)
@@ -66,10 +67,10 @@ (declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function org-mode "org" ())
(declare-function org-occur "org" (regexp &optional keep-previous callback))
(declare-function org-open-file "org" (path &optional in-emacs line search))
-(declare-function org-overview "org" ())
+(declare-function org-cycle-overview "org-cycle" ())
(declare-function org-restart-font-lock "org" ())
(declare-function org-run-like-in-org-mode "org" (cmd))
-(declare-function org-show-context "org" (&optional key))
+(declare-function org-fold-show-context "org-fold" (&optional key))
(declare-function org-src-coderef-format "org-src" (&optional element))
(declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
(declare-function org-src-edit-buffer-p "org-src" (&optional buffer))
@@ -700,7 +701,7 @@ (defun org-link--buffer-for-internals ()
(make-indirect-buffer (current-buffer)
indirect-buffer-name
'clone))))
- (with-current-buffer indirect-buffer (org-overview))
+ (with-current-buffer indirect-buffer (org-cycle-overview))
indirect-buffer))))
(defun org-link--search-radio-target (target)
@@ -718,7 +719,7 @@ (defun org-link--search-radio-target (target)
(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))))
@@ -1257,7 +1258,7 @@ (defun org-link-search (s &optional avoid-pos stealth)
(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)
@@ -1430,7 +1431,7 @@ (defun org-next-link (&optional search-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 862243f28..fa60f4f19 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -47,6 +47,7 @@ ;;; Code:
(require 'cl-lib)
(require 'ol)
+(require 'org-fold-core)
(require 'org)
(require 'org-macs)
(require 'org-refile)
@@ -9393,7 +9394,7 @@ (defun org-agenda-goto (&optional highlight)
(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))
@@ -9682,7 +9683,7 @@ (defun org-agenda-switch-to (&optional delete-other-windows)
(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)
@@ -9698,7 +9699,7 @@ (defun org-agenda-show (&optional full-entry)
(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)
@@ -9717,12 +9718,12 @@ (defun org-agenda-show-and-scroll-up (&optional arg)
(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)))
@@ -9753,7 +9754,7 @@ (defun org-agenda-show-1 (&optional more)
(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))
@@ -9761,20 +9762,20 @@ (defun org-agenda-show-1 (&optional more)
((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)))
@@ -9906,7 +9907,7 @@ (defun org-agenda-todo (&optional arg)
(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)
;; Make sure that log is recorded in current undo.
@@ -9947,7 +9948,7 @@ (defun org-agenda-add-note (&optional _arg)
(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
@@ -10096,7 +10097,7 @@ (defun org-agenda-priority (&optional force-direction)
(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)))
@@ -10120,7 +10121,7 @@ (defun org-agenda-set-tags (&optional tag onoff)
(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))
@@ -10145,7 +10146,7 @@ (defun org-agenda-set-property ()
(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 ()
@@ -10164,7 +10165,7 @@ (defun org-agenda-set-effort ()
(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)))
@@ -10186,7 +10187,7 @@ (defun org-agenda-toggle-archive-tag ()
(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)))
@@ -10396,7 +10397,7 @@ (defun org-agenda-clock-in (&optional arg)
(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))
@@ -10485,7 +10486,7 @@ (defun org-agenda-diary-entry-in-org-file ()
(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
@@ -10587,7 +10588,7 @@ (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2)
(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)
@@ -10625,7 +10626,7 @@ (defun org-agenda-insert-diary-make-new-entry (text)
(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 6ea16f8c1..1026a295e 100644
--- a/lisp/org-archive.el
+++ b/lisp/org-archive.el
@@ -324,7 +324,7 @@ (defun org-archive-subtree (&optional find-done)
(org-todo-regexp tr-org-todo-regexp)
(org-todo-line-regexp tr-org-todo-line-regexp))
(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
@@ -339,7 +339,7 @@ (defun org-archive-subtree (&optional find-done)
(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)
@@ -417,7 +417,7 @@ (defun org-archive-subtree (&optional find-done)
(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))))
@@ -487,13 +487,13 @@ (defun org-archive-to-archive-sibling ()
(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))))
@@ -602,7 +602,7 @@ (defun org-toggle-archive-tag (&optional find-done)
(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 bbb37eb27..1324ffab4 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -1129,7 +1129,7 @@ (defun org-capture-place-template (&optional inhibit-wconf-store)
(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 6f441c18e..583b30237 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -1035,7 +1035,7 @@ (defun org-clock-jump-to-current-clock (&optional effective-clock)
(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)
@@ -1843,10 +1843,10 @@ (defun org-clock-goto (&optional select)
(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)))
@@ -2140,7 +2140,7 @@ (defun org-clock-report (&optional arg)
(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
@@ -3125,7 +3125,7 @@ (defun org-clock-load ()
(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)))))
(defun org-clock-kill-emacs-query ()
diff --git a/lisp/org-colview.el b/lisp/org-colview.el
index 15cab35f0..c8443c135 100644
--- a/lisp/org-colview.el
+++ b/lisp/org-colview.el
@@ -159,8 +159,8 @@ (defconst org-columns-summary-types-default
(defun org-columns-content ()
"Switch to contents view while in columns view."
(interactive)
- (org-overview)
- (org-content))
+ (org-cycle-overview)
+ (org-cycle-content))
(org-defkey org-columns-map "c" #'org-columns-content)
(org-defkey org-columns-map "o" #'org-overview)
@@ -701,7 +701,7 @@ (defun org-columns--call (fun)
(move-beginning-of-line 2)
(org-at-heading-p)))))
(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 b35e66b84..ed2ae62f4 100644
--- a/lisp/org-compat.el
+++ b/lisp/org-compat.el
@@ -50,18 +50,20 @@ (declare-function org-element-property "org-element" (property element))
(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))
(declare-function table--at-cell-p "table" (position &optional object at-column))
+(declare-function org-fold-region "org-fold" (from to flag &optional spec))
+(declare-function org-fold-show-all "org-fold" (&optional types))
(defvar calendar-mode-map)
(defvar org-complex-heading-regexp)
@@ -72,6 +74,7 @@ (defvar org-table-any-border-regexp)
(defvar org-table-dataline-regexp)
(defvar org-table-tab-recognizes-table.el)
(defvar org-table1-hline-regexp)
+(defvar org-fold-core-style)
\f
;;; Emacs < 29 compatibility
@@ -656,7 +659,7 @@ (make-obsolete 'org-capture-import-remember-templates
(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."
@@ -699,7 +702,7 @@ (defun org-flag-drawer (flag &optional element beg end)
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." "9.4"))
- (if (and beg end) (org-flag-region beg end flag 'outline)
+ (if (and beg end) (org-fold-region beg end flag (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))
(let ((drawer
(or element
(and (save-excursion
@@ -708,12 +711,12 @@ (defun org-flag-drawer (flag &optional element beg end)
(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 (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))
;; 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)))
@@ -725,7 +728,7 @@ (defun org-hide-block-toggle-maybe ()
an error. Return a non-nil value when toggling is successful."
(declare (obsolete "use `org-hide-block-toggle' instead." "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."
@@ -741,7 +744,7 @@ (defun org-hide-block-toggle-all ()
(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.
@@ -973,7 +976,7 @@ (eval-after-load 'imenu
(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)))))
@@ -1038,7 +1041,7 @@ (eval-after-load 'speedbar
(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
@@ -1152,7 +1155,7 @@ (defun org-bookmark-jump-unhide (&rest _)
(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.
(add-hook 'bookmark-after-jump-hook #'org-bookmark-jump-unhide)
@@ -1217,7 +1220,7 @@ (advice-add 'ecb-method-clicked :after #'org--ecb-show-context)
(defun org--ecb-show-context (&rest _)
"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
@@ -1225,7 +1228,7 @@ (defun org-mark-jump-unhide (&rest _)
"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)))
(advice-add 'pop-to-mark-command :after #'org-mark-jump-unhide)
diff --git a/lisp/org-crypt.el b/lisp/org-crypt.el
index 41813cb18..b2542ab43 100644
--- a/lisp/org-crypt.el
+++ b/lisp/org-crypt.el
@@ -73,7 +73,7 @@ (declare-function org-before-first-heading-p "org" ())
(declare-function org-end-of-meta-data "org" (&optional full))
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
-(declare-function org-flag-subtree "org" (flag))
+(declare-function org-fold-subtree "org-fold" (flag))
(declare-function org-make-tags-matcher "org" (match))
(declare-function org-previous-visible-heading "org" (arg))
(declare-function org-scan-tags "org" (action matcher todo-only &optional start-level))
@@ -243,7 +243,7 @@ (defun org-encrypt-entry ()
(error (error-message-string err)))))
(when folded-heading
(goto-char folded-heading)
- (org-flag-subtree t))
+ (org-fold-subtree t))
nil)))))
;;;###autoload
@@ -280,7 +280,7 @@ (defun org-decrypt-entry ()
'org-crypt-text encrypted-text))
(when folded-heading
(goto-char folded-heading)
- (org-flag-subtree t))
+ (org-fold-subtree t))
nil)))
(_ nil)))
@@ -313,7 +313,7 @@ (defun org-crypt-use-before-save-magic ()
'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-element.el b/lisp/org-element.el
index 28339c1b8..f627dd4ea 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -70,6 +70,7 @@ (require 'org-footnote)
(require 'org-list)
(require 'org-macs)
(require 'org-table)
+(require 'org-fold-core)
(declare-function org-at-heading-p "org" (&optional _))
(declare-function org-escape-code-in-string "org-src" (s))
diff --git a/lisp/org-feed.el b/lisp/org-feed.el
index a5fea0888..d634f9c41 100644
--- a/lisp/org-feed.el
+++ b/lisp/org-feed.el
@@ -412,8 +412,8 @@ (defun org-feed-update (feed &optional retrieve-only)
;; 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))
--git a/lisp/org-footnote.el b/lisp/org-footnote.el
index b55f6d98e..a4c9ae770 100644
--- a/lisp/org-footnote.el
+++ b/lisp/org-footnote.el
@@ -52,7 +52,7 @@ (declare-function org-in-verbatim-emphasis "org" ())
(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)
@@ -555,7 +555,7 @@ (defun org-footnote-goto-definition (label &optional location)
(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 \
@@ -581,7 +581,7 @@ (defun org-footnote-goto-previous-reference (label)
(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)))
\f
;;;; Getters
diff --git a/lisp/org-goto.el b/lisp/org-goto.el
index 860b0a3de..cd5000037 100644
--- a/lisp/org-goto.el
+++ b/lisp/org-goto.el
@@ -222,13 +222,13 @@ (defun org-goto-location (&optional _buf help)
" 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)
+ (org-cycle-overview)
(setq buffer-read-only t)
(if (and (boundp 'org-goto-start-pos)
(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")
@@ -279,7 +279,7 @@ (defun org-goto (&optional alternative-interface)
(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 a8f8eb4eb..0331b7c1d 100644
--- a/lisp/org-id.el
+++ b/lisp/org-id.el
@@ -333,7 +333,7 @@ (defun org-id-goto (id)
(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)
@@ -745,7 +745,7 @@ (defun org-id-open (id _)
(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-keys.el b/lisp/org-keys.el
index b8e9ddd93..782ffa871 100644
--- a/lisp/org-keys.el
+++ b/lisp/org-keys.el
@@ -67,8 +67,8 @@ (declare-function org-ctrl-c-star "org" ())
(declare-function org-ctrl-c-tab "org" (&optional arg))
(declare-function org-cut-special "org" ())
(declare-function org-cut-subtree "org" (&optional n))
-(declare-function org-cycle "org" (&optional arg))
-(declare-function org-cycle-agenda-files "org" ())
+(declare-function org-cycle "org-cycle" (&optional arg))
+(declare-function org-cycle-agenda-files "org-cycle" ())
(declare-function org-date-from-calendar "org" ())
(declare-function org-dynamic-block-insert-dblock "org" (&optional arg))
(declare-function org-dblock-update "org" (&optional arg))
@@ -94,7 +94,7 @@ (declare-function org-feed-update-all "org" ())
(declare-function org-fill-paragraph "org" (&optional justify region))
(declare-function org-find-file-at-mouse "org" (ev))
(declare-function org-footnote-action "org" (&optional special))
-(declare-function org-force-cycle-archived "org" ())
+(declare-function org-cycle-force-archived "org-cycle" ())
(declare-function org-force-self-insert "org" (n))
(declare-function org-forward-element "org" ())
(declare-function org-forward-heading-same-level "org" (arg &optional invisible-ok))
@@ -143,8 +143,8 @@ (declare-function org-previous-visible-heading "org" (arg))
(declare-function org-priority "org" (&optional action show))
(declare-function org-promote-subtree "org" ())
(declare-function org-redisplay-inline-images "org" ())
-(declare-function org-refile "org" (&optional arg1 default-buffer rfloc msg))
-(declare-function org-refile-copy "org" ())
+(declare-function org-refile "org-refile" (&optional arg1 default-buffer rfloc msg))
+(declare-function org-refile-copy "org-refile" ())
(declare-function org-refile-reverse "org-refile" (&optional arg default-buffer rfloc msg))
(declare-function org-reftex-citation "org" ())
(declare-function org-reload "org" (&optional arg1))
@@ -152,7 +152,7 @@ (declare-function org-remove-file "org" (&optional file))
(declare-function org-resolve-clocks "org" (&optional only-dangling-p prompt-fn last-valid))
(declare-function org-return "org" (&optional indent))
(declare-function org-return-and-maybe-indent "org" ())
-(declare-function org-reveal "org" (&optional siblings))
+(declare-function org-fold-reveal "org-fold" (&optional siblings))
(declare-function org-schedule "org" (arg &optional time))
(declare-function org-self-insert-command "org" (N))
(declare-function org-set-effort "org" (&optional increment value))
@@ -172,9 +172,9 @@ (declare-function org-shiftmetaup "org" (&optional arg))
(declare-function org-shiftright "org" (&optional arg))
(declare-function org-shifttab "org" (&optional arg))
(declare-function org-shiftup "org" (&optional arg))
-(declare-function org-show-all "org" (&optional types))
-(declare-function org-show-children "org" (&optional level))
-(declare-function org-show-subtree "org" ())
+(declare-function org-fold-show-all "org-fold" (&optional types))
+(declare-function org-fold-show-children "org-fold" (&optional level))
+(declare-function org-fold-show-subtree "org-fold" ())
(declare-function org-sort "org" (&optional with-case))
(declare-function org-sparse-tree "org" (&optional arg type))
(declare-function org-table-copy-down "org" (n))
@@ -423,7 +423,7 @@ (define-key org-mode-map [menu-bar hide] 'undefined)
(define-key org-mode-map [menu-bar show] 'undefined)
(define-key org-mode-map [remap outline-mark-subtree] #'org-mark-subtree)
-(define-key org-mode-map [remap outline-show-subtree] #'org-show-subtree)
+(define-key org-mode-map [remap outline-show-subtree] #'org-fold-show-subtree)
(define-key org-mode-map [remap outline-forward-same-level]
#'org-forward-heading-same-level)
(define-key org-mode-map [remap outline-backward-same-level]
@@ -437,14 +437,14 @@ (define-key org-mode-map [remap outline-next-visible-heading]
#'org-next-visible-heading)
(define-key org-mode-map [remap outline-previous-visible-heading]
#'org-previous-visible-heading)
-(define-key org-mode-map [remap show-children] #'org-show-children)
+(define-key org-mode-map [remap outline-show-children] #'org-fold-show-children)
;;;; Make `C-c C-x' a prefix key
(org-defkey org-mode-map (kbd "C-c C-x") (make-sparse-keymap))
;;;; TAB key with modifiers
(org-defkey org-mode-map (kbd "TAB") #'org-cycle)
-(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-force-cycle-archived)
+(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-cycle-force-archived)
;; Override text-mode binding to expose `complete-symbol' for
;; pcomplete functionality.
(org-defkey org-mode-map (kbd "M-TAB") nil)
@@ -544,7 +544,7 @@ (org-remap org-mode-map
;;;; All the other keys
(org-defkey org-mode-map (kbd "|") #'org-force-self-insert)
-(org-defkey org-mode-map (kbd "C-c C-r") #'org-reveal)
+(org-defkey org-mode-map (kbd "C-c C-r") #'org-fold-reveal)
(org-defkey org-mode-map (kbd "C-M-t") #'org-transpose-element)
(org-defkey org-mode-map (kbd "M-}") #'org-forward-element)
(org-defkey org-mode-map (kbd "ESC }") #'org-forward-element)
diff --git a/lisp/org-lint.el b/lisp/org-lint.el
index b21412be1..cce6fddbd 100644
--- a/lisp/org-lint.el
+++ b/lisp/org-lint.el
@@ -91,6 +91,7 @@ (require 'oc)
(require 'ol)
(require 'org-attach)
(require 'org-macro)
+(require 'org-fold)
(require 'ox)
(require 'seq)
@@ -264,7 +265,7 @@ (defun org-lint--jump-to-source ()
(let ((l (org-lint--current-line)))
(switch-to-buffer-other-window org-lint--source-buffer)
(org-goto-line l)
- (org-show-set-visibility 'local)
+ (org-fold-show-set-visibility 'local)
(recenter)))
(defun org-lint--show-source ()
diff --git a/lisp/org-list.el b/lisp/org-list.el
index f1ab2ca76..05a73a609 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -79,6 +79,7 @@ ;;; Code:
(require 'cl-lib)
(require 'org-macs)
(require 'org-compat)
+(require 'org-fold-core)
(defvar org-M-RET-may-split-line)
(defvar org-adapt-indentation)
@@ -138,7 +139,8 @@ (declare-function org-outline-level "org" ())
(declare-function org-previous-line-empty-p "org" ())
(declare-function org-reduced-level "org" (L))
(declare-function org-set-tags "org" (tags))
-(declare-function org-show-subtree "org" ())
+(declare-function org-fold-show-subtree "org-fold" ())
+(declare-function org-fold-region "org-fold" (from to flag &optional spec))
(declare-function org-sort-remove-invisible "org" (S))
(declare-function org-time-string-to-seconds "org" (s))
(declare-function org-timer-hms-to-secs "org-timer" (hms))
@@ -2029,7 +2031,7 @@ (defun org-list-set-item-visibility (item struct view)
((eq view 'folded)
(let ((item-end (org-list-get-item-end-before-blank item struct)))
;; Hide from eol
- (org-flag-region (save-excursion (goto-char item) (line-end-position))
+ (org-fold-region (save-excursion (goto-char item) (line-end-position))
item-end t 'outline)))
((eq view 'children)
;; First show everything.
@@ -2042,7 +2044,7 @@ (defun org-list-set-item-visibility (item struct view)
((eq view 'subtree)
;; Show everything
(let ((item-end (org-list-get-item-end item struct)))
- (org-flag-region item item-end nil 'outline)))))
+ (org-fold-region item item-end nil 'outline)))))
(defun org-list-item-body-column (item)
"Return column at which body of ITEM should start."
@@ -2455,7 +2457,7 @@ (defun org-reset-checkbox-state-subtree ()
(save-restriction
(save-excursion
(org-narrow-to-subtree)
- (org-show-subtree)
+ (org-fold-show-subtree)
(goto-char (point-min))
(let ((end (point-max)))
(while (< (point) end)
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index f63458f70..7703e09e4 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -35,11 +35,16 @@ (require 'cl-lib)
(require 'format-spec)
(declare-function org-mode "org" ())
-(declare-function org-show-context "org" (&optional key))
+(declare-function org-agenda-files "org" (&optional unrestricted archives))
+(declare-function org-fold-show-context "org-fold" (&optional key))
+(declare-function org-fold-save-outline-visibility "org-fold" (use-markers &rest body))
+(declare-function org-fold-next-visibility-change "org-fold" (&optional pos limit ignore-hidden-p previous-p))
+(declare-function org-fold-folded-p "org-fold" (&optional pos limit ignore-hidden-p previous-p))
(declare-function string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case))
(defvar org-ts-regexp0)
(defvar ffap-url-regexp)
+(defvar org-fold-core-style)
\f
;;; Macros
@@ -117,38 +122,7 @@ (defmacro org-no-read-only (&rest body)
(declare (debug (body)))
`(let ((inhibit-read-only t)) ,@body))
-(defmacro org-save-outline-visibility (use-markers &rest body)
- "Save and restore outline visibility around BODY.
-If USE-MARKERS is non-nil, use markers for the positions. This
-means that the buffer may change while running BODY, but it also
-means that the buffer should stay alive during the operation,
-because otherwise all these markers will point to nowhere."
- (declare (debug (form body)) (indent 1))
- (org-with-gensyms (data invisible-types markers?)
- `(let* ((,invisible-types '(org-hide-block outline))
- (,markers? ,use-markers)
- (,data
- (mapcar (lambda (o)
- (let ((beg (overlay-start o))
- (end (overlay-end o))
- (type (overlay-get o 'invisible)))
- (and beg end
- (> end beg)
- (memq type ,invisible-types)
- (list (if ,markers? (copy-marker beg) beg)
- (if ,markers? (copy-marker end t) end)
- type))))
- (org-with-wide-buffer
- (overlays-in (point-min) (point-max))))))
- (unwind-protect (progn ,@body)
- (org-with-wide-buffer
- (dolist (type ,invisible-types)
- (remove-overlays (point-min) (point-max) 'invisible type))
- (pcase-dolist (`(,beg ,end ,type) (delq nil ,data))
- (org-flag-region beg end t type)
- (when ,markers?
- (set-marker beg nil)
- (set-marker end nil))))))))
+(defalias 'org-save-outline-visibility #'org-fold-save-outline-visibility)
(defmacro org-with-wide-buffer (&rest body)
"Execute body while temporarily widening the buffer."
diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el
index 5cfaa7fe0..dd5333399 100644
--- a/lisp/org-mobile.el
+++ b/lisp/org-mobile.el
@@ -1064,7 +1064,7 @@ (defun org-mobile-edit (what old new)
(progn
;; Workaround a `org-insert-heading-respect-content' bug
;; which prevents correct insertion when point is invisible
- (org-show-subtree)
+ (org-fold-show-subtree)
(end-of-line 1)
(org-insert-heading-respect-content t)
(org-demote))
diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el
index 2d8136b75..912efb770 100644
--- a/lisp/org-mouse.el
+++ b/lisp/org-mouse.el
@@ -1007,10 +1007,10 @@ (defun org-mouse-do-remotely (command)
(with-current-buffer buffer
(widen)
(goto-char pos)
- (org-show-hidden-entry)
+ (org-fold-show-hidden-entry)
(save-excursion
(and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
+ (org-fold-heading nil))) ; show the next heading
(org-back-to-heading)
(setq marker (point-marker))
(goto-char (max (point-at-bol) (- (point-at-eol) anticol)))
diff --git a/lisp/org-refile.el b/lisp/org-refile.el
index 5ad73422e..6f2b019ad 100644
--- a/lisp/org-refile.el
+++ b/lisp/org-refile.el
@@ -521,7 +521,7 @@ (defun org-refile (&optional arg default-buffer rfloc msg)
(goto-char (cond (pos)
((org-notes-order-reversed-p) (point-min))
(t (point-max))))
- (org-show-context 'org-goto))
+ (org-fold-show-context 'org-goto))
(if regionp
(progn
(org-kill-new (buffer-substring region-start region-end))
diff --git a/lisp/org-src.el b/lisp/org-src.el
index 663ccb334..cc4918161 100644
--- a/lisp/org-src.el
+++ b/lisp/org-src.el
@@ -1358,8 +1358,10 @@ (defun org-edit-src-exit ()
(goto-char beg)
(cond
;; Block is hidden; move at start of block.
- ((cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block))
- (overlays-at (point)))
+ ((if (eq org-fold-core-style 'text-properties)
+ (org-fold-folded-p nil 'block)
+ (cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block))
+ (overlays-at (point))))
(beginning-of-line 0))
(write-back (org-src--goto-coordinates coordinates beg end))))
;; Clean up left-over markers and restore window configuration.
diff --git a/lisp/org-timer.el b/lisp/org-timer.el
index a6f3648fa..0c9350e76 100644
--- a/lisp/org-timer.el
+++ b/lisp/org-timer.el
@@ -478,7 +478,7 @@ (defun org-timer--get-timer-title ()
(with-current-buffer (marker-buffer marker)
(org-with-wide-buffer
(goto-char hdmarker)
- (org-show-entry)
+ (org-fold-show-entry)
(or (ignore-errors (org-get-heading))
(buffer-name (buffer-base-buffer))))))))
((derived-mode-p 'org-mode)
diff --git a/lisp/org.el b/lisp/org.el
index 8c823a7c8..ca4973bc3 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -96,6 +96,9 @@ (require 'org-keys)
(require 'ol)
(require 'oc)
(require 'org-table)
+(require 'org-fold)
+
+(require 'org-cycle)
;; `org-outline-regexp' ought to be a defconst but is let-bound in
;; some places -- e.g. see the macro `org-with-limited-levels'.
@@ -4670,7 +4673,7 @@ (define-derived-mode org-mode outline-mode "Org"
t))
(when org-startup-with-inline-images (org-display-inline-images))
(when org-startup-with-latex-preview (org-latex-preview '(16)))
- (unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility))
+ (unless org-inhibit-startup-visibility-stuff (org-cycle-set-startup-visibility))
(when org-startup-truncated (setq truncate-lines t))
(when org-startup-numerated (require 'org-num) (org-num-mode 1))
(when org-startup-indented (require 'org-indent) (org-indent-mode 1))))
@@ -5865,7 +5868,7 @@ (defun org-tree-to-indirect-buffer (&optional arg)
(pop-to-buffer ibuf))
(t (error "Invalid value")))
(narrow-to-region beg end)
- (org-show-all '(headings drawers blocks))
+ (org-fold-show-all '(headings drawers blocks))
(goto-char pos)
(run-hook-with-args 'org-cycle-hook 'all)
(and (window-live-p cwin) (select-window cwin))))
@@ -5977,10 +5980,15 @@ (defun org-insert-heading (&optional arg invisible-ok top)
;; When INVISIBLE-OK is non-nil, ensure newly created headline
;; is visible.
(unless invisible-ok
- (pcase (get-char-property-and-overlay (point) 'invisible)
- (`(outline . ,o)
- (move-overlay o (overlay-start o) (line-end-position 0)))
- (_ nil))))
+ (if (eq org-fold-core-style 'text-properties)
+ (cond
+ ((org-fold-folded-p (line-beginning-position) 'headline)
+ (org-fold-region (line-end-position 0) (line-end-position) nil 'headline))
+ (t nil))
+ (pcase (get-char-property-and-overlay (point) 'invisible)
+ (`(outline . ,o)
+ (move-overlay o (overlay-start o) (line-end-position 0)))
+ (_ nil)))))
;; At a headline...
((org-at-heading-p)
(cond ((bolp)
@@ -6522,7 +6530,7 @@ (defun org-convert-to-oddeven-levels ()
(goto-char (point-min))
;; First check if there are no even levels
(when (re-search-forward "^\\(\\*\\*\\)+ " nil t)
- (org-show-set-visibility 'canonical)
+ (org-fold-show-set-visibility 'canonical)
(error "Not all levels are odd in this file. Conversion not possible"))
(when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
(let ((outline-regexp org-outline-regexp)
@@ -6615,9 +6623,9 @@ (defun org-move-subtree-down (&optional arg)
(setq txt (buffer-substring beg end))
(org-save-markers-in-region beg end)
(delete-region beg end)
- (org-remove-empty-overlays-at beg)
- (unless (= beg (point-min)) (org-flag-region (1- beg) beg nil 'outline))
- (unless (bobp) (org-flag-region (1- (point)) (point) nil 'outline))
+ (when (eq org-fold-core-style 'overlays) (org-remove-empty-overlays-at beg))
+ (unless (= beg (point-min)) (org-fold-region (1- beg) beg nil 'outline))
+ (unless (bobp) (org-fold-region (1- (point)) (point) nil 'outline))
(and (not (bolp)) (looking-at "\n") (forward-char 1))
(let ((bbb (point)))
(insert-before-markers txt)
@@ -6628,9 +6636,9 @@ (defun org-move-subtree-down (&optional arg)
(org-skip-whitespace)
(move-marker ins-point nil)
(if folded
- (org-flag-subtree t)
- (org-show-entry)
- (org-show-children))
+ (org-fold-subtree t)
+ (org-fold-show-entry)
+ (org-fold-show-children))
(org-clean-visibility-after-subtree-move)
;; move back to the initial column we were at
(move-to-column col))))
@@ -6988,7 +6996,7 @@ (defun org-clone-subtree-with-time-shift (n &optional shift)
(insert template)
(org-mode)
(goto-char (point-min))
- (org-show-subtree)
+ (org-fold-show-subtree)
(and idprop (if org-clone-delete-id
(org-entry-delete nil "ID")
(org-id-get-create t)))
@@ -7260,7 +7268,7 @@ (defun org-sort-entries
(point))
what "children")
(goto-char start)
- (outline-show-subtree)
+ (org-fold-show-subtree)
(outline-next-heading))
(t
;; we will sort the top-level entries in this file
@@ -7276,7 +7284,7 @@ (defun org-sort-entries
(setq end (point-max))
(setq what "top-level")
(goto-char start)
- (org-show-all '(headings drawers blocks))))
+ (org-fold-show-all '(headings drawers blocks))))
(setq beg (point))
(when (>= beg end) (goto-char start) (user-error "Nothing to sort"))
@@ -7860,7 +7868,7 @@ (defun org-open-file (path &optional in-emacs line search)
(funcall (cdr (assq 'file org-link-frame-setup)) file)
(widen)
(cond (line (org-goto-line line)
- (when (derived-mode-p 'org-mode) (org-reveal)))
+ (when (derived-mode-p 'org-mode) (org-fold-reveal)))
(search (condition-case err
(org-link-search search)
;; Save position before error-ing out so user
@@ -8156,7 +8164,7 @@ (defun org-mark-ring-goto (&optional n)
(setq m (car p))
(pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
- (when (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
+ (when (or (org-invisible-p) (org-invisible-p2)) (org-fold-show-context 'mark-goto))))
;;; Following specific links
@@ -10167,7 +10175,7 @@ (defun org-occur (regexp &optional keep-previous callback)
"Make a compact tree showing all matches of REGEXP.
The tree will show the lines where the regexp matches, and any other context
-defined in `org-show-context-detail', which see.
+defined in `org-fold-show-context-detail', which see.
When optional argument KEEP-PREVIOUS is non-nil, highlighting and exposing
done by a previous call to `org-occur' will be kept, to allow stacking of
@@ -10189,7 +10197,7 @@ (defun org-occur (regexp &optional keep-previous callback)
(when (or (not keep-previous) ; do not want to keep
(not org-occur-highlights)) ; no previous matches
;; hide everything
- (org-overview))
+ (org-cycle-overview))
(let ((case-fold-search (if (eq org-occur-case-fold-search 'smart)
(isearch-no-upper-case-p regexp t)
org-occur-case-fold-search)))
@@ -10199,12 +10207,12 @@ (defun org-occur (regexp &optional keep-previous callback)
(setq cnt (1+ cnt))
(when org-highlight-sparse-tree-matches
(org-highlight-new-match (match-beginning 0) (match-end 0)))
- (org-show-context 'occur-tree)))))
+ (org-fold-show-context 'occur-tree)))))
(when org-remove-highlights-with-change
(add-hook 'before-change-functions 'org-remove-occur-highlights
nil 'local))
(unless org-sparse-tree-open-archived-trees
- (org-hide-archived-subtrees (point-min) (point-max)))
+ (org-fold-hide-archived-subtrees (point-min) (point-max)))
(run-hooks 'org-occur-hook)
(when (called-interactively-p 'interactive)
(message "%d match(es) for regexp %s" cnt regexp))
@@ -10488,7 +10496,7 @@ (defun org-scan-tags (action matcher todo-only &optional start-level)
(save-excursion
(goto-char (point-min))
(when (eq action 'sparse-tree)
- (org-overview)
+ (org-cycle-overview)
(org-remove-occur-highlights))
(if (org-element--cache-active-p)
(let ((fast-re (concat "^"
@@ -10537,7 +10545,7 @@ (defun org-scan-tags (action matcher todo-only &optional start-level)
(org-get-heading) (match-end 0)
(org-highlight-new-match
(match-beginning 1) (match-end 1)))
- (org-show-context 'tags-tree))
+ (org-fold-show-context 'tags-tree))
((eq action 'agenda)
(let* ((effort (org-entry-get (point) org-effort-property))
(effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))))
@@ -10663,7 +10671,7 @@ (defun org-scan-tags (action matcher todo-only &optional start-level)
(org-get-heading) (match-end 0)
(org-highlight-new-match
(match-beginning 1) (match-end 1)))
- (org-show-context 'tags-tree))
+ (org-fold-show-context 'tags-tree))
((eq action 'agenda)
(setq txt (org-agenda-format-item
""
@@ -10701,7 +10709,7 @@ (defun org-scan-tags (action matcher todo-only &optional start-level)
(and (= (point) lspos) (end-of-line 1))))))
(when (and (eq action 'sparse-tree)
(not org-sparse-tree-open-archived-trees))
- (org-hide-archived-subtrees (point-min) (point-max)))
+ (org-fold-hide-archived-subtrees (point-min) (point-max)))
(nreverse rtn)))
(defun org-remove-uninherited-tags (tags)
@@ -12549,7 +12557,7 @@ (defun org-insert-property-drawer ()
(inhibit-read-only t))
(unless (bobp) (insert "\n"))
(insert ":PROPERTIES:\n:END:")
- (org-flag-region (line-end-position 0) (point) t 'outline)
+ (org-fold-region (line-end-position 0) (point) t (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))
(when (or (eobp) (= begin (point-min))) (insert "\n"))
(org-indent-region begin (point))))))
@@ -14391,7 +14399,7 @@ (defun org-timestamp-change (n &optional what updown suppress-tmp-delay)
(message "No clock to adjust")
(save-excursion
(org-goto-marker-or-bmk clfixpos)
- (org-show-subtree)
+ (org-fold-show-subtree)
(when (re-search-forward clrgx nil t)
(goto-char (match-beginning 1))
(let (org-clock-adjust-closest)
@@ -15893,7 +15901,7 @@ (defun org-self-insert-command (N)
If the cursor is in a table looking at whitespace, the whitespace is
overwritten, and the table is not marked as requiring realignment."
(interactive "p")
- (org-check-before-invisible-edit 'insert)
+ (org-fold-check-before-invisible-edit 'insert)
(cond
((and org-use-speed-commands
(let ((kv (this-command-keys-vector)))
@@ -15963,7 +15971,7 @@ (defun org-delete-backward-char (N)
because, in this case the deletion might narrow the column."
(interactive "p")
(save-match-data
- (org-check-before-invisible-edit 'delete-backward)
+ (org-fold-check-before-invisible-edit 'delete-backward)
(if (and (= N 1)
(not overwrite-mode)
(not (org-region-active-p))
@@ -15983,7 +15991,7 @@ (defun org-delete-char (N)
because, in this case the deletion might narrow the column."
(interactive "p")
(save-match-data
- (org-check-before-invisible-edit 'delete)
+ (org-fold-check-before-invisible-edit 'delete)
(cond
((or (/= N 1)
(eq (char-after) ?|)
@@ -16169,11 +16177,11 @@ (defun org-shifttab (&optional arg)
((integerp arg)
(let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg)))
(message "Content view to level: %d" arg)
- (org-content (prefix-numeric-value arg2))
+ (org-cycle-content (prefix-numeric-value arg2))
(org-cycle-show-empty-lines t)
(setq org-cycle-global-status 'overview)
(run-hook-with-args 'org-cycle-hook 'overview)))
- (t (call-interactively 'org-global-cycle))))
+ (t (call-interactively 'org-cycle-global))))
(defun org-shiftmetaleft ()
"Promote subtree or delete table column.
@@ -16327,14 +16335,14 @@ (defun org-check-for-hidden (what)
(setq beg (point-at-bol))
(beginning-of-line 2)
(while (and (not (eobp)) ;; this is like `next-line'
- (get-char-property (1- (point)) 'invisible))
+ (org-invisible-p (1- (point))))
(beginning-of-line 2))
(setq end (point))
(goto-char beg)
(goto-char (point-at-eol))
(setq end (max end (point)))
(while (re-search-forward re end t)
- (when (get-char-property (match-beginning 0) 'invisible)
+ (when (org-invisible-p (match-beginning 0))
(throw 'exit t))))
nil))))
@@ -16622,11 +16630,18 @@ (defun org-copy-visible (beg end)
(interactive "r")
(let ((result ""))
(while (/= beg end)
- (if (invisible-p beg)
- (setq beg (next-single-char-property-change beg 'invisible nil end))
+ (if (eq org-fold-core-style 'text-properties)
+ (progn
+ (while (org-invisible-p beg)
+ (setq beg (org-fold-next-visibility-change beg end)))
+ (let ((next (org-fold-next-visibility-change beg end)))
+ (setq result (concat result (buffer-substring beg next)))
+ (setq beg next)))
+ (when (invisible-p beg)
+ (setq beg (next-single-char-property-change beg 'invisible nil end)))
(let ((next (next-single-char-property-change beg 'invisible nil end)))
- (setq result (concat result (buffer-substring beg next)))
- (setq beg next))))
+ (setq result (concat result (buffer-substring beg next)))
+ (setq beg next))))
(setq deactivate-mark t)
(kill-new result)
(message "Visible strings have been copied to the kill ring.")))
@@ -17000,14 +17015,14 @@ (defun org-kill-note-or-show-branches ()
(cond (org-finish-function
(let ((org-note-abort t)) (funcall org-finish-function)))
((org-before-first-heading-p)
- (org-show-branches-buffer)
- (org-hide-archived-subtrees (point-min) (point-max)))
+ (org-fold-show-branches-buffer)
+ (org-fold-hide-archived-subtrees (point-min) (point-max)))
(t
(let ((beg (progn (org-back-to-heading) (point)))
(end (save-excursion (org-end-of-subtree t t) (point))))
- (outline-hide-subtree)
- (outline-show-branches)
- (org-hide-archived-subtrees beg end)))))
+ (org-fold-hide-subtree)
+ (org-fold-show-branches)
+ (org-fold-hide-archived-subtrees beg end)))))
(defun org-delete-indentation (&optional arg)
"Join current line to previous and fix whitespace at join.
@@ -17130,7 +17145,7 @@ (defun org-return (&optional indent arg interactive)
(org-auto-align-tags (org-align-tags))
(t (org--align-tags-here tags-column))) ;preserve tags column
(end-of-line)
- (org-show-entry)
+ (org-fold-show-entry)
(org--newline indent arg interactive)
(when string (save-excursion (insert (org-trim string))))))
;; In a list, make sure indenting keeps trailing text within.
@@ -17168,11 +17183,11 @@ (defun org-ctrl-c-tab (&optional arg)
(call-interactively #'org-table-toggle-column-width))
((org-before-first-heading-p)
(save-excursion
- (org-flag-above-first-heading)
- (outline-hide-sublevels (or arg 1))))
+ (org-fold-flag-above-first-heading)
+ (org-fold-hide-sublevels (or arg 1))))
(t
- (outline-hide-subtree)
- (org-show-children arg))))
+ (org-fold-hide-subtree)
+ (org-fold-show-children arg))))
(defun org-ctrl-c-star ()
"Compute table, or change heading status of lines.
@@ -17307,7 +17322,7 @@ (defun org-meta-return (&optional arg)
`org-table-wrap-region', depending on context. When called with
an argument, unconditionally call `org-insert-heading'."
(interactive "P")
- (org-check-before-invisible-edit 'insert)
+ (org-fold-check-before-invisible-edit 'insert)
(or (run-hook-with-args-until-success 'org-metareturn-hook)
(call-interactively (cond (arg #'org-insert-heading)
((org-at-table-p) #'org-table-wrap-region)
@@ -17327,8 +17342,8 @@ (easy-menu-define org-org-menu org-mode-map "Org menu."
["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))]
["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))]
["Sparse Tree..." org-sparse-tree t]
- ["Reveal Context" org-reveal t]
- ["Show All" org-show-all t]
+ ["Reveal Context" org-fold-reveal t]
+ ["Show All" org-fold-show-all t]
"--"
["Subtree to indirect buffer" org-tree-to-indirect-buffer t])
"--"
@@ -17787,7 +17802,7 @@ (defun org-goto-marker-or-bmk (marker &optional bookmark)
(when (or (> marker (point-max)) (< marker (point-min)))
(widen))
(goto-char marker)
- (org-show-context 'org-goto))
+ (org-fold-show-context 'org-goto))
(if bookmark
(bookmark-jump bookmark)
(error "Cannot find location"))))
@@ -18024,7 +18039,7 @@ (defun org-occur-in-agenda-files (regexp &optional _nlines)
regexp)))
(add-hook 'occur-mode-find-occurrence-hook
- (lambda () (when (derived-mode-p 'org-mode) (org-reveal))))
+ (lambda () (when (derived-mode-p 'org-mode) (org-fold-reveal))))
(defun org-occur-link-in-agenda-files ()
"Create a link and search for it in the agendas.
@@ -18960,7 +18975,7 @@ (defun org-next-block (arg &optional backward block-regexp)
(cl-decf count))))
(if (= count 0)
(prog1 (goto-char (org-element-property :post-affiliated last-element))
- (save-match-data (org-show-context)))
+ (save-match-data (org-fold-show-context)))
(goto-char origin)
(user-error "No %s code blocks" (if backward "previous" "further")))))
@@ -19441,7 +19456,7 @@ (defun org-kill-line (&optional _arg)
((or (not org-special-ctrl-k)
(bolp)
(not (org-at-heading-p)))
- (when (and (get-char-property (line-end-position) 'invisible)
+ (when (and (org-invisible-p (line-end-position))
org-ctrl-k-protect-subtree
(or (eq org-ctrl-k-protect-subtree 'error)
(not (y-or-n-p "Kill hidden subtree along with headline? "))))
@@ -19529,7 +19544,7 @@ (defun org-yank-generic (command arg)
(or (looking-at org-outline-regexp)
(re-search-forward org-outline-regexp-bol end t))
(while (and (< (point) end) (looking-at org-outline-regexp))
- (org-flag-subtree t)
+ (org-fold-subtree t)
(org-cycle-show-empty-lines 'folded)
(condition-case nil
(outline-forward-same-level 1)
@@ -19586,7 +19601,7 @@ (defun org-back-to-heading (&optional invisible-ok)
(fboundp 'org-inlinetask-end-p)
(org-inlinetask-end-p))
(org-inlinetask-goto-beginning)
- (setq found (and (or invisible-ok (not (org-invisible-p)))
+ (setq found (and (or invisible-ok (not (org-fold-folded-p)))
(point))))))
(goto-char found)
found)))
@@ -20623,9 +20638,9 @@ (defun org-info-find-node (&optional nodename)
\f
;;; Finish up
-(add-hook 'org-mode-hook ;remove overlays when changing major mode
+(add-hook 'org-mode-hook ;remove folds when changing major mode
(lambda () (add-hook 'change-major-mode-hook
- 'org-show-all 'append 'local)))
+ 'org-fold-show-all 'append 'local)))
(provide 'org)
diff --git a/lisp/ox-org.el b/lisp/ox-org.el
index 3d3c4fe6a..96d22d178 100644
--- a/lisp/ox-org.el
+++ b/lisp/ox-org.el
@@ -329,7 +329,7 @@ (defun org-org-publish-to-org (plist filename pub-dir)
newbuf)
(with-current-buffer work-buffer
(org-font-lock-ensure)
- (org-show-all)
+ (org-fold-show-all)
(setq newbuf (htmlize-buffer)))
(with-current-buffer newbuf
(when org-org-htmlized-css-url
diff --git a/testing/lisp/test-org-list.el b/testing/lisp/test-org-list.el
index e21409ca5..a9490692e 100644
--- a/testing/lisp/test-org-list.el
+++ b/testing/lisp/test-org-list.el
@@ -627,7 +627,7 @@ (ert-deftest test-org-list/move-item-down-contents-visibility ()
#+BEGIN_CENTER
Text2
#+END_CENTER"
- (org-hide-block-all)
+ (org-fold-hide-block-all)
(let ((invisible-property-1
(progn
(search-forward "Text1")
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 6aecc3af8..0a47618ca 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -3787,7 +3787,7 @@ (ert-deftest test-org/end-of-line ()
(should-not
(org-test-with-temp-text "#+BEGIN_CENTER\nContents\n#+END_CENTER"
(let ((org-special-ctrl-a/e t))
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(org-end-of-line)
(eobp))))
;; Get past invisible characters at the end of line.
@@ -3935,7 +3935,7 @@ (ert-deftest test-org/forward-paragraph ()
(should
(= 6
(org-test-with-temp-text "#+begin_center\nP1\n\nP2\n#+end_center\nP3"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(org-forward-paragraph)
(org-current-line))))
;; On an item or a footnote definition, move past the first element
@@ -4055,7 +4055,7 @@ (ert-deftest test-org/backward-paragraph ()
(bobp)))
(should
(org-test-with-temp-text "#+begin_center\nP1\n\nP2\n#+end_center\n"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(goto-char (point-max))
(org-backward-paragraph)
(bobp)))
@@ -8057,108 +8057,110 @@ (ert-deftest test-org/timestamp-to-time ()
;;; Visibility
(ert-deftest test-org/hide-drawer-toggle ()
- "Test `org-hide-drawer-toggle' specifications."
+ "Test `org-fold-hide-drawer-toggle' specifications."
;; Error when not at a drawer.
(should-error
(org-test-with-temp-text ":fake-drawer:\ncontents"
- (org-hide-drawer-toggle 'off)
+ (org-fold-hide-drawer-toggle 'off)
(get-char-property (line-end-position) 'invisible)))
(should-error
(org-test-with-temp-text
"#+begin_example\n<point>:D:\nc\n:END:\n#+end_example"
- (org-hide-drawer-toggle t)))
+ (org-fold-hide-drawer-toggle t)))
;; Hide drawer.
(should
(org-test-with-temp-text ":drawer:\ncontents\n:end:"
- (org-hide-drawer-toggle)
+ (org-fold-show-all)
+ (org-fold-hide-drawer-toggle)
(get-char-property (line-end-position) 'invisible)))
;; Show drawer unconditionally when optional argument is `off'.
(should-not
(org-test-with-temp-text ":drawer:\ncontents\n:end:"
- (org-hide-drawer-toggle)
- (org-hide-drawer-toggle 'off)
+ (org-fold-hide-drawer-toggle)
+ (org-fold-hide-drawer-toggle 'off)
(get-char-property (line-end-position) 'invisible)))
;; Hide drawer unconditionally when optional argument is non-nil.
(should
(org-test-with-temp-text ":drawer:\ncontents\n:end:"
- (org-hide-drawer-toggle t)
+ (org-fold-hide-drawer-toggle t)
(get-char-property (line-end-position) 'invisible)))
;; Do not hide drawer when called from final blank lines.
(should-not
(org-test-with-temp-text ":drawer:\ncontents\n:end:\n\n<point>"
- (org-hide-drawer-toggle)
+ (org-fold-show-all)
+ (org-fold-hide-drawer-toggle)
(goto-char (point-min))
(get-char-property (line-end-position) 'invisible)))
;; Don't leave point in an invisible part of the buffer when hiding
;; a drawer away.
(should-not
(org-test-with-temp-text ":drawer:\ncontents\n<point>:end:"
- (org-hide-drawer-toggle)
+ (org-fold-hide-drawer-toggle)
(get-char-property (point) 'invisible))))
(ert-deftest test-org/hide-block-toggle ()
- "Test `org-hide-block-toggle' specifications."
+ "Test `org-fold-hide-block-toggle' specifications."
;; Error when not at a block.
(should-error
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents"
- (org-hide-block-toggle 'off)
+ (org-fold-hide-block-toggle 'off)
(get-char-property (line-end-position) 'invisible)))
;; Hide block.
(should
(org-test-with-temp-text "#+BEGIN_CENTER\ncontents\n#+END_CENTER"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(get-char-property (line-end-position) 'invisible)))
(should
(org-test-with-temp-text "#+BEGIN_EXAMPLE\ncontents\n#+END_EXAMPLE"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(get-char-property (line-end-position) 'invisible)))
;; Show block unconditionally when optional argument is `off'.
(should-not
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
- (org-hide-block-toggle)
- (org-hide-block-toggle 'off)
+ (org-fold-hide-block-toggle)
+ (org-fold-hide-block-toggle 'off)
(get-char-property (line-end-position) 'invisible)))
(should-not
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
- (org-hide-block-toggle 'off)
+ (org-fold-hide-block-toggle 'off)
(get-char-property (line-end-position) 'invisible)))
;; Hide block unconditionally when optional argument is non-nil.
(should
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
- (org-hide-block-toggle t)
+ (org-fold-hide-block-toggle t)
(get-char-property (line-end-position) 'invisible)))
(should
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
- (org-hide-block-toggle)
- (org-hide-block-toggle t)
+ (org-fold-hide-block-toggle)
+ (org-fold-hide-block-toggle t)
(get-char-property (line-end-position) 'invisible)))
;; Do not hide block when called from final blank lines.
(should-not
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE\n\n<point>"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(goto-char (point-min))
(get-char-property (line-end-position) 'invisible)))
;; Don't leave point in an invisible part of the buffer when hiding
;; a block away.
(should-not
(org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n<point>#+END_QUOTE"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(get-char-property (point) 'invisible))))
(ert-deftest test-org/hide-block-toggle-maybe ()
- "Test `org-hide-block-toggle-maybe' specifications."
+ "Test `org-fold-hide-block-toggle' specifications."
(should
(org-test-with-temp-text "#+BEGIN: dynamic\nContents\n#+END:"
- (org-hide-block-toggle-maybe)))
- (should-not
- (org-test-with-temp-text "Paragraph" (org-hide-block-toggle-maybe))))
+ (org-hide-block-toggle)))
+ (should-error
+ (org-test-with-temp-text "Paragraph" (org-hide-block-toggle))))
(ert-deftest test-org/show-set-visibility ()
- "Test `org-show-set-visibility' specifications."
+ "Test `org-fold-show-set-visibility' specifications."
;; Do not throw an error before first heading.
(should
(org-test-with-temp-text "Preamble\n* Headline"
- (org-show-set-visibility 'tree)
+ (org-fold-show-set-visibility 'tree)
t))
;; Test all visibility spans, both on headline and in entry.
(let ((list-visible-lines
@@ -8180,7 +8182,7 @@ (ert-deftest test-org/show-set-visibility ()
"
(org-cycle t)
(search-forward (if headerp "Self" "Match"))
- (org-show-set-visibility state)
+ (org-fold-show-set-visibility state)
(goto-char (point-min))
(let (result (line 0))
(while (not (eobp))
@@ -8211,24 +8213,24 @@ (ert-deftest test-org/show-set-visibility ()
;; visible.
(should-not
(org-test-with-temp-text "#+BEGIN_QUOTE\nText\n#+END_QUOTE"
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(search-forward "Text")
- (org-show-set-visibility 'minimal)
+ (org-fold-show-set-visibility 'minimal)
(org-invisible-p2)))
(should-not
(org-test-with-temp-text ":DRAWER:\nText\n:END:"
- (org-hide-drawer-toggle)
+ (org-fold-hide-drawer-toggle)
(search-forward "Text")
- (org-show-set-visibility 'minimal)
+ (org-fold-show-set-visibility 'minimal)
(org-invisible-p2)))
(should-not
(org-test-with-temp-text
"#+BEGIN_QUOTE\n<point>:DRAWER:\nText\n:END:\n#+END_QUOTE"
- (org-hide-drawer-toggle)
+ (org-fold-hide-drawer-toggle)
(forward-line -1)
- (org-hide-block-toggle)
+ (org-fold-hide-block-toggle)
(search-forward "Text")
- (org-show-set-visibility 'minimal)
+ (org-fold-show-set-visibility 'minimal)
(org-invisible-p2))))
(ert-deftest test-org/copy-visible ()
--
2.35.1
--
Ihor Radchenko,
PhD,
Center for Advancing Materials Performance from the Nanoscale (CAMP-nano)
State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China
Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg
^ permalink raw reply related [relevance 12%]
* [PATCH v2 17/38] org-compat: Work around some third-party packages using outline-* functions
2022-04-20 13:24 13% ` [PATCH v2 02/38] Separate folding functions from org.el into new library: org-fold Ihor Radchenko
2022-04-20 13:25 12% ` [PATCH v2 09/38] Rename old function call to use org-fold--- Ihor Radchenko
@ 2022-04-20 13:26 12% ` Ihor Radchenko
2 siblings, 0 replies; 25+ results
From: Ihor Radchenko @ 2022-04-20 13:26 UTC (permalink / raw)
To: emacs-orgmode
---
lisp/org-compat.el | 72 +++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 71 insertions(+), 1 deletion(-)
diff --git a/lisp/org-compat.el b/lisp/org-compat.el
index 3e8f49f0a..f599e246e 100644
--- a/lisp/org-compat.el
+++ b/lisp/org-compat.el
@@ -1330,11 +1330,81 @@ (defvar session-globals-exclude)
(eval-after-load 'session
'(add-to-list 'session-globals-exclude 'org-mark-ring))
+;;;; outline-mode
+
+;; Folding in outline-mode is not compatible with org-mode folding
+;; anymore. Working around to avoid breakage of external packages
+;; assuming the compatibility.
+(defadvice outline-flag-region (around outline-flag-region@fix-for-org-fold (from to flag) activate)
+ "Run `org-fold-region' when in org-mode."
+ (if (eq major-mode 'org-mode)
+ (setq ad-return-value (org-fold-region (max from (point-min)) (min to (point-max)) flag 'headline))
+ ad-do-it))
+
+(defadvice outline-next-visible-heading (around outline-next-visible-heading@fix-for-org-fold (arg) activate)
+ "Run `org-next-visible-heading' when in org-mode."
+ (interactive "p")
+ (if (eq major-mode 'org-mode)
+ (setq ad-return-value (org-next-visible-heading arg))
+ ad-do-it))
+
+(defadvice outline-back-to-heading (around outline-back-to-heading@fix-for-org-fold (&optional invisible-ok) activate)
+ "Run `org-back-to-heading' when in org-mode."
+ (if (eq major-mode 'org-mode)
+ (setq ad-return-value
+ (progn
+ (beginning-of-line)
+ (or (org-at-heading-p (not invisible-ok))
+ (let (found)
+ (save-excursion
+ (while (not found)
+ (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
+ nil t)
+ (signal 'outline-before-first-heading nil))
+ (setq found (and (or invisible-ok (not (org-fold-folded-p)))
+ (point)))))
+ (goto-char found)
+ found))))
+ ad-do-it))
+
+(defadvice outline-on-heading-p (around outline-on-heading-p@fix-for-org-fold (&optional invisible-ok) activate)
+ "Run `org-at-heading-p' when in org-mode."
+ (if (eq major-mode 'org-mode)
+ (setq ad-return-value (org-at-heading-p (not invisible-ok)))
+ ad-do-it))
+
+(defadvice outline-hide-sublevels (around outline-hide-sublevels@fix-for-org-fold (levels) activate)
+ "Run `org-fold-hide-sublevels' when in org-mode."
+ (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 (eq major-mode 'org-mode)
+ (setq ad-return-value (org-fold-hide-sublevels levels))
+ ad-do-it))
+
+(defadvice outline-toggle-children (around outline-toggle-children@fix-for-org-fold () activate)
+ "Run `org-fold-hide-sublevels' when in org-mode."
+ (interactive)
+ (if (eq major-mode 'org-mode)
+ (setq ad-return-value
+ (save-excursion
+ (org-back-to-heading)
+ (if (not (org-fold-folded-p (line-end-position)))
+ (org-fold-hide-subtree)
+ (org-fold-show-children)
+ (org-fold-show-entry))))
+ ad-do-it))
+
+;; TODO: outline-headers-as-kill
+
;;;; Speed commands
(make-obsolete-variable 'org-speed-commands-user
"configure `org-speed-commands' instead." "9.5")
-
(provide 'org-compat)
;; Local variables:
--
2.35.1
--
Ihor Radchenko,
PhD,
Center for Advancing Materials Performance from the Nanoscale (CAMP-nano)
State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China
Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg
^ permalink raw reply related [relevance 12%]
* [PATCH] Re: [Style] Shouldn’t the macros in org-fold-core have (indent 0)
@ 2022-05-07 3:46 5% ` Ihor Radchenko
0 siblings, 0 replies; 25+ results
From: Ihor Radchenko @ 2022-05-07 3:46 UTC (permalink / raw)
To: Anders Johansson; +Cc: org-mode-email
[-- Attachment #1: Type: text/plain, Size: 800 bytes --]
Anders Johansson <mejlaandersj@gmail.com> writes:
> When looking through the code in org-fold-core (while debugging a tricky
> problem that seems to be an interaction with org-modern, I may get back to
> it) I noticed that all the macros that wrap a “body” argument have (indent
> 1), but I gather that they should have (indent 0), similar to for example
> `with-silent-modifications`.
Thanks for the heads up! This was just a blind kill-yank from a macro
with extra arg.
> I didn’t want to create a patch, since it would involve whitespace changes
> on quite a lot of places, but I thought it could be good to highlight now
> that org-fold just got merged.
Still, it needs to be done.
Attaching the patch with fixed indent statements and reindented code.
Best,
Ihor
[-- Attachment #2: 0001-Fix-macro-indentation-and-re-indent-code-misindented.patch --]
[-- Type: text/x-patch, Size: 113722 bytes --]
From 6412cc974afa3a4701a784f331b7182278ba5bef Mon Sep 17 00:00:00 2001
Message-Id: <6412cc974afa3a4701a784f331b7182278ba5bef.1651895053.git.yantar92@gmail.com>
From: Ihor Radchenko <yantar92@gmail.com>
Date: Sat, 7 May 2022 11:34:10 +0800
Subject: [PATCH] Fix macro indentation and re-indent code misindented by
nameless
* lisp/org-fold-core.el (org-fold-core-cycle-over-indirect-buffers):
(org-fold-core-ignore-modifications):
(org-fold-core-ignore-fragility-checks):
* lisp/org-macs.el (org-element-with-disabled-cache): Fix incorrect
indentation declare statement. Body-only macros should use (indent 0)
to avoid indenting first line differently from other body.
* lisp/org-capture.el:
* lisp/org-clock.el:
* lisp/org-fold-core.el:
* lisp/org-fold.el:
* lisp/org-id.el:
* lisp/org-list.el:
* lisp/org-macs.el:
* lisp/org.el: Reindent.
Reported in https://orgmode.org/list/CAKJdtO_Z4LBGek3SUc6-a_Z0-dDd6L26_YfMYpZTn7F92uxXJQ@mail.gmail.com
---
lisp/org-capture.el | 2 +-
lisp/org-clock.el | 58 ++--
lisp/org-element.el | 458 +++++++++++++++-------------
lisp/org-fold-core.el | 140 ++++-----
lisp/org-fold.el | 91 +++---
lisp/org-id.el | 48 +--
lisp/org-list.el | 90 +++---
lisp/org-macs.el | 2 +-
lisp/org.el | 688 +++++++++++++++++++++---------------------
9 files changed, 812 insertions(+), 765 deletions(-)
diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index 068e3eda2..5ca4e1f2f 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -1174,7 +1174,7 @@ (defun org-capture-place-entry ()
(t (goto-char (point-max))
;; Make sure that last point is not folded.
(org-fold-core-cycle-over-indirect-buffers
- (org-fold-region (max 1 (1- (point-max))) (point-max) nil))))
+ (org-fold-region (max 1 (1- (point-max))) (point-max) nil))))
(let ((origin (point)))
(unless (bolp) (insert "\n"))
(org-capture-empty-lines-before)
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index ec87aaf8a..e2c2688e1 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -1582,8 +1582,8 @@ (defun org-clock-find-position (find-unclosed)
(cond
((null positions)
(org-fold-core-ignore-modifications
- ;; Skip planning line and property drawer, if any.
- (org-end-of-meta-data)
+ ;; Skip planning line and property drawer, if any.
+ (org-end-of-meta-data)
(unless (bolp) (insert-and-inherit "\n"))
;; Create a new drawer if necessary.
(when (and org-clock-into-drawer
@@ -1607,28 +1607,28 @@ (defun org-clock-find-position (find-unclosed)
;; Skip planning line and property drawer, if any.
(org-end-of-meta-data)
(org-fold-core-ignore-modifications
- (let ((beg (point)))
- (insert-and-inherit
- (mapconcat
- (lambda (p)
- (save-excursion
- (goto-char p)
- (org-trim (delete-and-extract-region
- (save-excursion (skip-chars-backward " \r\t\n")
- (line-beginning-position 2))
- (line-beginning-position 2)))))
- positions "\n")
- "\n:END:\n")
- (let ((end (point-marker)))
- (goto-char beg)
- (save-excursion (insert-and-inherit ":" drawer ":\n"))
- (org-fold-region (line-end-position) (1- end) t 'outline)
- (org-indent-region (point) end)
- (forward-line)
- (unless org-log-states-order-reversed
- (goto-char end)
- (beginning-of-line -1))
- (set-marker end nil)))))
+ (let ((beg (point)))
+ (insert-and-inherit
+ (mapconcat
+ (lambda (p)
+ (save-excursion
+ (goto-char p)
+ (org-trim (delete-and-extract-region
+ (save-excursion (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))
+ (line-beginning-position 2)))))
+ positions "\n")
+ "\n:END:\n")
+ (let ((end (point-marker)))
+ (goto-char beg)
+ (save-excursion (insert-and-inherit ":" drawer ":\n"))
+ (org-fold-region (line-end-position) (1- end) t 'outline)
+ (org-indent-region (point) end)
+ (forward-line)
+ (unless org-log-states-order-reversed
+ (goto-char end)
+ (beginning-of-line -1))
+ (set-marker end nil)))))
(org-log-states-order-reversed (goto-char (car (last positions))))
(t (goto-char (car positions))))))))
@@ -1678,7 +1678,7 @@ (defun org-clock-out (&optional switch-to-state fail-quietly at-time)
(goto-char (match-end 0))
(delete-region (point) (point-at-eol))
(org-fold-core-ignore-modifications
- (insert-and-inherit "--")
+ (insert-and-inherit "--")
(setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive))
(setq s (org-time-convert-to-integer
(time-subtract
@@ -1717,9 +1717,11 @@ (defun org-clock-out (&optional switch-to-state fail-quietly at-time)
(match-string 2))))
(when newstate (org-todo newstate))))
((and org-clock-out-switch-to-state
- (not (looking-at (concat org-outline-regexp "[ \t]*"
- org-clock-out-switch-to-state
- "\\>"))))
+ (not (looking-at
+ (concat
+ org-outline-regexp "[ \t]*"
+ org-clock-out-switch-to-state
+ "\\>"))))
(org-todo org-clock-out-switch-to-state))))))
(force-mode-line-update)
(message (if remove
diff --git a/lisp/org-element.el b/lisp/org-element.el
index 3856079aa..14c657287 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -646,8 +646,9 @@ (defun org-element-insert-before (element location)
;; Set appropriate :parent property.
(org-element-put-property element :parent parent)))
-(defconst org-element--cache-element-properties '(:cached
- :org-element--cache-sync-key)
+(defconst org-element--cache-element-properties
+ '(:cached
+ :org-element--cache-sync-key)
"List of element properties used internally by cache.")
(defun org-element-set-element (old new)
@@ -1291,10 +1292,10 @@ (defun org-element-org-data-parser (&optional _)
(let ((org-element-org-data-parser--recurse t))
(while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t)
(org-element-with-disabled-cache
- (let ((element (org-element-at-point-no-context)))
- (when (eq (org-element-type element) 'keyword)
- (throw 'buffer-category
- (org-element-property :value element)))))))))
+ (let ((element (org-element-at-point-no-context)))
+ (when (eq (org-element-type element) 'keyword)
+ (throw 'buffer-category
+ (org-element-property :value element)))))))))
category))
(properties (org-element--get-global-node-properties)))
(unless (plist-get properties :CATEGORY)
@@ -5416,18 +5417,19 @@ (defvar-local org-element--cache-sync-keys-value nil
(defvar-local org-element--cache-change-tic nil
"Last `buffer-chars-modified-tick' for registered changes.")
-(defvar org-element--cache-non-modifying-commands '(org-agenda
- org-agenda-redo
- org-sparse-tree
- org-occur
- org-columns
- org-columns-redo
- org-columns-new
- org-columns-delete
- org-columns-compute
- org-columns-insert-dblock
- org-agenda-columns
- org-ctrl-c-ctrl-c)
+(defvar org-element--cache-non-modifying-commands
+ '(org-agenda
+ org-agenda-redo
+ org-sparse-tree
+ org-occur
+ org-columns
+ org-columns-redo
+ org-columns-new
+ org-columns-delete
+ org-columns-compute
+ org-columns-insert-dblock
+ org-agenda-columns
+ org-ctrl-c-ctrl-c)
"List of commands that are not expected to change the cache state.
This variable is used to determine when re-parsing buffer is not going
@@ -5541,9 +5543,10 @@ (defsubst org-element--cache-key (element)
(- begin 2)
begin)))))
(when org-element--cache-sync-requests
- (org-element-put-property element
- :org-element--cache-sync-key
- (cons org-element--cache-sync-keys-value key)))
+ (org-element-put-property
+ element
+ :org-element--cache-sync-key
+ (cons org-element--cache-sync-keys-value key)))
key)))
(defun org-element--cache-generate-key (lower upper)
@@ -5698,7 +5701,7 @@ (defun org-element--cache-find (pos &optional side)
(cond
((and limit
(not (org-element--cache-key-less-p
- (org-element--cache-key element) limit)))
+ (org-element--cache-key element) limit)))
(setq node (avl-tree--node-left node)))
((> begin pos)
(setq upper element
@@ -5751,13 +5754,15 @@ (defun org-element--cache-put (element)
(cond ((cdr keys) (org-element--cache-key (cdr keys)))
(org-element--cache-sync-requests
(org-element--request-key (car org-element--cache-sync-requests)))))))
- (org-element-put-property element
- :org-element--cache-sync-key
- (cons org-element--cache-sync-keys-value new-key))))
+ (org-element-put-property
+ element
+ :org-element--cache-sync-key
+ (cons org-element--cache-sync-keys-value new-key))))
(when (>= org-element--cache-diagnostics-level 2)
- (org-element--cache-log-message "Added new element with %S key: %S"
- (org-element-property :org-element--cache-sync-key element)
- (org-element--format-element element)))
+ (org-element--cache-log-message
+ "Added new element with %S key: %S"
+ (org-element-property :org-element--cache-sync-key element)
+ (org-element--format-element element)))
(org-element-put-property element :cached t)
(when (memq (org-element-type element) '(headline inlinetask))
(cl-incf org-element--headline-cache-size)
@@ -5781,12 +5786,13 @@ (defsubst org-element--cache-remove (element)
(progn
;; This should not happen, but if it is, would be better to know
;; where it happens.
- (org-element--cache-warn "Failed to delete %S element in %S at %S. The element cache key was %S.
+ (org-element--cache-warn
+ "Failed to delete %S element in %S at %S. The element cache key was %S.
If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report)."
- (org-element-type element)
- (current-buffer)
- (org-element-property :begin element)
- (org-element-property :org-element--cache-sync-key element))
+ (org-element-type element)
+ (current-buffer)
+ (org-element-property :begin element)
+ (org-element-property :org-element--cache-sync-key element))
(org-element-cache-reset)
(throw 'quit nil))))
@@ -5873,7 +5879,7 @@ (defun org-element--cache-sync (buffer &optional threshold future-change offset)
;; Check if the buffer have been changed outside visibility of
;; `org-element--cache-before-change' and `org-element--cache-after-change'.
(if (and (/= org-element--cache-change-tic
- (buffer-chars-modified-tick))
+ (buffer-chars-modified-tick))
org-element--cache-silent-modification-check
;; FIXME: Below is a heuristics noticed by observation.
;; quail.el with non-latin input does silent
@@ -5901,16 +5907,17 @@ (defun org-element--cache-sync (buffer &optional threshold future-change offset)
;; warning to not irritate the users.)
(not (version< emacs-version "28")))
(and (boundp 'org-batch-test) org-batch-test))
- (org-element--cache-warn "Unregistered buffer modifications detected. Resetting.
+ (org-element--cache-warn
+ "Unregistered buffer modifications detected. Resetting.
If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report).
The buffer is: %s\n Current command: %S\n Chars modified: %S\n Buffer modified: %S\n Backtrace:\n%S"
- (buffer-name (current-buffer))
- (list this-command (buffer-chars-modified-tick) (buffer-modified-tick))
- (buffer-chars-modified-tick)
- (buffer-modified-tick)
- (when (and (fboundp 'backtrace-get-frames)
- (fboundp 'backtrace-to-string))
- (backtrace-to-string (backtrace-get-frames 'backtrace)))))
+ (buffer-name (current-buffer))
+ (list this-command (buffer-chars-modified-tick) (buffer-modified-tick))
+ (buffer-chars-modified-tick)
+ (buffer-modified-tick)
+ (when (and (fboundp 'backtrace-get-frames)
+ (fboundp 'backtrace-to-string))
+ (backtrace-to-string (backtrace-get-frames 'backtrace)))))
(org-element-cache-reset))
(let ((inhibit-quit t) request next)
(setq org-element--cache-interrupt-C-g-count 0)
@@ -5941,9 +5948,10 @@ (defun org-element--cache-sync (buffer &optional threshold future-change offset)
;; or phase 2 requests. We need to let them know
;; that additional shifting happened ahead of them.
(cl-incf (org-element--request-offset next) (org-element--request-offset request))
- (org-element--cache-log-message "Updating next request offset to %S: %s"
- (org-element--request-offset next)
- (let ((print-length 10) (print-level 3)) (prin1-to-string next)))
+ (org-element--cache-log-message
+ "Updating next request offset to %S: %s"
+ (org-element--request-offset next)
+ (let ((print-length 10) (print-level 3)) (prin1-to-string next)))
;; FIXME: END part of the request only matters for
;; phase 0 requests. However, the only possible
;; phase 0 request must be the first request in the
@@ -5981,11 +5989,12 @@ (defun org-element--cache-process-request
Throw `org-element--cache-interrupt' if the process stops before
completing the request."
- (org-element--cache-log-message "org-element-cache: Processing request %s up to %S-%S, next: %S"
- (let ((print-length 10) (print-level 3)) (prin1-to-string request))
- future-change
- threshold
- next-request-key)
+ (org-element--cache-log-message
+ "org-element-cache: Processing request %s up to %S-%S, next: %S"
+ (let ((print-length 10) (print-level 3)) (prin1-to-string request))
+ future-change
+ threshold
+ next-request-key)
(catch 'org-element--cache-quit
(when (= (org-element--request-phase request) 0)
;; Phase 0.
@@ -6045,18 +6054,20 @@ (defun org-element--cache-process-request
;; Done deleting everthing starting before END.
;; DATA-KEY is the first known element after END.
;; Move on to phase 1.
- (org-element--cache-log-message "found element after %S: %S::%S"
- end
- (org-element-property :org-element--cache-sync-key data)
- (org-element--format-element data))
+ (org-element--cache-log-message
+ "found element after %S: %S::%S"
+ end
+ (org-element-property :org-element--cache-sync-key data)
+ (org-element--format-element data))
(setf (org-element--request-key request) data-key)
(setf (org-element--request-beg request) pos)
(setf (org-element--request-phase request) 1)
(throw 'org-element--cache-end-phase nil)))
;; No element starting after modifications left in
;; cache: further processing is futile.
- (org-element--cache-log-message "Phase 0 deleted all elements in cache after %S!"
- request-key)
+ (org-element--cache-log-message
+ "Phase 0 deleted all elements in cache after %S!"
+ request-key)
(throw 'org-element--cache-quit t)))))))
(when (= (org-element--request-phase request) 1)
;; Phase 1.
@@ -6161,10 +6172,11 @@ (defun org-element--cache-process-request
'(:contents-end :end :robust-end)
'(:contents-end :end))))
(setq up (org-element-property :parent up)))))
- (org-element--cache-log-message "New parent at %S: %S::%S"
- limit
- (org-element-property :org-element--cache-sync-key parent)
- (org-element--format-element parent))
+ (org-element--cache-log-message
+ "New parent at %S: %S::%S"
+ limit
+ (org-element-property :org-element--cache-sync-key parent)
+ (org-element--format-element parent))
(setf (org-element--request-parent request) parent)
(setf (org-element--request-phase request) 2))))))
;; Phase 2.
@@ -6284,19 +6296,21 @@ (defun org-element--cache-process-request
(not (org-element-property :cached p))
;; (not (avl-tree-member-p org-element--cache p))
))))
- (org-element--cache-log-message "Updating parent in %S\n Old parent: %S\n New parent: %S"
- (org-element--format-element data)
- (org-element--format-element (org-element-property :parent data))
- (org-element--format-element parent))
+ (org-element--cache-log-message
+ "Updating parent in %S\n Old parent: %S\n New parent: %S"
+ (org-element--format-element data)
+ (org-element--format-element (org-element-property :parent data))
+ (org-element--format-element parent))
(when (and (eq 'org-data (org-element-type parent))
(not (eq 'headline (org-element-type data))))
;; FIXME: This check is here to see whether
;; such error happens within
;; `org-element--cache-process-request' or somewhere
;; else.
- (org-element--cache-warn "Added org-data parent to non-headline element: %S
+ (org-element--cache-warn
+ "Added org-data parent to non-headline element: %S
If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report)."
- data)
+ data)
(org-element-cache-reset)
(throw 'org-element--cache-quit t))
(org-element-put-property data :parent parent)
@@ -6317,9 +6331,10 @@ (defun org-element--cache-process-request
(pop stack)))))))
;; We reached end of tree: synchronization complete.
t))
- (org-element--cache-log-message "org-element-cache: Finished process. The cache size is %S. The remaining sync requests: %S"
- org-element--cache-size
- (let ((print-level 2)) (prin1-to-string org-element--cache-sync-requests))))
+ (org-element--cache-log-message
+ "org-element-cache: Finished process. The cache size is %S. The remaining sync requests: %S"
+ org-element--cache-size
+ (let ((print-level 2)) (prin1-to-string org-element--cache-sync-requests))))
(defsubst org-element--open-end-p (element)
"Check if ELEMENT in current buffer contains extra blank lines after
@@ -6368,8 +6383,9 @@ (defun org-element--parse-to (pos &optional syncp time-limit)
(setq element (org-element-org-data-parser))
(unless (org-element-property :begin element)
(org-element--cache-warn "Error parsing org-data. Got %S\nPlease report to Org mode mailing list (M-x org-submit-bug-report)." element))
- (org-element--cache-log-message "Nothing in cache. Adding org-data: %S"
- (org-element--format-element element))
+ (org-element--cache-log-message
+ "Nothing in cache. Adding org-data: %S"
+ (org-element--format-element element))
(org-element--cache-put element)
(goto-char (org-element-property :contents-begin element))
(setq mode 'org-data))
@@ -6441,9 +6457,9 @@ (defun org-element--parse-to (pos &optional syncp time-limit)
(org-skip-whitespace)
(eobp))
(org-element-with-disabled-cache
- (setq element (org-element--current-element
- end 'element mode
- (org-element-property :structure parent)))))
+ (setq element (org-element--current-element
+ end 'element mode
+ (org-element-property :structure parent)))))
;; Make sure that we return referenced element in cache
;; that can be altered directly.
(if element
@@ -6451,12 +6467,13 @@ (defun org-element--parse-to (pos &optional syncp time-limit)
;; Nothing to parse (i.e. empty file).
(throw 'exit parent))
(unless (or (not (org-element--cache-active-p)) parent)
- (org-element--cache-warn "Got empty parent while parsing. Please report it to Org mode mailing list (M-x org-submit-bug-report).\n Backtrace:\n%S"
- (when (and (fboundp 'backtrace-get-frames)
- (fboundp 'backtrace-to-string))
- (backtrace-to-string (backtrace-get-frames 'backtrace))
- (org-element-cache-reset)
- (error "org-element--cache: Emergency exit"))))
+ (org-element--cache-warn
+ "Got empty parent while parsing. Please report it to Org mode mailing list (M-x org-submit-bug-report).\n Backtrace:\n%S"
+ (when (and (fboundp 'backtrace-get-frames)
+ (fboundp 'backtrace-to-string))
+ (backtrace-to-string (backtrace-get-frames 'backtrace))
+ (org-element-cache-reset)
+ (error "org-element--cache: Emergency exit"))))
(org-element-put-property element :parent parent))
(let ((elem-end (org-element-property :end element))
(type (org-element-type element)))
@@ -6645,9 +6662,10 @@ (defun org-element--cache-before-change (beg end)
org-element--cache-change-warning-after)
(t (or org-element--cache-change-warning-after
org-element--cache-change-warning-before)))))
- (org-element--cache-log-message "%S is about to modify text: warning %S"
- this-command
- org-element--cache-change-warning)))))))
+ (org-element--cache-log-message
+ "%S is about to modify text: warning %S"
+ this-command
+ org-element--cache-change-warning)))))))
(defun org-element--cache-after-change (beg end pre)
"Update buffer modifications for current buffer.
@@ -6791,8 +6809,9 @@ (defun org-element--cache-for-removal (beg end offset)
(org-element-property :robust-end up))
'(:contents-end :end :robust-end)
'(:contents-end :end)))
- (org-element--cache-log-message "Shifting end positions of robust parent: %S"
- (org-element--format-element up)))
+ (org-element--cache-log-message
+ "Shifting end positions of robust parent: %S"
+ (org-element--format-element up)))
(unless (or
;; UP is non-robust. Yet, if UP is headline, flagging
;; everything inside for removal may be to
@@ -6809,10 +6828,11 @@ (defun org-element--cache-for-removal (beg end offset)
(not (> end (org-element-property :end up)))
(let ((current (org-with-point-at (org-element-property :begin up)
(org-element-with-disabled-cache
- (org-element--current-element (point-max))))))
+ (org-element--current-element (point-max))))))
(when (eq 'headline (org-element-type current))
- (org-element--cache-log-message "Found non-robust headline that can be updated individually: %S"
- (org-element--format-element current))
+ (org-element--cache-log-message
+ "Found non-robust headline that can be updated individually: %S"
+ (org-element--format-element current))
(org-element-set-element up current)
t)))
;; If UP is org-data, the situation is similar to
@@ -6823,11 +6843,13 @@ (defun org-element--cache-for-removal (beg end offset)
(when (and (eq 'org-data (org-element-type up))
(>= beg (org-element-property :contents-begin up)))
(org-element-set-element up (org-with-point-at 1 (org-element-org-data-parser)))
- (org-element--cache-log-message "Found non-robust change invalidating org-data. Re-parsing: %S"
- (org-element--format-element up))
+ (org-element--cache-log-message
+ "Found non-robust change invalidating org-data. Re-parsing: %S"
+ (org-element--format-element up))
t))
- (org-element--cache-log-message "Found non-robust element: %S"
- (org-element--format-element up))
+ (org-element--cache-log-message
+ "Found non-robust element: %S"
+ (org-element--format-element up))
(setq before up)
(when robust-flag (setq robust-flag nil))))
(unless (or (org-element-property :parent up)
@@ -6851,8 +6873,9 @@ (defun org-element--cache-submit-request (beg end offset)
BEG and END are buffer positions delimiting the minimal area
where cache data should be removed. OFFSET is the size of the
change, as an integer."
- (org-element--cache-log-message "Submitting new synchronization request for [%S..%S]𝝙%S"
- beg end offset)
+ (org-element--cache-log-message
+ "Submitting new synchronization request for [%S..%S]𝝙%S"
+ beg end offset)
(with-current-buffer (or (buffer-base-buffer (current-buffer))
(current-buffer))
(let ((next (car org-element--cache-sync-requests))
@@ -6885,38 +6908,49 @@ (defun org-element--cache-submit-request (beg end offset)
;; also need to update the request.
(let ((first (org-element--cache-for-removal delete-from end offset) ; Shift as needed.
))
- (org-element--cache-log-message "Current request is inside next. Candidate parent: %S"
- (org-element--format-element first))
+ (org-element--cache-log-message
+ "Current request is inside next. Candidate parent: %S"
+ (org-element--format-element first))
(when
;; Non-robust element is now before NEXT. Need to
;; update.
(and first
- (org-element--cache-key-less-p (org-element--cache-key first)
- (org-element--request-key next)))
- (org-element--cache-log-message "Current request is inside next. New parent: %S"
- (org-element--format-element first))
- (setf (org-element--request-key next) (org-element--cache-key first))
- (setf (org-element--request-beg next) (org-element-property :begin first))
- (setf (org-element--request-end next) (max (org-element-property :end first)
- (org-element--request-end next)))
- (setf (org-element--request-parent next) (org-element-property :parent first))))
+ (org-element--cache-key-less-p
+ (org-element--cache-key first)
+ (org-element--request-key next)))
+ (org-element--cache-log-message
+ "Current request is inside next. New parent: %S"
+ (org-element--format-element first))
+ (setf (org-element--request-key next)
+ (org-element--cache-key first))
+ (setf (org-element--request-beg next)
+ (org-element-property :begin first))
+ (setf (org-element--request-end next)
+ (max (org-element-property :end first)
+ (org-element--request-end next)))
+ (setf (org-element--request-parent next)
+ (org-element-property :parent first))))
;; The current and NEXT modifications are intersecting
;; with current modification starting before NEXT and NEXT
;; ending after current. We need to update the common
;; non-robust parent for the new extended modification
;; region.
(let ((first (org-element--cache-for-removal beg delete-to offset)))
- (org-element--cache-log-message "Current request intersects with next. Candidate parent: %S"
- (org-element--format-element first))
+ (org-element--cache-log-message
+ "Current request intersects with next. Candidate parent: %S"
+ (org-element--format-element first))
(when (and first
- (org-element--cache-key-less-p (org-element--cache-key first)
- (org-element--request-key next)))
- (org-element--cache-log-message "Current request intersects with next. Updating. New parent: %S"
- (org-element--format-element first))
+ (org-element--cache-key-less-p
+ (org-element--cache-key first)
+ (org-element--request-key next)))
+ (org-element--cache-log-message
+ "Current request intersects with next. Updating. New parent: %S"
+ (org-element--format-element first))
(setf (org-element--request-key next) (org-element--cache-key first))
(setf (org-element--request-beg next) (org-element-property :begin first))
- (setf (org-element--request-end next) (max (org-element-property :end first)
- (org-element--request-end next)))
+ (setf (org-element--request-end next)
+ (max (org-element-property :end first)
+ (org-element--request-end next)))
(setf (org-element--request-parent next) (org-element-property :parent first))))))
;; Ensure cache is correct up to END. Also make sure that NEXT,
;; if any, is no longer a 0-phase request, thus ensuring that
@@ -6974,23 +7008,26 @@ (defun org-element--cache-submit-request (beg end offset)
;; element starting before END but after
;; beginning of first.
;; of the FIRST.
- (org-element--cache-log-message "Extending to all elements between:\n 1: %S\n 2: %S"
- (org-element--format-element first)
- (org-element--format-element element))
+ (org-element--cache-log-message
+ "Extending to all elements between:\n 1: %S\n 2: %S"
+ (org-element--format-element first)
+ (org-element--format-element element))
(vector key first-beg element-end offset up 0)))))
org-element--cache-sync-requests)
;; No element to remove. No need to re-parent either.
;; Simply shift additional elements, if any, by OFFSET.
(if org-element--cache-sync-requests
(progn
- (org-element--cache-log-message "Nothing to remove. Updating offset of the next request by 𝝙%S: %S"
- offset
- (let ((print-level 3))
- (car org-element--cache-sync-requests)))
+ (org-element--cache-log-message
+ "Nothing to remove. Updating offset of the next request by 𝝙%S: %S"
+ offset
+ (let ((print-level 3))
+ (car org-element--cache-sync-requests)))
(cl-incf (org-element--request-offset (car org-element--cache-sync-requests))
offset))
- (org-element--cache-log-message "Nothing to remove. No elements in cache after %S. Terminating."
- end))))))
+ (org-element--cache-log-message
+ "Nothing to remove. No elements in cache after %S. Terminating."
+ end))))))
(setq org-element--cache-change-warning nil)))
(defun org-element--cache-verify-element (element)
@@ -7002,11 +7039,13 @@ (defun org-element--cache-verify-element (element)
(eq 'org-data (org-element-type element)))
(org-element--cache-warn "Got element without parent (cache active?: %S). Please report it to Org mode mailing list (M-x org-submit-bug-report).\n%S" (org-element--cache-active-p) element)
(org-element-cache-reset))
- (let ((org-element--cache-self-verify (or org-element--cache-self-verify
- (and (boundp 'org-batch-test) org-batch-test)))
- (org-element--cache-self-verify-frequency (if (and (boundp 'org-batch-test) org-batch-test)
- 1
- org-element--cache-self-verify-frequency)))
+ (let ((org-element--cache-self-verify
+ (or org-element--cache-self-verify
+ (and (boundp 'org-batch-test) org-batch-test)))
+ (org-element--cache-self-verify-frequency
+ (if (and (boundp 'org-batch-test) org-batch-test)
+ 1
+ org-element--cache-self-verify-frequency)))
(when (and org-element--cache-self-verify
(org-element--cache-active-p)
(derived-mode-p 'org-mode)
@@ -7018,13 +7057,14 @@ (defun org-element--cache-verify-element (element)
(org-element-with-disabled-cache (org-up-heading-or-point-min))
(unless (or (= (point) (org-element-property :begin (org-element-property :parent element)))
(eq (point) (point-min)))
- (org-element--cache-warn "Cached element has wrong parent in %s. Resetting.
+ (org-element--cache-warn
+ "Cached element has wrong parent in %s. Resetting.
If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report).
The element is: %S\n The parent is: %S\n The real parent is: %S"
- (buffer-name (current-buffer))
- (org-element--format-element element)
- (org-element--format-element (org-element-property :parent element))
- (org-element--format-element (org-element--current-element (org-element-property :end (org-element-property :parent element)))))
+ (buffer-name (current-buffer))
+ (org-element--format-element element)
+ (org-element--format-element (org-element-property :parent element))
+ (org-element--format-element (org-element--current-element (org-element-property :end (org-element-property :parent element)))))
(org-element-cache-reset))
(org-element--cache-verify-element (org-element-property :parent element))))
;; Verify the element itself.
@@ -7049,16 +7089,16 @@ (defun org-element--cache-verify-element (element)
(org-element--cache-warn "(%S) Cached element is incorrect in %s. (Cache tic up to date: %S) Resetting.
If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report).
The element is: %S\n The real element is: %S\n Cache around :begin:\n%S\n%S\n%S"
- this-command
- (buffer-name (current-buffer))
- (if (/= org-element--cache-change-tic
- (buffer-chars-modified-tick))
- "no" "yes")
- (org-element--format-element element)
- (org-element--format-element real-element)
- (org-element--cache-find (1- (org-element-property :begin real-element)))
- (car (org-element--cache-find (org-element-property :begin real-element) 'both))
- (cdr (org-element--cache-find (org-element-property :begin real-element) 'both)))
+ this-command
+ (buffer-name (current-buffer))
+ (if (/= org-element--cache-change-tic
+ (buffer-chars-modified-tick))
+ "no" "yes")
+ (org-element--format-element element)
+ (org-element--format-element real-element)
+ (org-element--cache-find (1- (org-element-property :begin real-element)))
+ (car (org-element--cache-find (org-element-property :begin real-element) 'both))
+ (cdr (org-element--cache-find (org-element-property :begin real-element) 'both)))
(org-element-cache-reset))))))
;;; Cache persistance
@@ -7174,8 +7214,8 @@ (defvar org-element-cache-map-continue-from nil
function modified the buffer.")
;;;###autoload
(cl-defun org-element-cache-map (func &key (granularity 'headline+inlinetask) restrict-elements
- next-re fail-re from-pos (to-pos (point-max-marker)) after-element limit-count
- narrow)
+ next-re fail-re from-pos (to-pos (point-max-marker)) after-element limit-count
+ narrow)
"Map all elements in current buffer with FUNC according to
GRANULARITY. Collect non-nil return values into result list.
@@ -7245,27 +7285,27 @@ (cl-defun org-element-cache-map (func &key (granularity 'headline+inlinetask) re
;; Synchronise cache up to the end of mapped region.
(org-element-at-point to-pos)
(cl-macrolet ((cache-root
- ;; Use the most optimal version of cache available.
- () `(if (memq granularity '(headline headline+inlinetask))
- (org-element--headline-cache-root)
- (org-element--cache-root)))
+ ;; Use the most optimal version of cache available.
+ () `(if (memq granularity '(headline headline+inlinetask))
+ (org-element--headline-cache-root)
+ (org-element--cache-root)))
(cache-size
- ;; Use the most optimal version of cache available.
- () `(if (memq granularity '(headline headline+inlinetask))
- org-element--headline-cache-size
- org-element--cache-size))
+ ;; Use the most optimal version of cache available.
+ () `(if (memq granularity '(headline headline+inlinetask))
+ org-element--headline-cache-size
+ org-element--cache-size))
(cache-walk-restart
- ;; Restart tree traversal after AVL tree re-balance.
- () `(when node
- (org-element-at-point (point-max))
- (setq node (cache-root)
- stack (list nil)
- leftp t
- continue-flag t)))
+ ;; Restart tree traversal after AVL tree re-balance.
+ () `(when node
+ (org-element-at-point (point-max))
+ (setq node (cache-root)
+ stack (list nil)
+ leftp t
+ continue-flag t)))
(cache-walk-abort
- ;; Abort tree traversal.
- () `(setq continue-flag t
- node nil))
+ ;; Abort tree traversal.
+ () `(setq continue-flag t
+ node nil))
(element-match-at-point
;; Returning the first element to match around point.
;; For example, if point is inside headline and
@@ -7306,14 +7346,15 @@ (cl-defun org-element-cache-map (func &key (granularity 'headline+inlinetask) re
;; point.
(move-start-to-next-match
(re) `(save-match-data
- (if (or (not ,re) (if org-element--cache-map-statistics
- (progn
- (setq before-time (float-time))
- (re-search-forward (or (car-safe ,re) ,re) nil 'move)
- (cl-incf re-search-time
- (- (float-time)
- before-time)))
- (re-search-forward (or (car-safe ,re) ,re) nil 'move)))
+ (if (or (not ,re)
+ (if org-element--cache-map-statistics
+ (progn
+ (setq before-time (float-time))
+ (re-search-forward (or (car-safe ,re) ,re) nil 'move)
+ (cl-incf re-search-time
+ (- (float-time)
+ before-time)))
+ (re-search-forward (or (car-safe ,re) ,re) nil 'move)))
(unless (or (< (point) (or start -1))
(and data
(< (point) (org-element-property :begin data))))
@@ -7476,8 +7517,8 @@ (cl-defun org-element-cache-map (func &key (granularity 'headline+inlinetask) re
;; PREV.
(or (not prev)
(not (org-element--cache-key-less-p
- (org-element--cache-key data)
- (org-element--cache-key prev))))
+ (org-element--cache-key data)
+ (org-element--cache-key prev))))
;; ... or when we are before START.
(or (not start)
(not (> start (org-element-property :begin data)))))
@@ -7497,8 +7538,8 @@ (cl-defun org-element-cache-map (func &key (granularity 'headline+inlinetask) re
;; and need to fill it.
(unless (or (and start (< (org-element-property :begin data) start))
(and prev (not (org-element--cache-key-less-p
- (org-element--cache-key prev)
- (org-element--cache-key data)))))
+ (org-element--cache-key prev)
+ (org-element--cache-key data)))))
;; DATA is at of after START and PREV.
(if (or (not start) (= (org-element-property :begin data) start))
;; DATA is at START. Match it.
@@ -7711,13 +7752,14 @@ (defun org-element-at-point (&optional pom cached-only)
(condition-case err
(org-element--parse-to pom)
(error
- (org-element--cache-warn "Org parser error in %s::%S. Resetting.\n The error was: %S\n Backtrace:\n%S\n Please report this to Org mode mailing list (M-x org-submit-bug-report)."
- (buffer-name (current-buffer))
- pom
- err
- (when (and (fboundp 'backtrace-get-frames)
- (fboundp 'backtrace-to-string))
- (backtrace-to-string (backtrace-get-frames 'backtrace))))
+ (org-element--cache-warn
+ "Org parser error in %s::%S. Resetting.\n The error was: %S\n Backtrace:\n%S\n Please report this to Org mode mailing list (M-x org-submit-bug-report)."
+ (buffer-name (current-buffer))
+ pom
+ err
+ (when (and (fboundp 'backtrace-get-frames)
+ (fboundp 'backtrace-to-string))
+ (backtrace-to-string (backtrace-get-frames 'backtrace))))
(org-element-cache-reset)
(org-element--parse-to pom)))))
(when (and (org-element--cache-active-p)
@@ -7872,7 +7914,7 @@ (defun org-element-context (&optional element)
(and (= pos cend)
(or (= (point-max) pos)
(not (memq (char-before pos)
- '(?\s ?\t)))))))
+ '(?\s ?\t)))))))
(goto-char cbeg)
(narrow-to-region (point) cend)
(setq parent next)
@@ -7996,36 +8038,36 @@ (defun org-element-swap-A-B--text-properties (elem-A elem-B)
(when (and specialp
(or (not (eq (org-element-type elem-B) 'paragraph))
(/= (org-element-property :begin elem-B)
- (org-element-property :contents-begin elem-B))))
+ (org-element-property :contents-begin elem-B))))
(error "Cannot swap elements"))
;; In a special situation, ELEM-A will have no indentation. We'll
;; give it ELEM-B's (which will in, in turn, have no indentation).
(org-fold-core-ignore-modifications ;; Preserve folding state
- (let* ((ind-B (when specialp
- (goto-char (org-element-property :begin elem-B))
- (current-indentation)))
- (beg-A (org-element-property :begin elem-A))
- (end-A (save-excursion
- (goto-char (org-element-property :end elem-A))
- (skip-chars-backward " \r\t\n")
- (point-at-eol)))
- (beg-B (org-element-property :begin elem-B))
- (end-B (save-excursion
- (goto-char (org-element-property :end elem-B))
- (skip-chars-backward " \r\t\n")
- (point-at-eol)))
- ;; Get contents.
- (body-A (buffer-substring beg-A end-A))
- (body-B (delete-and-extract-region beg-B end-B)))
- (goto-char beg-B)
- (when specialp
- (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B))
- (indent-to-column ind-B))
- (insert body-A)
- (goto-char beg-A)
- (delete-region beg-A end-A)
- (insert body-B)
- (goto-char (org-element-property :end elem-B))))))
+ (let* ((ind-B (when specialp
+ (goto-char (org-element-property :begin elem-B))
+ (current-indentation)))
+ (beg-A (org-element-property :begin elem-A))
+ (end-A (save-excursion
+ (goto-char (org-element-property :end elem-A))
+ (skip-chars-backward " \r\t\n")
+ (point-at-eol)))
+ (beg-B (org-element-property :begin elem-B))
+ (end-B (save-excursion
+ (goto-char (org-element-property :end elem-B))
+ (skip-chars-backward " \r\t\n")
+ (point-at-eol)))
+ ;; Get contents.
+ (body-A (buffer-substring beg-A end-A))
+ (body-B (delete-and-extract-region beg-B end-B)))
+ (goto-char beg-B)
+ (when specialp
+ (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B))
+ (indent-to-column ind-B))
+ (insert body-A)
+ (goto-char beg-A)
+ (delete-region beg-A end-A)
+ (insert body-B)
+ (goto-char (org-element-property :end elem-B))))))
(defsubst org-element-swap-A-B (elem-A elem-B)
"Swap elements ELEM-A and ELEM-B.
Assume ELEM-B is after ELEM-A in the buffer. Leave point at the
diff --git a/lisp/org-fold-core.el b/lisp/org-fold-core.el
index 6786009ec..be2b044ff 100644
--- a/lisp/org-fold-core.el
+++ b/lisp/org-fold-core.el
@@ -365,7 +365,7 @@ ;;; Core functionality
;;;; Folding specs
(defvar-local org-fold-core--specs '((org-fold-visible
- (:visible . t)
+ (:visible . t)
(:alias . (visible)))
(org-fold-hidden
(:ellipsis . "...")
@@ -512,7 +512,7 @@ (defmacro org-fold-core-cycle-over-indirect-buffers (&rest body)
Also, make sure that folding properties from killed buffers are not
hanging around."
- (declare (debug (form body)) (indent 1))
+ (declare (debug (form body)) (indent 0))
`(let (buffers dead-properties)
(if (and (not (buffer-base-buffer))
(not (eq (current-buffer) (car org-fold-core--indirect-buffers))))
@@ -590,7 +590,7 @@ (defun org-fold-core--property-symbol-get-create (spec &optional buffer return-o
(setq-local org-fold-core--indirect-buffers
(let (bufs)
(org-fold-core-cycle-over-indirect-buffers
- (push (current-buffer) bufs))
+ (push (current-buffer) bufs))
(push buf bufs)
(delete-dups bufs)))))
;; Copy all the old folding properties to preserve the folding state
@@ -623,25 +623,25 @@ (defun org-fold-core--property-symbol-get-create (spec &optional buffer return-o
;; parameters.
(let (full-prop-list)
(org-fold-core-cycle-over-indirect-buffers
- (setq full-prop-list
- (append full-prop-list
- (delq nil
- (mapcar (lambda (spec)
- (cond
- ((org-fold-core-get-folding-spec-property spec :front-sticky)
- (cons (org-fold-core--property-symbol-get-create spec nil 'return-only)
- nil))
- ((org-fold-core-get-folding-spec-property spec :rear-sticky)
- nil)
- (t
- (cons (org-fold-core--property-symbol-get-create spec nil 'return-only)
- t))))
- (org-fold-core-folding-spec-list))))))
+ (setq full-prop-list
+ (append full-prop-list
+ (delq nil
+ (mapcar (lambda (spec)
+ (cond
+ ((org-fold-core-get-folding-spec-property spec :front-sticky)
+ (cons (org-fold-core--property-symbol-get-create spec nil 'return-only)
+ nil))
+ ((org-fold-core-get-folding-spec-property spec :rear-sticky)
+ nil)
+ (t
+ (cons (org-fold-core--property-symbol-get-create spec nil 'return-only)
+ t))))
+ (org-fold-core-folding-spec-list))))))
(org-fold-core-cycle-over-indirect-buffers
- (setq-local text-property-default-nonsticky
- (delete-dups (append
- text-property-default-nonsticky
- full-prop-list))))))))))))))
+ (setq-local text-property-default-nonsticky
+ (delete-dups (append
+ text-property-default-nonsticky
+ full-prop-list))))))))))))))
(defun org-fold-core-decouple-indirect-buffer-folds ()
"Copy and decouple folding state in a newly created indirect buffer.
@@ -1177,14 +1177,14 @@ (defvar org-fold-core--ignore-fragility-checks nil
(defmacro org-fold-core-ignore-modifications (&rest body)
"Run BODY ignoring buffer modifications in `org-fold-core--fix-folded-region'."
- (declare (debug (form body)) (indent 1))
+ (declare (debug (form body)) (indent 0))
`(let ((org-fold-core--ignore-modifications t))
(unwind-protect (progn ,@body)
(setq org-fold-core--last-buffer-chars-modified-tick (buffer-chars-modified-tick)))))
(defmacro org-fold-core-ignore-fragility-checks (&rest body)
"Run BODY skipping :fragility checks in `org-fold-core--fix-folded-region'."
- (declare (debug (form body)) (indent 1))
+ (declare (debug (form body)) (indent 0))
`(let ((org-fold-core--ignore-fragility-checks t))
(progn ,@body)))
@@ -1215,53 +1215,53 @@ (defun org-fold-core--fix-folded-region (from to _)
;; buffer. Work around Emacs bug#46982.
(when (eq org-fold-core-style 'text-properties)
(org-fold-core-cycle-over-indirect-buffers
- ;; Re-hide text inserted in the middle/font/back of a folded
- ;; region.
- (unless (equal from to) ; Ignore deletions.
- (dolist (spec (org-fold-core-folding-spec-list))
- ;; Reveal fully invisible text inserted in the middle
- ;; of visible portion of the buffer. This is needed,
- ;; for example, when there was a deletion in a folded
- ;; heading, the heading was unfolded, end `undo' was
- ;; called. The `undo' would insert the folded text.
- (when (and (or (eq from (point-min))
- (not (org-fold-core-folded-p (1- from) spec)))
- (or (eq to (point-max))
- (not (org-fold-core-folded-p to spec)))
- (org-fold-core-region-folded-p from to spec))
- (org-fold-core-region from to nil spec))
- ;; Look around and fold the new text if the nearby folds are
- ;; sticky.
- (unless (org-fold-core-region-folded-p from to spec)
- (let ((spec-to (org-fold-core-get-folding-spec spec (min to (1- (point-max)))))
- (spec-from (org-fold-core-get-folding-spec spec (max (point-min) (1- from)))))
- ;; Reveal folds around undoed deletion.
- (when undo-in-progress
- (let ((lregion (org-fold-core-get-region-at-point spec (max (point-min) (1- from))))
- (rregion (org-fold-core-get-region-at-point spec (min to (1- (point-max))))))
- (if (and lregion rregion)
- (org-fold-core-region (car lregion) (cdr rregion) nil spec)
- (when lregion
- (org-fold-core-region (car lregion) (cdr lregion) nil spec))
- (when rregion
- (org-fold-core-region (car rregion) (cdr rregion) nil spec)))))
- ;; Hide text inserted in the middle of a fold.
- (when (and (or spec-from (eq from (point-min)))
- (or spec-to (eq to (point-max)))
- (or spec-from spec-to)
- (eq spec-to spec-from)
- (or (org-fold-core-get-folding-spec-property spec :front-sticky)
- (org-fold-core-get-folding-spec-property spec :rear-sticky)))
- (unless (and (eq from (point-min)) (eq to (point-max))) ; Buffer content replaced.
- (org-fold-core-region from to t (or spec-from spec-to))))
- ;; Hide text inserted at the end of a fold.
- (when (and spec-from (org-fold-core-get-folding-spec-property spec-from :rear-sticky))
- (org-fold-core-region from to t spec-from))
- ;; Hide text inserted in front of a fold.
- (when (and spec-to
- (not (eq to (point-max))) ; Text inserted at the end of buffer is not prepended anywhere.
- (org-fold-core-get-folding-spec-property spec-to :front-sticky))
- (org-fold-core-region from to t spec-to))))))))
+ ;; Re-hide text inserted in the middle/font/back of a folded
+ ;; region.
+ (unless (equal from to) ; Ignore deletions.
+ (dolist (spec (org-fold-core-folding-spec-list))
+ ;; Reveal fully invisible text inserted in the middle
+ ;; of visible portion of the buffer. This is needed,
+ ;; for example, when there was a deletion in a folded
+ ;; heading, the heading was unfolded, end `undo' was
+ ;; called. The `undo' would insert the folded text.
+ (when (and (or (eq from (point-min))
+ (not (org-fold-core-folded-p (1- from) spec)))
+ (or (eq to (point-max))
+ (not (org-fold-core-folded-p to spec)))
+ (org-fold-core-region-folded-p from to spec))
+ (org-fold-core-region from to nil spec))
+ ;; Look around and fold the new text if the nearby folds are
+ ;; sticky.
+ (unless (org-fold-core-region-folded-p from to spec)
+ (let ((spec-to (org-fold-core-get-folding-spec spec (min to (1- (point-max)))))
+ (spec-from (org-fold-core-get-folding-spec spec (max (point-min) (1- from)))))
+ ;; Reveal folds around undoed deletion.
+ (when undo-in-progress
+ (let ((lregion (org-fold-core-get-region-at-point spec (max (point-min) (1- from))))
+ (rregion (org-fold-core-get-region-at-point spec (min to (1- (point-max))))))
+ (if (and lregion rregion)
+ (org-fold-core-region (car lregion) (cdr rregion) nil spec)
+ (when lregion
+ (org-fold-core-region (car lregion) (cdr lregion) nil spec))
+ (when rregion
+ (org-fold-core-region (car rregion) (cdr rregion) nil spec)))))
+ ;; Hide text inserted in the middle of a fold.
+ (when (and (or spec-from (eq from (point-min)))
+ (or spec-to (eq to (point-max)))
+ (or spec-from spec-to)
+ (eq spec-to spec-from)
+ (or (org-fold-core-get-folding-spec-property spec :front-sticky)
+ (org-fold-core-get-folding-spec-property spec :rear-sticky)))
+ (unless (and (eq from (point-min)) (eq to (point-max))) ; Buffer content replaced.
+ (org-fold-core-region from to t (or spec-from spec-to))))
+ ;; Hide text inserted at the end of a fold.
+ (when (and spec-from (org-fold-core-get-folding-spec-property spec-from :rear-sticky))
+ (org-fold-core-region from to t spec-from))
+ ;; Hide text inserted in front of a fold.
+ (when (and spec-to
+ (not (eq to (point-max))) ; Text inserted at the end of buffer is not prepended anywhere.
+ (org-fold-core-get-folding-spec-property spec-to :front-sticky))
+ (org-fold-core-region from to t spec-to))))))))
;; Process all the folded text between `from' and `to'. Do it
;; only in current buffer to avoid verifying semantic structure
;; multiple times in indirect buffers that have exactly same
diff --git a/lisp/org-fold.el b/lisp/org-fold.el
index 5085778dc..afde89bed 100644
--- a/lisp/org-fold.el
+++ b/lisp/org-fold.el
@@ -215,34 +215,35 @@ (defun org-fold-initialize (ellipsis)
;; this until there will be no need to convert text properties to
;; overlays for isearch.
(setq-local org-fold-core--isearch-special-specs '(org-link))
- (org-fold-core-initialize `((org-fold-outline
- (:ellipsis . ,ellipsis)
- (:fragile . ,#'org-fold--reveal-outline-maybe)
- (:isearch-open . t)
- ;; This is needed to make sure that inserting a
- ;; new planning line in folded heading is not
- ;; revealed.
- (:front-sticky . t)
- (:rear-sticky . t)
- (:font-lock-skip . t)
- (:alias . (headline heading outline inlinetask plain-list)))
- (org-fold-block
- (:ellipsis . ,ellipsis)
- (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe)
- (:isearch-open . t)
- (:front-sticky . t)
- (:alias . ( block center-block comment-block
- dynamic-block example-block export-block
- quote-block special-block src-block
- verse-block)))
- (org-fold-drawer
- (:ellipsis . ,ellipsis)
- (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe)
- (:isearch-open . t)
- (:front-sticky . t)
- (:alias . (drawer property-drawer)))
- ,org-link--description-folding-spec
- ,org-link--link-folding-spec)))
+ (org-fold-core-initialize
+ `((org-fold-outline
+ (:ellipsis . ,ellipsis)
+ (:fragile . ,#'org-fold--reveal-outline-maybe)
+ (:isearch-open . t)
+ ;; This is needed to make sure that inserting a
+ ;; new planning line in folded heading is not
+ ;; revealed.
+ (:front-sticky . t)
+ (:rear-sticky . t)
+ (:font-lock-skip . t)
+ (:alias . (headline heading outline inlinetask plain-list)))
+ (org-fold-block
+ (:ellipsis . ,ellipsis)
+ (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe)
+ (:isearch-open . t)
+ (:front-sticky . t)
+ (:alias . ( block center-block comment-block
+ dynamic-block example-block export-block
+ quote-block special-block src-block
+ verse-block)))
+ (org-fold-drawer
+ (:ellipsis . ,ellipsis)
+ (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe)
+ (:isearch-open . t)
+ (:front-sticky . t)
+ (:alias . (drawer property-drawer)))
+ ,org-link--description-folding-spec
+ ,org-link--link-folding-spec)))
;;;; Searching and examining folded text
@@ -461,10 +462,11 @@ (defun org-fold-hide-entry ()
(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
- 'outline)))
+ (org-fold-region
+ (line-end-position)
+ (progn (org-end-of-subtree t) (point))
+ flag
+ 'outline)))
;; Replaces `outline-hide-subtree'.
(defun org-fold-hide-subtree ()
@@ -940,18 +942,19 @@ (defun org-fold--reveal-outline-maybe (region _)
(beginning-of-line)
;; Make sure that headline is not partially hidden
(unless (org-fold-folded-p nil 'headline)
- (org-fold-region (max (point-min) (1- (point)))
- (let ((endl (line-end-position)))
- (save-excursion
- (goto-char endl)
- (skip-chars-forward "\n\t\r ")
- ;; Unfold blank lines.
- (if (or (and (looking-at-p "\\*")
- (> (point) (1+ endl)))
- (eq (point) (point-max)))
- (point)
- endl)))
- nil 'headline))
+ (org-fold-region
+ (max (point-min) (1- (point)))
+ (let ((endl (line-end-position)))
+ (save-excursion
+ (goto-char endl)
+ (skip-chars-forward "\n\t\r ")
+ ;; Unfold blank lines.
+ (if (or (and (looking-at-p "\\*")
+ (> (point) (1+ endl)))
+ (eq (point) (point-max)))
+ (point)
+ endl)))
+ nil 'headline))
;; Never hide level 1 headlines
(save-excursion
(goto-char (line-end-position))
diff --git a/lisp/org-id.el b/lisp/org-id.el
index 0331b7c1d..42b165681 100644
--- a/lisp/org-id.el
+++ b/lisp/org-id.el
@@ -525,30 +525,30 @@ (defun org-id-update-id-locations (&optional files silent)
(i 0))
(with-temp-buffer
(org-element-with-disabled-cache
- (delay-mode-hooks
- (org-mode)
- (dolist (file files)
- (when (file-exists-p file)
- (unless silent
- (cl-incf i)
- (message "Finding ID locations (%d/%d files): %s" i nfiles file))
- (insert-file-contents file nil nil nil 'replace)
- (let ((ids nil)
- (case-fold-search t))
- (org-with-point-at 1
- (while (re-search-forward id-regexp nil t)
- (when (org-at-property-p)
- (push (org-entry-get (point) "ID") ids)))
- (when ids
- (push (cons (abbreviate-file-name file) ids)
- org-id-locations)
- (dolist (id ids)
- (cond
- ((not (member id seen-ids)) (push id seen-ids))
- (silent nil)
- (t
- (message "Duplicate ID %S" id)
- (cl-incf ndup))))))))))))
+ (delay-mode-hooks
+ (org-mode)
+ (dolist (file files)
+ (when (file-exists-p file)
+ (unless silent
+ (cl-incf i)
+ (message "Finding ID locations (%d/%d files): %s" i nfiles file))
+ (insert-file-contents file nil nil nil 'replace)
+ (let ((ids nil)
+ (case-fold-search t))
+ (org-with-point-at 1
+ (while (re-search-forward id-regexp nil t)
+ (when (org-at-property-p)
+ (push (org-entry-get (point) "ID") ids)))
+ (when ids
+ (push (cons (abbreviate-file-name file) ids)
+ org-id-locations)
+ (dolist (id ids)
+ (cond
+ ((not (member id seen-ids)) (push id seen-ids))
+ (silent nil)
+ (t
+ (message "Duplicate ID %S" id)
+ (cl-incf ndup))))))))))))
(setq org-id-files (mapcar #'car org-id-locations))
(org-id-locations-save)
;; Now convert to a hash table.
diff --git a/lisp/org-list.el b/lisp/org-list.el
index f72151460..515763036 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -1092,51 +1092,51 @@ (defun org-list-swap-items--text-properties (beg-A beg-B struct)
This function modifies STRUCT."
(save-excursion
(org-fold-core-ignore-modifications
- (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct))
- (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct))
- (end-A (org-list-get-item-end beg-A struct))
- (end-B (org-list-get-item-end beg-B struct))
- (size-A (- end-A-no-blank beg-A))
- (size-B (- end-B-no-blank beg-B))
- (body-A (buffer-substring beg-A end-A-no-blank))
- (body-B (buffer-substring beg-B end-B-no-blank))
- (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))
- (sub-A (cons beg-A (org-list-get-subtree beg-A struct)))
- (sub-B (cons beg-B (org-list-get-subtree beg-B struct))))
- ;; 1. Move effectively items in buffer.
- (goto-char beg-A)
- (delete-region beg-A end-B-no-blank)
- (insert (concat body-B between-A-no-blank-and-B body-A))
- ;; 2. Now modify struct. No need to re-read the list, the
- ;; transformation is just a shift of positions. Some special
- ;; attention is required for items ending at END-A and END-B
- ;; as empty spaces are not moved there. In others words,
- ;; item BEG-A will end with whitespaces that were at the end
- ;; of BEG-B and the same applies to BEG-B.
- (dolist (e struct)
- (let ((pos (car e)))
- (cond
- ((< pos beg-A))
- ((memq pos sub-A)
- (let ((end-e (nth 6 e)))
- (setcar e (+ pos (- end-B-no-blank end-A-no-blank)))
- (setcar (nthcdr 6 e)
- (+ end-e (- end-B-no-blank end-A-no-blank)))
- (when (= end-e end-A) (setcar (nthcdr 6 e) end-B))))
- ((memq pos sub-B)
- (let ((end-e (nth 6 e)))
- (setcar e (- (+ pos beg-A) beg-B))
- (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B)))
- (when (= end-e end-B)
- (setcar (nthcdr 6 e)
- (+ beg-A size-B (- end-A end-A-no-blank))))))
- ((< pos beg-B)
- (let ((end-e (nth 6 e)))
- (setcar e (+ pos (- size-B size-A)))
- (setcar (nthcdr 6 e) (+ end-e (- size-B size-A))))))))
- (setq struct (sort struct #'car-less-than-car))
- ;; Return structure.
- struct))))
+ (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct))
+ (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct))
+ (end-A (org-list-get-item-end beg-A struct))
+ (end-B (org-list-get-item-end beg-B struct))
+ (size-A (- end-A-no-blank beg-A))
+ (size-B (- end-B-no-blank beg-B))
+ (body-A (buffer-substring beg-A end-A-no-blank))
+ (body-B (buffer-substring beg-B end-B-no-blank))
+ (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))
+ (sub-A (cons beg-A (org-list-get-subtree beg-A struct)))
+ (sub-B (cons beg-B (org-list-get-subtree beg-B struct))))
+ ;; 1. Move effectively items in buffer.
+ (goto-char beg-A)
+ (delete-region beg-A end-B-no-blank)
+ (insert (concat body-B between-A-no-blank-and-B body-A))
+ ;; 2. Now modify struct. No need to re-read the list, the
+ ;; transformation is just a shift of positions. Some special
+ ;; attention is required for items ending at END-A and END-B
+ ;; as empty spaces are not moved there. In others words,
+ ;; item BEG-A will end with whitespaces that were at the end
+ ;; of BEG-B and the same applies to BEG-B.
+ (dolist (e struct)
+ (let ((pos (car e)))
+ (cond
+ ((< pos beg-A))
+ ((memq pos sub-A)
+ (let ((end-e (nth 6 e)))
+ (setcar e (+ pos (- end-B-no-blank end-A-no-blank)))
+ (setcar (nthcdr 6 e)
+ (+ end-e (- end-B-no-blank end-A-no-blank)))
+ (when (= end-e end-A) (setcar (nthcdr 6 e) end-B))))
+ ((memq pos sub-B)
+ (let ((end-e (nth 6 e)))
+ (setcar e (- (+ pos beg-A) beg-B))
+ (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B)))
+ (when (= end-e end-B)
+ (setcar (nthcdr 6 e)
+ (+ beg-A size-B (- end-A end-A-no-blank))))))
+ ((< pos beg-B)
+ (let ((end-e (nth 6 e)))
+ (setcar e (+ pos (- size-B size-A)))
+ (setcar (nthcdr 6 e) (+ end-e (- size-B size-A))))))))
+ (setq struct (sort struct #'car-less-than-car))
+ ;; Return structure.
+ struct))))
(defun org-list-swap-items--overlays (beg-A beg-B struct)
"Swap item starting at BEG-A with item starting at BEG-B in STRUCT.
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index 8535bf2cd..10eed2686 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -181,7 +181,7 @@ (defmacro org-no-popups (&rest body)
(defmacro org-element-with-disabled-cache (&rest body)
"Run BODY without active org-element-cache."
- (declare (debug (form body)) (indent 1))
+ (declare (debug (form body)) (indent 0))
`(cl-letf (((symbol-function #'org-element--cache-active-p) (lambda (&rest _) nil)))
,@body))
diff --git a/lisp/org.el b/lisp/org.el
index 1d5fc3903..5601bcee8 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -6445,7 +6445,7 @@ (defun org-demote ()
(down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
(diff (abs (- level (length down-head) -1))))
(org-fold-core-ignore-fragility-checks
- (replace-match (apply #'propertize down-head (text-properties-at (match-beginning 0))) t)
+ (replace-match (apply #'propertize down-head (text-properties-at (match-beginning 0))) t)
(when org-auto-align-tags (org-align-tags))
(when org-adapt-indentation (org-fixup-indentation diff)))
(run-hooks 'org-after-demote-entry-hook))))
@@ -6859,81 +6859,81 @@ (defun org-paste-subtree (&optional level tree for-yank remove)
"The kill is not a (set of) tree(s). Use `\\[yank]' to yank anyway")))
(org-with-limited-levels
(org-fold-core-ignore-fragility-checks
- (let* ((visp (not (org-invisible-p)))
- (txt tree)
- (old-level (if (string-match org-outline-regexp-bol txt)
- (- (match-end 0) (match-beginning 0) 1)
- -1))
- (force-level
- (cond
- (level (prefix-numeric-value level))
- ;; When point is after the stars in an otherwise empty
- ;; headline, use the number of stars as the forced level.
- ((and (org-match-line "^\\*+[ \t]*$")
- (not (eq ?* (char-after))))
- (org-outline-level))
- ((looking-at-p org-outline-regexp-bol) (org-outline-level))))
- (previous-level
- (save-excursion
- (org-previous-visible-heading 1)
- (if (org-at-heading-p) (org-outline-level) 1)))
- (next-level
- (save-excursion
- (if (org-at-heading-p) (org-outline-level)
- (org-next-visible-heading 1)
- (if (org-at-heading-p) (org-outline-level) 1))))
- (new-level (or force-level (max previous-level next-level)))
- (shift (if (or (= old-level -1)
- (= new-level -1)
- (= old-level new-level))
- 0
- (- new-level old-level)))
- (delta (if (> shift 0) -1 1))
- (func (if (> shift 0) #'org-demote #'org-promote))
- (org-odd-levels-only nil)
- beg end newend)
- ;; Remove the forced level indicator.
- (when (and force-level (not level))
- (delete-region (line-beginning-position) (point)))
- ;; Paste before the next visible heading or at end of buffer,
- ;; unless point is at the beginning of a headline.
- (unless (and (bolp) (org-at-heading-p))
- (org-next-visible-heading 1)
- (unless (bolp) (insert "\n")))
+ (let* ((visp (not (org-invisible-p)))
+ (txt tree)
+ (old-level (if (string-match org-outline-regexp-bol txt)
+ (- (match-end 0) (match-beginning 0) 1)
+ -1))
+ (force-level
+ (cond
+ (level (prefix-numeric-value level))
+ ;; When point is after the stars in an otherwise empty
+ ;; headline, use the number of stars as the forced level.
+ ((and (org-match-line "^\\*+[ \t]*$")
+ (not (eq ?* (char-after))))
+ (org-outline-level))
+ ((looking-at-p org-outline-regexp-bol) (org-outline-level))))
+ (previous-level
+ (save-excursion
+ (org-previous-visible-heading 1)
+ (if (org-at-heading-p) (org-outline-level) 1)))
+ (next-level
+ (save-excursion
+ (if (org-at-heading-p) (org-outline-level)
+ (org-next-visible-heading 1)
+ (if (org-at-heading-p) (org-outline-level) 1))))
+ (new-level (or force-level (max previous-level next-level)))
+ (shift (if (or (= old-level -1)
+ (= new-level -1)
+ (= old-level new-level))
+ 0
+ (- new-level old-level)))
+ (delta (if (> shift 0) -1 1))
+ (func (if (> shift 0) #'org-demote #'org-promote))
+ (org-odd-levels-only nil)
+ beg end newend)
+ ;; Remove the forced level indicator.
+ (when (and force-level (not level))
+ (delete-region (line-beginning-position) (point)))
+ ;; Paste before the next visible heading or at end of buffer,
+ ;; unless point is at the beginning of a headline.
+ (unless (and (bolp) (org-at-heading-p))
+ (org-next-visible-heading 1)
+ (unless (bolp) (insert "\n")))
+ (setq beg (point))
+ ;; Avoid re-parsing cache elements when i.e. level 1 heading
+ ;; is inserted and then promoted.
+ (combine-change-calls beg beg
+ (when (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
+ (insert-before-markers txt)
+ (unless (string-suffix-p "\n" txt) (insert "\n"))
+ (setq newend (point))
+ (org-reinstall-markers-in-region beg)
+ (setq end (point))
+ (goto-char beg)
+ (skip-chars-forward " \t\n\r")
(setq beg (point))
- ;; Avoid re-parsing cache elements when i.e. level 1 heading
- ;; is inserted and then promoted.
- (combine-change-calls beg beg
- (when (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
- (insert-before-markers txt)
- (unless (string-suffix-p "\n" txt) (insert "\n"))
- (setq newend (point))
- (org-reinstall-markers-in-region beg)
- (setq end (point))
- (goto-char beg)
- (skip-chars-forward " \t\n\r")
- (setq beg (point))
- (when (and (org-invisible-p) visp)
- (save-excursion (org-fold-heading nil)))
- ;; Shift if necessary.
- (unless (= shift 0)
- (save-restriction
- (narrow-to-region beg end)
- (while (not (= shift 0))
- (org-map-region func (point-min) (point-max))
- (setq shift (+ delta shift)))
- (goto-char (point-min))
- (setq newend (point-max)))))
- (when (or for-yank (called-interactively-p 'interactive))
- (message "Clipboard pasted as level %d subtree" new-level))
- (when (and (not for-yank) ; in this case, org-yank will decide about folding
- kill-ring
- (equal org-subtree-clip (current-kill 0))
- org-subtree-clip-folded)
- ;; The tree was folded before it was killed/copied
- (org-fold-subtree t))
- (when for-yank (goto-char newend))
- (when remove (pop kill-ring))))))
+ (when (and (org-invisible-p) visp)
+ (save-excursion (org-fold-heading nil)))
+ ;; Shift if necessary.
+ (unless (= shift 0)
+ (save-restriction
+ (narrow-to-region beg end)
+ (while (not (= shift 0))
+ (org-map-region func (point-min) (point-max))
+ (setq shift (+ delta shift)))
+ (goto-char (point-min))
+ (setq newend (point-max)))))
+ (when (or for-yank (called-interactively-p 'interactive))
+ (message "Clipboard pasted as level %d subtree" new-level))
+ (when (and (not for-yank) ; in this case, org-yank will decide about folding
+ kill-ring
+ (equal org-subtree-clip (current-kill 0))
+ org-subtree-clip-folded)
+ ;; The tree was folded before it was killed/copied
+ (org-fold-subtree t))
+ (when for-yank (goto-char newend))
+ (when remove (pop kill-ring))))))
(defun org-kill-is-subtree-p (&optional txt)
"Check if the current kill is an outline subtree, or a set of trees.
@@ -8905,16 +8905,16 @@ (defun org-todo (&optional arg)
((eq arg 'right)
;; Next state
(if this
- (if tail (car tail) nil)
- (car org-todo-keywords-1)))
+ (if tail (car tail) nil)
+ (car org-todo-keywords-1)))
((eq arg 'left)
;; Previous state
(unless (equal member org-todo-keywords-1)
- (if this
+ (if this
(nth (- (length org-todo-keywords-1)
(length tail) 2)
- org-todo-keywords-1)
- (org-last org-todo-keywords-1))))
+ org-todo-keywords-1)
+ (org-last org-todo-keywords-1))))
(arg
;; User or caller requests a specific state.
(cond
@@ -8922,15 +8922,15 @@ (defun org-todo (&optional arg)
((eq arg 'none) nil)
((eq arg 'done) (or done-word (car org-done-keywords)))
((eq arg 'nextset)
- (or (car (cdr (member head org-todo-heads)))
+ (or (car (cdr (member head org-todo-heads)))
(car org-todo-heads)))
((eq arg 'previousset)
- (let ((org-todo-heads (reverse org-todo-heads)))
- (or (car (cdr (member head org-todo-heads)))
+ (let ((org-todo-heads (reverse org-todo-heads)))
+ (or (car (cdr (member head org-todo-heads)))
(car org-todo-heads))))
((car (member arg org-todo-keywords-1)))
((stringp arg)
- (user-error "State `%s' not valid in this file" arg))
+ (user-error "State `%s' not valid in this file" arg))
((nth (1- (prefix-numeric-value arg))
org-todo-keywords-1))))
((and org-todo-key-trigger org-use-fast-todo-selection)
@@ -8941,10 +8941,10 @@ (defun org-todo (&optional arg)
((null tail) nil) ;-> first entry
((memq interpret '(type priority))
(if (eq this-command last-command)
- (car tail)
- (if (> (length tail) 0)
+ (car tail)
+ (if (> (length tail) 0)
(or done-word (car org-done-keywords))
- nil)))
+ nil)))
(t
(car tail))))
(org-state (or
@@ -8976,7 +8976,7 @@ (defun org-todo (&optional arg)
(throw 'exit nil)))))
(store-match-data match-data)
(org-fold-core-ignore-modifications
- (goto-char (match-beginning 0))
+ (goto-char (match-beginning 0))
(replace-match "")
;; We need to use `insert-before-markers-and-inherit'
;; because: (1) We want to preserve the folding state
@@ -8987,8 +8987,8 @@ (defun org-todo (&optional arg)
(insert-before-markers-and-inherit next)
(unless (org-invisible-p (line-beginning-position))
(org-fold-region (line-beginning-position)
- (line-end-position)
- nil)))
+ (line-end-position)
+ nil)))
(cond ((and org-state (equal this org-state))
(message "TODO state was already %s" (org-trim next)))
((not (pos-visible-in-window-p hl-pos))
@@ -9730,81 +9730,81 @@ (defun org--deadline-or-schedule (arg type time)
TYPE is either `deadline' or `scheduled'. See `org-deadline' or
`org-schedule' for information about ARG and TIME arguments."
(org-fold-core-ignore-modifications
- (let* ((deadline? (eq type 'deadline))
- (keyword (if deadline? org-deadline-string org-scheduled-string))
- (log (if deadline? org-log-redeadline org-log-reschedule))
- (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED")))
- (old-date-time (and old-date (org-time-string-to-time old-date)))
- ;; Save repeater cookie from either TIME or current scheduled
- ;; time stamp. We are going to insert it back at the end of
- ;; the process.
- (repeater (or (and (org-string-nw-p time)
- ;; We use `org-repeat-re' because we need
- ;; to tell the difference between a real
- ;; repeater and a time delta, e.g. "+2d".
- (string-match org-repeat-re time)
- (match-string 1 time))
- (and (org-string-nw-p old-date)
- (string-match "\\([.+-]+[0-9]+[hdwmy]\
+ (let* ((deadline? (eq type 'deadline))
+ (keyword (if deadline? org-deadline-string org-scheduled-string))
+ (log (if deadline? org-log-redeadline org-log-reschedule))
+ (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED")))
+ (old-date-time (and old-date (org-time-string-to-time old-date)))
+ ;; Save repeater cookie from either TIME or current scheduled
+ ;; time stamp. We are going to insert it back at the end of
+ ;; the process.
+ (repeater (or (and (org-string-nw-p time)
+ ;; We use `org-repeat-re' because we need
+ ;; to tell the difference between a real
+ ;; repeater and a time delta, e.g. "+2d".
+ (string-match org-repeat-re time)
+ (match-string 1 time))
+ (and (org-string-nw-p old-date)
+ (string-match "\\([.+-]+[0-9]+[hdwmy]\
\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\)"
- old-date)
- (match-string 1 old-date)))))
- (pcase arg
- (`(4)
- (if (not old-date)
- (message (if deadline? "Entry had no deadline to remove"
- "Entry was not scheduled"))
- (when (and old-date log)
- (org-add-log-setup (if deadline? 'deldeadline 'delschedule)
- nil old-date log))
- (org-remove-timestamp-with-keyword keyword)
- (message (if deadline? "Entry no longer has a deadline."
- "Entry is no longer scheduled."))))
- (`(16)
- (save-excursion
+ old-date)
+ (match-string 1 old-date)))))
+ (pcase arg
+ (`(4)
+ (if (not old-date)
+ (message (if deadline? "Entry had no deadline to remove"
+ "Entry was not scheduled"))
+ (when (and old-date log)
+ (org-add-log-setup (if deadline? 'deldeadline 'delschedule)
+ nil old-date log))
+ (org-remove-timestamp-with-keyword keyword)
+ (message (if deadline? "Entry no longer has a deadline."
+ "Entry is no longer scheduled."))))
+ (`(16)
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((regexp (if deadline? org-deadline-time-regexp
+ org-scheduled-time-regexp)))
+ (if (not (re-search-forward regexp (line-end-position 2) t))
+ (user-error (if deadline? "No deadline information to update"
+ "No scheduled information to update"))
+ (let* ((rpl0 (match-string 1))
+ (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))
+ (msg (if deadline? "Warn starting from" "Delay until")))
+ (replace-match
+ (concat keyword
+ " <" rpl
+ (format " -%dd"
+ (abs (- (time-to-days
+ (save-match-data
+ (org-read-date
+ nil t nil msg old-date-time)))
+ (time-to-days old-date-time))))
+ ">") t t))))))
+ (_
+ (org-add-planning-info type time 'closed)
+ (when (and old-date
+ log
+ (not (equal old-date org-last-inserted-timestamp)))
+ (org-add-log-setup (if deadline? 'redeadline 'reschedule)
+ org-last-inserted-timestamp
+ old-date
+ log))
+ (when repeater
+ (save-excursion
(org-back-to-heading t)
- (let ((regexp (if deadline? org-deadline-time-regexp
- org-scheduled-time-regexp)))
- (if (not (re-search-forward regexp (line-end-position 2) t))
- (user-error (if deadline? "No deadline information to update"
- "No scheduled information to update"))
- (let* ((rpl0 (match-string 1))
- (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))
- (msg (if deadline? "Warn starting from" "Delay until")))
- (replace-match
- (concat keyword
- " <" rpl
- (format " -%dd"
- (abs (- (time-to-days
- (save-match-data
- (org-read-date
- nil t nil msg old-date-time)))
- (time-to-days old-date-time))))
- ">") t t))))))
- (_
- (org-add-planning-info type time 'closed)
- (when (and old-date
- log
- (not (equal old-date org-last-inserted-timestamp)))
- (org-add-log-setup (if deadline? 'redeadline 'reschedule)
- org-last-inserted-timestamp
- old-date
- log))
- (when repeater
- (save-excursion
- (org-back-to-heading t)
- (when (re-search-forward
- (concat keyword " " org-last-inserted-timestamp)
- (line-end-position 2)
- t)
- (goto-char (1- (match-end 0)))
- (insert-and-inherit " " repeater)
- (setq org-last-inserted-timestamp
- (concat (substring org-last-inserted-timestamp 0 -1)
- " " repeater
- (substring org-last-inserted-timestamp -1))))))
- (message (if deadline? "Deadline on %s" "Scheduled to %s")
- org-last-inserted-timestamp))))))
+ (when (re-search-forward
+ (concat keyword " " org-last-inserted-timestamp)
+ (line-end-position 2)
+ t)
+ (goto-char (1- (match-end 0)))
+ (insert-and-inherit " " repeater)
+ (setq org-last-inserted-timestamp
+ (concat (substring org-last-inserted-timestamp 0 -1)
+ " " repeater
+ (substring org-last-inserted-timestamp -1))))))
+ (message (if deadline? "Deadline on %s" "Scheduled to %s")
+ org-last-inserted-timestamp))))))
(defun org-deadline (arg &optional time)
"Insert a \"DEADLINE:\" string with a timestamp to make a deadline.
@@ -9910,101 +9910,101 @@ (defun org-add-planning-info (what &optional time &rest remove)
a date. REMOVE indicates what kind of entries to remove. An old
WHAT entry will also be removed."
(org-fold-core-ignore-modifications
- (let (org-time-was-given org-end-time-was-given default-time default-input)
- (when (and (memq what '(scheduled deadline))
- (or (not time)
- (and (stringp time)
- (string-match "^[-+]+[0-9]" time))))
- ;; Try to get a default date/time from existing timestamp
- (save-excursion
- (org-back-to-heading t)
- (let ((end (save-excursion (outline-next-heading) (point))) ts)
- (when (re-search-forward (if (eq what 'scheduled)
- org-scheduled-time-regexp
- org-deadline-time-regexp)
- end t)
- (setq ts (match-string 1)
- default-time (org-time-string-to-time ts)
- default-input (and ts (org-get-compact-tod ts)))))))
- (when what
- (setq time
- (if (stringp time)
- ;; This is a string (relative or absolute), set
- ;; proper date.
- (apply #'encode-time
- (org-read-date-analyze
- time default-time (decode-time default-time)))
- ;; If necessary, get the time from the user
- (or time (org-read-date nil 'to-time nil
- (cl-case what
- (deadline "DEADLINE")
- (scheduled "SCHEDULED")
- (otherwise nil))
- default-time default-input)))))
- (org-with-wide-buffer
- (org-back-to-heading t)
- (let ((planning? (save-excursion
- (forward-line)
- (looking-at-p org-planning-line-re))))
- (cond
- (planning?
- (forward-line)
- ;; Move to current indentation.
- (skip-chars-forward " \t")
- ;; Check if we have to remove something.
- (dolist (type (if what (cons what remove) remove))
+ (let (org-time-was-given org-end-time-was-given default-time default-input)
+ (when (and (memq what '(scheduled deadline))
+ (or (not time)
+ (and (stringp time)
+ (string-match "^[-+]+[0-9]" time))))
+ ;; Try to get a default date/time from existing timestamp
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((end (save-excursion (outline-next-heading) (point))) ts)
+ (when (re-search-forward (if (eq what 'scheduled)
+ org-scheduled-time-regexp
+ org-deadline-time-regexp)
+ end t)
+ (setq ts (match-string 1)
+ default-time (org-time-string-to-time ts)
+ default-input (and ts (org-get-compact-tod ts)))))))
+ (when what
+ (setq time
+ (if (stringp time)
+ ;; This is a string (relative or absolute), set
+ ;; proper date.
+ (apply #'encode-time
+ (org-read-date-analyze
+ time default-time (decode-time default-time)))
+ ;; If necessary, get the time from the user
+ (or time (org-read-date nil 'to-time nil
+ (cl-case what
+ (deadline "DEADLINE")
+ (scheduled "SCHEDULED")
+ (otherwise nil))
+ default-time default-input)))))
+ (org-with-wide-buffer
+ (org-back-to-heading t)
+ (let ((planning? (save-excursion
+ (forward-line)
+ (looking-at-p org-planning-line-re))))
+ (cond
+ (planning?
+ (forward-line)
+ ;; Move to current indentation.
+ (skip-chars-forward " \t")
+ ;; Check if we have to remove something.
+ (dolist (type (if what (cons what remove) remove))
+ (save-excursion
+ (when (re-search-forward
+ (cl-case type
+ (closed org-closed-time-regexp)
+ (deadline org-deadline-time-regexp)
+ (scheduled org-scheduled-time-regexp)
+ (otherwise (error "Invalid planning type: %s" type)))
+ (line-end-position)
+ t)
+ ;; Delete until next keyword or end of line.
+ (delete-region
+ (match-beginning 0)
+ (if (re-search-forward org-keyword-time-not-clock-regexp
+ (line-end-position)
+ t)
+ (match-beginning 0)
+ (line-end-position))))))
+ ;; If there is nothing more to add and no more keyword is
+ ;; left, remove the line completely.
+ (if (and (looking-at-p "[ \t]*$") (not what))
+ (delete-region (line-end-position 0)
+ (line-end-position))
+ ;; If we removed last keyword, do not leave trailing white
+ ;; space at the end of line.
+ (let ((p (point)))
(save-excursion
- (when (re-search-forward
- (cl-case type
- (closed org-closed-time-regexp)
- (deadline org-deadline-time-regexp)
- (scheduled org-scheduled-time-regexp)
- (otherwise (error "Invalid planning type: %s" type)))
- (line-end-position)
- t)
- ;; Delete until next keyword or end of line.
- (delete-region
- (match-beginning 0)
- (if (re-search-forward org-keyword-time-not-clock-regexp
- (line-end-position)
- t)
- (match-beginning 0)
- (line-end-position))))))
- ;; If there is nothing more to add and no more keyword is
- ;; left, remove the line completely.
- (if (and (looking-at-p "[ \t]*$") (not what))
- (delete-region (line-end-position 0)
- (line-end-position))
- ;; If we removed last keyword, do not leave trailing white
- ;; space at the end of line.
- (let ((p (point)))
- (save-excursion
- (end-of-line)
- (unless (= (skip-chars-backward " \t" p) 0)
- (delete-region (point) (line-end-position)))))))
- (what
- (end-of-line)
- (insert-and-inherit "\n")
- (when org-adapt-indentation
- (indent-to-column (1+ (org-outline-level)))))
- (t nil)))
- (when what
- ;; Insert planning keyword.
- (insert-and-inherit (cl-case what
- (closed org-closed-string)
- (deadline org-deadline-string)
- (scheduled org-scheduled-string)
- (otherwise (error "Invalid planning type: %s" what)))
- " ")
- ;; Insert associated timestamp.
- (let ((ts (org-insert-time-stamp
- time
- (or org-time-was-given
- (and (eq what 'closed) org-log-done-with-time))
- (eq what 'closed)
- nil nil (list org-end-time-was-given))))
- (unless (eolp) (insert " "))
- ts))))))
+ (end-of-line)
+ (unless (= (skip-chars-backward " \t" p) 0)
+ (delete-region (point) (line-end-position)))))))
+ (what
+ (end-of-line)
+ (insert-and-inherit "\n")
+ (when org-adapt-indentation
+ (indent-to-column (1+ (org-outline-level)))))
+ (t nil)))
+ (when what
+ ;; Insert planning keyword.
+ (insert-and-inherit (cl-case what
+ (closed org-closed-string)
+ (deadline org-deadline-string)
+ (scheduled org-scheduled-string)
+ (otherwise (error "Invalid planning type: %s" what)))
+ " ")
+ ;; Insert associated timestamp.
+ (let ((ts (org-insert-time-stamp
+ time
+ (or org-time-was-given
+ (and (eq what 'closed) org-log-done-with-time))
+ (eq what 'closed)
+ nil nil (list org-end-time-was-given))))
+ (unless (eolp) (insert " "))
+ ts))))))
(defvar org-log-note-marker (make-marker)
"Marker pointing at the entry where the note is to be inserted.")
@@ -10061,7 +10061,7 @@ (defun org-log-beginning (&optional create)
;; continuity.
(when (org-at-heading-p) (backward-char))
(org-fold-core-ignore-modifications
- (unless (bolp) (insert-and-inherit "\n"))
+ (unless (bolp) (insert-and-inherit "\n"))
(let ((beg (point)))
(insert-and-inherit ":" drawer ":\n:END:\n")
(org-indent-region beg (point))
@@ -10201,34 +10201,34 @@ (defun org-store-log-note ()
(when (and lines (not org-note-abort))
(with-current-buffer (marker-buffer org-log-note-marker)
(org-fold-core-ignore-modifications
- (org-with-wide-buffer
- ;; Find location for the new note.
- (goto-char org-log-note-marker)
- (set-marker org-log-note-marker nil)
- ;; Note associated to a clock is to be located right after
- ;; the clock. Do not move point.
- (unless (eq org-log-note-purpose 'clock-out)
- (goto-char (org-log-beginning t)))
- ;; Make sure point is at the beginning of an empty line.
- (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert-and-inherit "\n")))
- ((looking-at "[ \t]*\\S-") (save-excursion (insert-and-inherit "\n"))))
- ;; In an existing list, add a new item at the top level.
- ;; Otherwise, indent line like a regular one.
- (let ((itemp (org-in-item-p)))
- (if itemp
- (indent-line-to
- (let ((struct (save-excursion
- (goto-char itemp) (org-list-struct))))
- (org-list-get-ind (org-list-get-top-point struct) struct)))
- (org-indent-line)))
- (insert-and-inherit (org-list-bullet-string "-") (pop lines))
- (let ((ind (org-list-item-body-column (line-beginning-position))))
- (dolist (line lines)
- (insert-and-inherit "\n")
- (indent-line-to ind)
- (insert-and-inherit line)))
- (message "Note stored")
- (org-back-to-heading t))))))
+ (org-with-wide-buffer
+ ;; Find location for the new note.
+ (goto-char org-log-note-marker)
+ (set-marker org-log-note-marker nil)
+ ;; Note associated to a clock is to be located right after
+ ;; the clock. Do not move point.
+ (unless (eq org-log-note-purpose 'clock-out)
+ (goto-char (org-log-beginning t)))
+ ;; Make sure point is at the beginning of an empty line.
+ (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert-and-inherit "\n")))
+ ((looking-at "[ \t]*\\S-") (save-excursion (insert-and-inherit "\n"))))
+ ;; In an existing list, add a new item at the top level.
+ ;; Otherwise, indent line like a regular one.
+ (let ((itemp (org-in-item-p)))
+ (if itemp
+ (indent-line-to
+ (let ((struct (save-excursion
+ (goto-char itemp) (org-list-struct))))
+ (org-list-get-ind (org-list-get-top-point struct) struct)))
+ (org-indent-line)))
+ (insert-and-inherit (org-list-bullet-string "-") (pop lines))
+ (let ((ind (org-list-item-body-column (line-beginning-position))))
+ (dolist (line lines)
+ (insert-and-inherit "\n")
+ (indent-line-to ind)
+ (insert-and-inherit line)))
+ (message "Note stored")
+ (org-back-to-heading t))))))
;; Don't add undo information when called from `org-agenda-todo'.
(set-window-configuration org-log-note-window-configuration)
(with-current-buffer (marker-buffer org-log-note-return-to)
@@ -11360,34 +11360,34 @@ (defun org-set-tags (tags)
This function assumes point is on a headline."
(org-with-wide-buffer
(org-fold-core-ignore-modifications
- (let ((tags (pcase tags
- ((pred listp) tags)
- ((pred stringp) (split-string (org-trim tags) ":" t))
- (_ (error "Invalid tag specification: %S" tags))))
- (old-tags (org-get-tags nil t))
- (tags-change? nil))
- (when (functionp org-tags-sort-function)
- (setq tags (sort tags org-tags-sort-function)))
- (setq tags-change? (not (equal tags old-tags)))
- (when tags-change?
- ;; Delete previous tags and any trailing white space.
- (goto-char (if (org-match-line org-tag-line-re) (match-beginning 1)
- (line-end-position)))
- (skip-chars-backward " \t")
- (delete-region (point) (line-end-position))
- ;; Deleting white spaces may break an otherwise empty headline.
- ;; Re-introduce one space in this case.
- (unless (org-at-heading-p) (insert " "))
- (when tags
- (save-excursion (insert-and-inherit " " (org-make-tag-string tags)))
- ;; When text is being inserted on an invisible region
- ;; boundary, it can be inadvertently sucked into
- ;; invisibility.
- (unless (org-invisible-p (line-beginning-position))
- (org-fold-region (point) (line-end-position) nil 'outline))))
- ;; Align tags, if any.
- (when tags (org-align-tags))
- (when tags-change? (run-hooks 'org-after-tags-change-hook))))))
+ (let ((tags (pcase tags
+ ((pred listp) tags)
+ ((pred stringp) (split-string (org-trim tags) ":" t))
+ (_ (error "Invalid tag specification: %S" tags))))
+ (old-tags (org-get-tags nil t))
+ (tags-change? nil))
+ (when (functionp org-tags-sort-function)
+ (setq tags (sort tags org-tags-sort-function)))
+ (setq tags-change? (not (equal tags old-tags)))
+ (when tags-change?
+ ;; Delete previous tags and any trailing white space.
+ (goto-char (if (org-match-line org-tag-line-re) (match-beginning 1)
+ (line-end-position)))
+ (skip-chars-backward " \t")
+ (delete-region (point) (line-end-position))
+ ;; Deleting white spaces may break an otherwise empty headline.
+ ;; Re-introduce one space in this case.
+ (unless (org-at-heading-p) (insert " "))
+ (when tags
+ (save-excursion (insert-and-inherit " " (org-make-tag-string tags)))
+ ;; When text is being inserted on an invisible region
+ ;; boundary, it can be inadvertently sucked into
+ ;; invisibility.
+ (unless (org-invisible-p (line-beginning-position))
+ (org-fold-region (point) (line-end-position) nil 'outline))))
+ ;; Align tags, if any.
+ (when tags (org-align-tags))
+ (when tags-change? (run-hooks 'org-after-tags-change-hook))))))
(defun org-change-tag-in-region (beg end tag off)
"Add or remove TAG for each entry in the region.
@@ -12582,19 +12582,19 @@ (defun org-entry-put (pom property value)
(error "The %s property cannot be set with `org-entry-put'" property))
(t
(org-fold-core-ignore-modifications
- (let* ((range (org-get-property-block beg 'force))
- (end (cdr range))
- (case-fold-search t))
- (goto-char (car range))
- (if (re-search-forward (org-re-property property nil t) end t)
- (progn (delete-region (match-beginning 0) (match-end 0))
- (goto-char (match-beginning 0)))
- (goto-char end)
- (insert-and-inherit "\n")
- (backward-char))
- (insert-and-inherit ":" property ":")
- (when value (insert-and-inherit " " value))
- (org-indent-line))))))
+ (let* ((range (org-get-property-block beg 'force))
+ (end (cdr range))
+ (case-fold-search t))
+ (goto-char (car range))
+ (if (re-search-forward (org-re-property property nil t) end t)
+ (progn (delete-region (match-beginning 0) (match-end 0))
+ (goto-char (match-beginning 0)))
+ (goto-char end)
+ (insert-and-inherit "\n")
+ (backward-char))
+ (insert-and-inherit ":" property ":")
+ (when value (insert-and-inherit " " value))
+ (org-indent-line))))))
(run-hook-with-args 'org-property-changed-functions property value))))
(defun org-buffer-property-keys (&optional specials defaults columns)
@@ -13749,23 +13749,23 @@ (defun org-insert-time-stamp (time &optional with-hm inactive pre post extra)
stamp.
The command returns the inserted time stamp."
(org-fold-core-ignore-modifications
- (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats))
- stamp)
- (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]")))
- (insert-before-markers-and-inherit (or pre ""))
- (when (listp extra)
- (setq extra (car extra))
- (if (and (stringp extra)
- (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra))
- (setq extra (format "-%02d:%02d"
- (string-to-number (match-string 1 extra))
- (string-to-number (match-string 2 extra))))
- (setq extra nil)))
- (when extra
- (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1))))
- (insert-before-markers-and-inherit (setq stamp (format-time-string fmt time)))
- (insert-before-markers-and-inherit (or post ""))
- (setq org-last-inserted-timestamp stamp))))
+ (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats))
+ stamp)
+ (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]")))
+ (insert-before-markers-and-inherit (or pre ""))
+ (when (listp extra)
+ (setq extra (car extra))
+ (if (and (stringp extra)
+ (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra))
+ (setq extra (format "-%02d:%02d"
+ (string-to-number (match-string 1 extra))
+ (string-to-number (match-string 2 extra))))
+ (setq extra nil)))
+ (when extra
+ (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1))))
+ (insert-before-markers-and-inherit (setq stamp (format-time-string fmt time)))
+ (insert-before-markers-and-inherit (or post ""))
+ (setq org-last-inserted-timestamp stamp))))
(defun org-toggle-time-stamp-overlays ()
"Toggle the use of custom time stamp formats."
--
2.35.1
^ permalink raw reply related [relevance 5%]
* [PATCH] Re: How to stop results being hidden when using ":results drawer"?
@ 2022-05-13 13:35 9% ` Ihor Radchenko
0 siblings, 0 replies; 25+ results
From: Ihor Radchenko @ 2022-05-13 13:35 UTC (permalink / raw)
To: John Kitchin; +Cc: Richard Stanton, emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 1071 bytes --]
John Kitchin <jkitchin@andrew.cmu.edu> writes:
> This issue is specific to using a scimax function
> `scimax-ob-execute-and-next-block` that executes the current block then
> moves to the next or creates a new block if needed. This is a UI feature
> from jupyter notebooks that I like to use.
>
> That function uses `(org-babel-next-src-block)`, which uses
> org-next-block, which calls org-show-context, which uses
> org-show-set-visibility, which calls org-show-entry, which hides the
> drawers.
>
> It isn't an org-core issue perhaps, other than it is not obvious why
> org-show-entry has a hard-coded line to hide drawers in it.
I'd say that it is org-core issue. The current behaviour does not really
follow what org-fold-show-entry docstring promises:
>> Show the body directly following its heading.
>> Show the heading too, if it is currently invisible.
In fact, forcefully folding the drawers is relatively recent addition by
Nicolas in 1027e0256903bc2.
I am attaching the patch making drawer folding controllable via optional
argument. WDYT?
Best,
Ihor
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-org-fold-show-entry-Do-not-fold-drawers-unless-reque.patch --]
[-- Type: text/x-patch, Size: 6581 bytes --]
From bd3c7ac6162d64a19eff370b7b22ba233f8480ad Mon Sep 17 00:00:00 2001
Message-Id: <bd3c7ac6162d64a19eff370b7b22ba233f8480ad.1652448909.git.yantar92@gmail.com>
From: Ihor Radchenko <yantar92@gmail.com>
Date: Fri, 13 May 2022 21:30:46 +0800
Subject: [PATCH] org-fold-show-entry: Do not fold drawers unless requested
* lisp/org-fold.el (org-fold-show-entry): Do not fold drawers in the
unfolded entry unless the new optional argument is non-nil. Folding
the drawers was introduced in 1027e0256903bc2, but does not follow the
function docstring. Moreover, folding drawers creates unexpected
behaviour in some cases. See
https://orgmode.org/list/m2a6bl4mmr.fsf@andrew.cmu.edu
* etc/ORG-NEWS (~org-fold-show-entry~ does not fold drawers by default
anymore): Document the change.
* lisp/org-agenda.el (org-agenda-show):
(org-agenda-show-and-scroll-up):
(org-agenda-show-1):
* lisp/org-clock.el (org-clock-goto):
* lisp/org-compat.el (outline-toggle-children):
* lisp/org-timer.el (org-timer--get-timer-title):
* lisp/org.el (org-move-subtree-down):
(org-return): Explicitly request folding drawers inside the revealed
entry in the places where it appears to make sense.
---
etc/ORG-NEWS | 7 +++++++
lisp/org-agenda.el | 6 +++---
lisp/org-clock.el | 2 +-
lisp/org-compat.el | 2 +-
lisp/org-fold.el | 4 ++--
lisp/org-timer.el | 2 +-
lisp/org.el | 4 ++--
7 files changed, 17 insertions(+), 10 deletions(-)
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 582816534..15986c935 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -190,6 +190,13 @@ installed. It uses Emacs' font-lock information, and so tends to
produce results superior to Minted or Listings.
** New functions and changes in function arguments
+*** ~org-fold-show-entry~ does not fold drawers by default anymore
+
+~org-fold-show-entry~ now accepts an optional argument HIDE-DRAWERS.
+When the argument is non-nil, the function folds all the drawers
+inside entry. This was the default previously.
+
+Now, ~org-fold-show-entry~ does not fold drawers by default.
*** New function ~org-element-cache-map~ for quick mapping across Org elements
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 0479a0e1f..6fd0e4498 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -9701,7 +9701,7 @@ (defun org-agenda-show (&optional full-entry)
(interactive "P")
(let ((win (selected-window)))
(org-agenda-goto t)
- (when full-entry (org-fold-show-entry))
+ (when full-entry (org-fold-show-entry 'hide-drawers))
(select-window win)))
(defvar org-agenda-show-window nil)
@@ -9720,7 +9720,7 @@ (defun org-agenda-show-and-scroll-up (&optional arg)
(select-window org-agenda-show-window)
(ignore-errors (scroll-up)))
(org-agenda-goto t)
- (org-fold-show-entry)
+ (org-fold-show-entry 'hide-drawers)
(if arg (org-cycle-hide-drawers 'children)
(org-with-wide-buffer
(narrow-to-region (org-entry-beginning-position)
@@ -9764,7 +9764,7 @@ (defun org-agenda-show-1 (&optional more)
((and (called-interactively-p 'any) (= more 1))
(message "Remote: show with default settings"))
((= more 2)
- (org-fold-show-entry)
+ (org-fold-show-entry 'hide-drawers)
(org-fold-show-children)
(save-excursion
(org-back-to-heading)
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index ec87aaf8a..c04a8fdcf 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -1849,7 +1849,7 @@ (defun org-clock-goto (&optional select)
(pop-to-buffer-same-window (marker-buffer m))
(if (or (< m (point-min)) (> m (point-max))) (widen))
(goto-char m)
- (org-fold-show-entry)
+ (org-fold-show-entry 'hide-drawers)
(org-back-to-heading t)
(recenter org-clock-goto-before-context)
(org-fold-reveal)
diff --git a/lisp/org-compat.el b/lisp/org-compat.el
index 704197645..8553500d6 100644
--- a/lisp/org-compat.el
+++ b/lisp/org-compat.el
@@ -1400,7 +1400,7 @@ (defadvice outline-toggle-children (around outline-toggle-children@fix-for-org-f
(if (not (org-fold-folded-p (line-end-position)))
(org-fold-hide-subtree)
(org-fold-show-children)
- (org-fold-show-entry))))
+ (org-fold-show-entry 'hide-drawers))))
ad-do-it))
;; TODO: outline-headers-as-kill
diff --git a/lisp/org-fold.el b/lisp/org-fold.el
index acf7c0761..482b5772b 100644
--- a/lisp/org-fold.el
+++ b/lisp/org-fold.el
@@ -514,7 +514,7 @@ (defun org-fold-hide-sublevels (levels)
(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 ()
+(defun org-fold-show-entry (&optional hide-drawers)
"Show the body directly following its heading.
Show the heading too, if it is currently invisible."
(interactive)
@@ -529,7 +529,7 @@ (defun org-fold-show-entry ()
(point-max)))
nil
'outline)
- (org-cycle-hide-drawers 'children)))
+ (when hide-drawers (org-cycle-hide-drawers 'children))))
(defalias 'org-fold-show-hidden-entry #'org-fold-show-entry
"Show an entry where even the heading is hidden.")
diff --git a/lisp/org-timer.el b/lisp/org-timer.el
index 0c9350e76..f8e753edf 100644
--- a/lisp/org-timer.el
+++ b/lisp/org-timer.el
@@ -478,7 +478,7 @@ (defun org-timer--get-timer-title ()
(with-current-buffer (marker-buffer marker)
(org-with-wide-buffer
(goto-char hdmarker)
- (org-fold-show-entry)
+ (org-fold-show-entry 'hide-drawers)
(or (ignore-errors (org-get-heading))
(buffer-name (buffer-base-buffer))))))))
((derived-mode-p 'org-mode)
diff --git a/lisp/org.el b/lisp/org.el
index 47a16e94b..0f761e475 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -6765,7 +6765,7 @@ (defun org-move-subtree-down (&optional arg)
(move-marker ins-point nil)
(if folded
(org-fold-subtree t)
- (org-fold-show-entry)
+ (org-fold-show-entry 'hide-drawers)
(org-fold-show-children))
(org-clean-visibility-after-subtree-move)
;; move back to the initial column we were at
@@ -17261,7 +17261,7 @@ (defun org-return (&optional indent arg interactive)
(org-auto-align-tags (org-align-tags))
(t (org--align-tags-here tags-column))) ;preserve tags column
(end-of-line)
- (org-fold-show-entry)
+ (org-fold-show-entry 'hide-drawers)
(org--newline indent arg interactive)
(when string (save-excursion (insert (org-trim string))))))
;; In a list, make sure indenting keeps trailing text within.
--
2.35.1
^ permalink raw reply related [relevance 9%]
* Re: BUG: org cycling regression when using the legacy folding style overlays
@ 2022-05-31 3:07 6% ` Kaushal Modi
0 siblings, 0 replies; 25+ results
From: Kaushal Modi @ 2022-05-31 3:07 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: emacs-org list
On Mon, May 30, 2022 at 7:45 PM Ihor Radchenko <yantar92@gmail.com> wrote:
> Your code__collapse_all_posts block makes use of hide-subtree from
> outline.el. Please, do not use it. outline.el is no longer considered
> compatible with Org. It was not in the past, and even more so now. This
> has been announced in ORG-NEWS.
I read the ORG-NEWS:
> The new folding backend breaks some of the =outline-*= functions that
> rely on the details of visibility state implementation in
> =outline.el=. The old Org folding backend was compatible with the
> =outline.el= folding, but it is not the case anymore with the new
> backend. From now on, using =outline-*= functions is strongly
> discouraged when working with Org files.
It says that the new folding backend won't work with outline.el. But
in this case, I am still using the old backend.
Are the outline.el functions expected to stop working for the old backend too?
I replaced hide-subtree with org-fold-hide-subtree and my subtree
collpasing function seems to work as before even with
org-fold-core-style set to 'overlays. I will update this thread if I
see any issue with that.
Thanks!
^ permalink raw reply [relevance 6%]
* PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode.
@ 2023-02-22 7:29 12% Karl Fogel
2023-02-22 15:57 7% ` Max Nikulin
0 siblings, 1 reply; 25+ results
From: Karl Fogel @ 2023-02-22 7:29 UTC (permalink / raw)
To: Org Mode
Hey everyone, is there a reason we don't bind
`org-fold-hide-subtree' by default in Org Mode?
I bind it to C-<tab> and now find this to be one of the most
useful keybindings in Org Mode. I suspect my workflow is pretty
typical.
The use case is simple:
When reading material within a certain heading level, one often
decides that one is done with that section (and therefore done
with everything inside it -- including anything at deeper levels
of nesting). So one just folds the entire subtree around point
and moves on, without changing the visibility of any of the
sibling-or-higher subtrees around it (because often the next place
one is going is one of them).
This is one of my most frequent actions in Org Mode. In fact, I
think it might be the most common Org Mode command I run.
It seems like an obvious thing have bound to a key, and yet Org
Mode doesn't bind it by default. Should we?
(I put it on "C-<tab>" because that's normally unbound in Org
Mode, and because so many of the Org Mode cycling commands involve
modified tab already. But I don't feel strongly about the
particular key, as long as it's fast to type; maybe there's a
better key available.)
I looked for prior discussion about this in the archives and
didn't find anything:
https://list.orgmode.org/?q=org-fold-hide-subtree
Best regards,
-Karl
^ permalink raw reply [relevance 12%]
* Re: PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode.
2023-02-22 7:29 12% PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode Karl Fogel
@ 2023-02-22 15:57 7% ` Max Nikulin
2023-02-22 17:01 12% ` Karl Fogel
0 siblings, 1 reply; 25+ results
From: Max Nikulin @ 2023-02-22 15:57 UTC (permalink / raw)
To: emacs-orgmode
On 22/02/2023 14:29, Karl Fogel wrote:
> I put it on "C-<tab>" because that's normally unbound in Org Mode, and
> because so many of the Org Mode cycling commands involve modified tab
> already.
Perhaps C-<tab> is not the best choice:
9092c289b6bea38bb519e6c59a60237ae5af8f08
author Bastien Mon Jun 1 14:39:28 2020 +0200
Bind `org-force-cycle-archived' to C-c C-TAB
* lisp/org-keys.el (org-mode-map): Bind `org-force-cycle-archived'
to C-c C-TAB instead of C-TAB to avoid conflict with native Emacs
keybinding.
...
-(org-defkey org-mode-map (kbd "C-<tab>") #'org-force-cycle-archived)
+(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-force-cycle-archived)
^ permalink raw reply [relevance 7%]
* Re: PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode.
2023-02-22 15:57 7% ` Max Nikulin
@ 2023-02-22 17:01 12% ` Karl Fogel
2023-02-23 2:35 7% ` Max Nikulin
0 siblings, 1 reply; 25+ results
From: Karl Fogel @ 2023-02-22 17:01 UTC (permalink / raw)
To: Max Nikulin; +Cc: emacs-orgmode
On 22 Feb 2023, Max Nikulin wrote:
>On 22/02/2023 14:29, Karl Fogel wrote:
>> I put it on "C-<tab>" because that's normally unbound in Org
>> Mode,
>> and because so many of the Org Mode cycling commands involve
>> modified tab already.
>
>Perhaps C-<tab> is not the best choice:
>
>9092c289b6bea38bb519e6c59a60237ae5af8f08
>author Bastien Mon Jun 1 14:39:28 2020 +0200
>
>Bind `org-force-cycle-archived' to C-c C-TAB
>
>* lisp/org-keys.el (org-mode-map): Bind
>`org-force-cycle-archived'
>to C-c C-TAB instead of C-TAB to avoid conflict with native Emacs
>keybinding.
Ah, clearly it is not a good choice -- thank you for noticing
that.
I think there are two separate questions here:
1) Would it be useful to bind `org-fold-hide-subtree' by default?
2) If yes to (1), then is there a good key to bind it to? (C-c
C-something, I guess.)
If we agree on (1), then let's figure out the answer to (2). I
don't know if anyone else agrees about (1) yet, though.
By the way, the binding in my Org Mode hook looks like this:
(when (not (keymap-lookup nil "C-<tab>"))
(keymap-local-set "C-<tab>" 'org-fold-hide-subtree))
So FWIW C-<tab> is not bound in Org Mode buffers for me, in Emacs
30.x (i.e., recent development builds). However, I agree with
Bastien's logic: C-<tab> is not in the reserved keymap space, so
Emacs might bind it (and perhaps does bind it in other modes).
I don't know how widely-used `org-cycle-force-archived' is (that's
the new name of that function). I don't use it, personally, so if
we decide against (1)+(2) above, then perhaps I'll just override
that binding for myself instead.
Best regards,
-Karl
^ permalink raw reply [relevance 12%]
* Re: PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode.
2023-02-22 17:01 12% ` Karl Fogel
@ 2023-02-23 2:35 7% ` Max Nikulin
2023-02-23 4:48 7% ` Samuel Wales
2023-02-23 19:02 6% ` PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode Karl Fogel
0 siblings, 2 replies; 25+ results
From: Max Nikulin @ 2023-02-23 2:35 UTC (permalink / raw)
To: emacs-orgmode
On 23/02/2023 00:01, Karl Fogel wrote:
>
> (when (not (keymap-lookup nil "C-<tab>"))
> (keymap-local-set "C-<tab>" 'org-fold-hide-subtree))
>
> So FWIW C-<tab> is not bound in Org Mode buffers for me, in Emacs 30.x
> (i.e., recent development builds).
lisp/tab-bar.el:130: (unless (global-key-binding [(control tab)])
lisp/tab-bar.el:131: (global-set-key [(control tab)] #'tab-next))
Minibuffer file cache completion should not be relevant to Org buffers.
^ permalink raw reply [relevance 7%]
* Re: PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode.
2023-02-23 2:35 7% ` Max Nikulin
@ 2023-02-23 4:48 7% ` Samuel Wales
2023-02-25 8:01 7% ` Key binding in help (was: Re: PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode.) Max Nikulin
2023-02-23 19:02 6% ` PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode Karl Fogel
1 sibling, 1 reply; 25+ results
From: Samuel Wales @ 2023-02-23 4:48 UTC (permalink / raw)
To: Max Nikulin; +Cc: emacs-orgmode
huh i had put org-next-link there. i wish define-key could have a
button in a help page like functions and vars do so you could go to
where you define it. [there are probably 300 competing packages that
do exactly that.]
On 2/22/23, Max Nikulin <manikulin@gmail.com> wrote:
> On 23/02/2023 00:01, Karl Fogel wrote:
>>
>> (when (not (keymap-lookup nil "C-<tab>"))
>> (keymap-local-set "C-<tab>" 'org-fold-hide-subtree))
>>
>> So FWIW C-<tab> is not bound in Org Mode buffers for me, in Emacs 30.x
>> (i.e., recent development builds).
>
> lisp/tab-bar.el:130: (unless (global-key-binding [(control tab)])
> lisp/tab-bar.el:131: (global-set-key [(control tab)] #'tab-next))
>
> Minibuffer file cache completion should not be relevant to Org buffers.
>
>
>
--
The Kafka Pandemic
A blog about science, health, human rights, and misopathy:
https://thekafkapandemic.blogspot.com
^ permalink raw reply [relevance 7%]
* Re: PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode.
2023-02-23 2:35 7% ` Max Nikulin
2023-02-23 4:48 7% ` Samuel Wales
@ 2023-02-23 19:02 6% ` Karl Fogel
2023-02-25 0:13 10% ` Karl Fogel
1 sibling, 1 reply; 25+ results
From: Karl Fogel @ 2023-02-23 19:02 UTC (permalink / raw)
To: Max Nikulin; +Cc: emacs-orgmode
On 23 Feb 2023, Max Nikulin wrote:
>On 23/02/2023 00:01, Karl Fogel wrote:
>> (when (not (keymap-lookup nil "C-<tab>"))
>> (keymap-local-set "C-<tab>" 'org-fold-hide-subtree))
>> So FWIW C-<tab> is not bound in Org Mode buffers for me, in
>> Emacs
>> 30.x (i.e., recent development builds).
>
>lisp/tab-bar.el:130: (unless (global-key-binding [(control
>tab)])
>lisp/tab-bar.el:131: (global-set-key [(control tab)]
>#'tab-next))
>
>Minibuffer file cache completion should not be relevant to Org
>buffers.
Ah, I don't use tab-bar at all (at least not as far as I know), so
I'm not 100% sure what the above is saying.
Are you saying that the only current default binding for C-<tab>
in Emacs is that one in tab-bar.el, and therefore we should feel
free to rebind it in Org Mode? If so, we should still be
cautious, since Emacs has policies for maintaining the keybinding
space. Generally, the space "C-c C-<LETTER>" is reserved for
major modes, so ideally we should find something in there if we
can -- although Org Mode has used up a lot of that space already
:-), so I'm not sure what's left, unless we decide to swap out
some existing binding in favor of this one.
(I realize this contradicts what I said in my inital post. I had
forgotten that C-<tab> was not part of the mode-reserved space.)
Best regards,
-Karl
^ permalink raw reply [relevance 6%]
* Re: PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode.
2023-02-23 19:02 6% ` PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode Karl Fogel
@ 2023-02-25 0:13 10% ` Karl Fogel
2023-02-25 11:26 6% ` Max Nikulin
0 siblings, 1 reply; 25+ results
From: Karl Fogel @ 2023-02-25 0:13 UTC (permalink / raw)
To: emacs-orgmode
Okay, today I did some research and found that every "C-c
C-<letter>" binding is used in Org Mode except for "C-c C-g".
While that one is technically reserved for the mode's use, I
suspect the reason it's unbound is that people are accustomed to
using C-g as a quit command (and they get that effect if they
accidentally type C-c, because then they type C-g and it's just an
undefined key -- i.e., it quits, which is what the user wanted).
Note that while "C-c C-h" does not appear to be bound, it actually
is: it gets you a help buffer about the Org Mode keybindings
(which then, ironically, does not list "C-c C-h" as one of the
bindings).
(It's not clear to me whether Emacs's conventions consider "C-c
C-i" to be a letter or whether they treat "C-i" as "TAB" and
consider it special; based on the previous evidence in this
thread, maybe the latter, so we shouldn't consider "C-c C-i" to be
available.)
I think what this is telling me is that Org Mode keybinding real
estate is quite valuable :-), and that unless there are other
people who feel as strongly as I do that `org-fold-hide-subtree'
is amazingly useful, we probably won't decide to bind it by
default in Org Mode. So I should just continue to bind it to a
custom key myself and continue to live a glorious life all alone
in my private keymap splendour.
Best regards,
-Karl
I wrote:
>On 23 Feb 2023, Max Nikulin wrote:
>>On 23/02/2023 00:01, Karl Fogel wrote:
>>> =C2=A0(when (not (keymap-lookup nil "C-<tab>"))
>>> =C2=A0=C2=A0 (keymap-local-set "C-<tab>"
>>> 'org-fold-hide-subtree))
>>> So FWIW C-<tab> is not bound in Org Mode buffers for me, in=20
>>> Emacs
>>> 30.x (i.e., recent development builds).
>>
>>lisp/tab-bar.el:130: (unless (global-key-binding [(control=20
>>tab)])
>>lisp/tab-bar.el:131: (global-set-key [(control tab)]=20
>>#'tab-next))
>>
>>Minibuffer file cache completion should not be relevant to
>>Org=20
>>buffers.
>
>Ah, I don't use tab-bar at all (at least not as far as I know),
>so=20
>I'm not 100% sure what the above is saying.
>
>Are you saying that the only current default binding for
>C-<tab>=20
>in Emacs is that one in tab-bar.el, and therefore we should
>feel=20
>free to rebind it in Org Mode? If so, we should still be=20
>cautious, since Emacs has policies for maintaining the
>keybinding=20
>space. Generally, the space "C-c C-<LETTER>" is reserved for=20
>major modes, so ideally we should find something in there if
>we=20
>can -- although Org Mode has used up a lot of that space
>already=20
>:-), so I'm not sure what's left, unless we decide to swap out=20
>some existing binding in favor of this one.
>
>(I realize this contradicts what I said in my inital post. I
>had=20
>forgotten that C-<tab> was not part of the mode-reserved space.)
^ permalink raw reply [relevance 10%]
* Key binding in help (was: Re: PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode.)
2023-02-23 4:48 7% ` Samuel Wales
@ 2023-02-25 8:01 7% ` Max Nikulin
2023-02-25 23:32 7% ` Samuel Wales
0 siblings, 1 reply; 25+ results
From: Max Nikulin @ 2023-02-25 8:01 UTC (permalink / raw)
To: emacs-orgmode
On 23/02/2023 11:48, Samuel Wales wrote:
> huh i had put org-next-link there. i wish define-key could have a
> button in a help page like functions and vars do so you could go to
> where you define it. [there are probably 300 competing packages that
> do exactly that.]
C-h f org-next-link
displays at the top:
It is bound to C-c C-x C-n, <menu-bar> <Org> <Hyperlinks> <Next link>.
Is it the feature you are asking for? This one is available out of the box.
Unfortunately it is not trivial to discover binding from a file that is
not loaded. Actually I found `tab-next' in the manual at first. Earlier
attempts with "C-<tab>" and "C-TAB" failed due to "[(control tab)]" is
used in tab-bar.el.
^ permalink raw reply [relevance 7%]
* Re: PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode.
2023-02-25 0:13 10% ` Karl Fogel
@ 2023-02-25 11:26 6% ` Max Nikulin
2023-02-25 17:33 14% ` Karl Fogel
0 siblings, 1 reply; 25+ results
From: Max Nikulin @ 2023-02-25 11:26 UTC (permalink / raw)
To: emacs-orgmode
On 25/02/2023 07:13, Karl Fogel wrote:
> Okay, today I did some research and found that every "C-c C-<letter>"
> binding is used in Org Mode except for "C-c C-g". While that one is
> technically reserved for the mode's use
No, there is an explicit exception for C-g, see (info "(elisp) Key
Binding Conventions") in "Tips and Conventions" appendix.
https://www.gnu.org/software/emacs/manual/html_node/elisp/Key-Binding-Conventions.html
> (It's not clear to me whether Emacs's conventions consider "C-c C-i" to
> be a letter or whether they treat "C-i" as "TAB" and consider it
> special; based on the previous evidence in this thread, maybe the
> latter, so we shouldn't consider "C-c C-i" to be available.)
It might be a problem to distinguish C-i and <tab> in text terminal.
Issues with "C-c C-," raised on this list
- (info "(emacs) Named ASCII Chars")
https://www.gnu.org/software/emacs/manual/html_node/emacs/Named-ASCII-Chars.html
- (info "(elisp) Function Keys")
https://www.gnu.org/software/emacs/manual/html_node/elisp/Function-Keys.html
A similar issue exists with C-S-letter
- (info "(emacs) Modifier Keys")
https://www.gnu.org/software/emacs/manual/html_node/emacs/Modifier-Keys.html
- (info "(elisp) Other Char Bits")
https://www.gnu.org/software/emacs/manual/html_node/elisp/Other-Char-Bits.html
> I think what this is telling me is that Org Mode keybinding real estate
> is quite valuable :-),
Even C-c C-x prefix is quite busy. Other modifiers might be a rescue:
C-c M-something.
However perhaps M-x with fuzzy completion allowing typos (and ideally
synonyms) might be a better solution.
>> Are you saying that the only current default binding for C-<tab>=20
>> in Emacs is that one in tab-bar.el, and therefore we should feel=20
>> free to rebind it in Org Mode?
No, [Ctrl+Tab] and [Ctrl+Shift+Tab] is widely used in other applications
to switch to next/previous tabs. I would strongly prefer to keep it
consistent across as much applications as possible. (There are corner
cases like e.g. vim with multiple tabs running in a terminal application
having several tabs as well. E.g. gnome terminal is able to pass
[Ctrl+PgDn], a [Ctrl+Tab] alternative, while it has single tab, but
intercepts the same shortcut when more terminal tabs are opened, so vim
keys have to be used.)
^ permalink raw reply [relevance 6%]
* Re: PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode.
2023-02-25 11:26 6% ` Max Nikulin
@ 2023-02-25 17:33 14% ` Karl Fogel
0 siblings, 0 replies; 25+ results
From: Karl Fogel @ 2023-02-25 17:33 UTC (permalink / raw)
To: Max Nikulin; +Cc: emacs-orgmode
On 25 Feb 2023, Max Nikulin wrote:
>On 25/02/2023 07:13, Karl Fogel wrote:
>> Okay, today I did some research and found that every "C-c
>> C-<letter>" binding is used in Org Mode except for "C-c
>> C-g". While
>> that one is technically reserved for the mode's use
>
>No, there is an explicit exception for C-g, see (info "(elisp)
>Key
>Binding Conventions") in "Tips and Conventions" appendix.
>https://www.gnu.org/software/emacs/manual/html_node/elisp/Key-Binding-Conventions.html
Ah, thanks for pointing that out.
>Even C-c C-x prefix is quite busy. Other modifiers might be a
>rescue:
>C-c M-something.
>
>However perhaps M-x with fuzzy completion allowing typos (and
>ideally
>synonyms) might be a better solution.
Well, sure -- we get that for free.
I think we can consider this proposal over. While I find
`org-fold-hide-subtree' very useful, the Org Mode default keyspace
is very busy already, and we don't hear anyone proposing to drop
something else in favor of `org-fold-hide-subtree'. Anyone can
custom-bind it themselves, of course (which is what I'll continue
doing).
>No, [Ctrl+Tab] and [Ctrl+Shift+Tab] is widely used in other
>applications to switch to next/previous tabs. I would strongly
>prefer
>to keep it consistent across as much applications as
>possible. (There
>are corner cases like e.g. vim with multiple tabs running in a
>terminal application having several tabs as well. E.g. gnome
>terminal
>is able to pass [Ctrl+PgDn], a [Ctrl+Tab] alternative, while it
>has
>single tab, but intercepts the same shortcut when more terminal
>tabs
>are opened, so vim keys have to be used.)
Agreed.
Best regards,
-Karl
^ permalink raw reply [relevance 14%]
* Re: Key binding in help (was: Re: PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode.)
2023-02-25 8:01 7% ` Key binding in help (was: Re: PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode.) Max Nikulin
@ 2023-02-25 23:32 7% ` Samuel Wales
2023-03-08 15:27 7% ` Max Nikulin
0 siblings, 1 reply; 25+ results
From: Samuel Wales @ 2023-02-25 23:32 UTC (permalink / raw)
To: Max Nikulin; +Cc: emacs-orgmode
what i meant was that i have a binding, org-next-link, bound to c-tab.
i acccomplished this with (define-key org-mode-map (quote [C-tab])
(quote org-next-link)) [kbd would be better].
i did similar with org-link-minor-mode. i was just offtopicing that
it would be useful to jump to those definitions.
i.e. like m-. on a function name, if that is set up to work, or c-h f
command tab ret to go to the fuction definition, but for keys.
On 2/25/23, Max Nikulin <manikulin@gmail.com> wrote:
> On 23/02/2023 11:48, Samuel Wales wrote:
>> huh i had put org-next-link there. i wish define-key could have a
>> button in a help page like functions and vars do so you could go to
>> where you define it. [there are probably 300 competing packages that
>> do exactly that.]
>
> C-h f org-next-link
>
> displays at the top:
>
> It is bound to C-c C-x C-n, <menu-bar> <Org> <Hyperlinks> <Next link>.
>
> Is it the feature you are asking for? This one is available out of the box.
>
> Unfortunately it is not trivial to discover binding from a file that is
> not loaded. Actually I found `tab-next' in the manual at first. Earlier
> attempts with "C-<tab>" and "C-TAB" failed due to "[(control tab)]" is
> used in tab-bar.el.
>
>
>
--
The Kafka Pandemic
A blog about science, health, human rights, and misopathy:
https://thekafkapandemic.blogspot.com
^ permalink raw reply [relevance 7%]
* PATCH] orgcard.tex: Fix `org-force-cycle-archived' binding
@ 2023-03-04 6:02 4% Max Nikulin
0 siblings, 0 replies; 25+ results
From: Max Nikulin @ 2023-03-04 6:02 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 393 bytes --]
Hi,
During discussion in the following thread I realized that the refcard
was not updated when `org-force-cycle-archived' binding was changed from
C-TAB to C-c C-<tab> to avoid conflict with switching of tabs.
Karl Fogel to emacs-orgmode. PROPOSAL: Bind `org-fold-hide-subtree' by
default in Org Mode. Wed, 22 Feb 2023 01:29:12 -0600.
https://list.orgmode.org/87k00aw43b.fsf@red-bean.com
[-- Attachment #2: 0001-orgcard.tex-Fix-org-force-cycle-archived-binding.patch --]
[-- Type: text/x-patch, Size: 991 bytes --]
From 6ad5ebf4c4a8c1546bbef1e9319f3b65c0b250b5 Mon Sep 17 00:00:00 2001
From: Max Nikulin <manikulin@gmail.com>
Date: Sat, 4 Mar 2023 12:38:18 +0700
Subject: [PATCH] orgcard.tex: Fix `org-force-cycle-archived' binding
* doc/orgcard.tex (Capture): Fix `org-force-cycle-archived' binding.
Changed in the release 9.4 to avoid conflict with tab-bar.el, see
9092c289b 2020-06-01 14:39:28 +0200 Bastien: Bind `org-force-cycle-archived' to C-c C-TAB
---
doc/orgcard.tex | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/orgcard.tex b/doc/orgcard.tex
index 3fafacf25..13e8b8d7a 100644
--- a/doc/orgcard.tex
+++ b/doc/orgcard.tex
@@ -324,7 +324,7 @@
\key{archive subtree using the default command}{C-c C-x C-a}
\key{move subtree to archive file}{C-c C-x C-s}
\key{toggle ARCHIVE tag / to ARCHIVE sibling}{C-c C-x a/A}
-\key{force cycling of an ARCHIVEd tree}{C-TAB}
+\key{force cycling of an ARCHIVEd tree}{C-c C-TAB}
\section{Filtering and Sparse Trees}
--
2.25.1
^ permalink raw reply related [relevance 4%]
* Re: Key binding in help (was: Re: PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode.)
2023-02-25 23:32 7% ` Samuel Wales
@ 2023-03-08 15:27 7% ` Max Nikulin
0 siblings, 0 replies; 25+ results
From: Max Nikulin @ 2023-03-08 15:27 UTC (permalink / raw)
To: emacs-orgmode
On 26/02/2023 06:32, Samuel Wales wrote:
> i acccomplished this with (define-key org-mode-map (quote [C-tab])
> (quote org-next-link)) [kbd would be better].
...
> i.e. like m-. on a function name, if that is set up to work, or c-h f
> command tab ret to go to the fuction definition, but for keys.
I do not mind to have such feature as well. If you really want to get
it, you should send a feature request to bug-gnu-emacs.
>> On 23/02/2023 11:48, Samuel Wales wrote:
>>> [there are probably 300 competing packages that
>>> do exactly that.]
I expect that it should be implemented in Emacs core since updated
`define-key' should be available rather early during initialization.
Looking into
https://www.gnu.org/software/emacs/manual/html_node/elisp/Format-of-Keymaps.html
https://www.gnu.org/software/emacs/manual/html_node/elisp/Key-Lookup.html
I do not see a ready to use slot for location of key definition. Another
point is that keymap extension should not noticeably affect performance.
^ permalink raw reply [relevance 7%]
* Re: [patch] ob-clojure: Fix results output
@ 2023-03-14 14:27 6% ` Daniel Kraus
0 siblings, 1 reply; 25+ results
From: Daniel Kraus @ 2023-03-14 14:27 UTC (permalink / raw)
To: Ihor Radchenko, emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 221 bytes --]
Daniel Kraus <daniel@kraus.my> writes:
> Attached is the new patch with the changes.
>
> [2. text/x-patch; 0001-lisp-ob-sql.el-Add-support-for-Athena.patch]...
Ups, I attached the wrong one.
Here the correct patch..
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-ob-clojure.el-Fix-results-output-support-clojure-cli.patch --]
[-- Type: text/x-patch, Size: 15014 bytes --]
From db0634b5ab0b5c8c996c5dcbbeb266b720c67459 Mon Sep 17 00:00:00 2001
From: Daniel Kraus <daniel@kraus.my>
Date: Thu, 9 Mar 2023 16:11:27 +0100
Subject: [PATCH] ob-clojure.el: Fix results output, support clojure-cli
* lisp/ob-clojure.el (org-babel-clojure-backend): Add support for
clojure-cli.
* lisp/ob-clojure.el (org-babel-clojurescript-backend): Move nbb to
clojurescript.
* lisp/ob-clojure.el (org-babel-expand-body:clojure)
* lisp/ob-clojure.el (ob-clojure-eval-with-cider): Return only the
last expression when :results is not set or value, and return only
stdout when :results is set to output.
* lisp/ob-clojure.el (ob-clojure-eval-with-cmd): Rename function as
it is not only for babashka.
* lisp/ob-clojure.el (org-babel-execute:clojure): Differentiate
between Clojure and ClojureScript source blocks.
The problem was that the ob-clojure results where not correctly
taking the results parameter into account.
E.g. with the cider backend, you would get all printed or returned
values for each line in your block:
(def small-map {:a 2 :b 4 :c 8})
{:some :map}
(prn :xx)
(:b small-map)
| #'user/small-map |
| {:some :map} |
| 4 |
or for babashka you would only get the printed values but not the
last return value:
(def small-map {:a 2 :b 4 :c 8})
{:some :map}
(prn :xx)
(:b small-map)
: :xx
Now when you specify :results value, the result is only the last
returned value, and with :results output you get all values
printed to stdout.
So the examples above would all result in the same:
(def small-map {:a 2 :b 4 :c 8})
{:some :map}
(prn :xx)
(:b small-map)
: 4
---
etc/ORG-NEWS | 23 +++++++
lisp/ob-clojure.el | 149 ++++++++++++++++++++++++++++-----------------
lisp/org-compat.el | 4 ++
3 files changed, 120 insertions(+), 56 deletions(-)
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index b9d7b3459..4ca13af17 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -96,6 +96,21 @@ The face ~org-agenda-calendar-daterange~ is used to show entries with
a date range in the agenda. It inherits from the default face in
order to remain backward-compatible.
+*** New ~org-babel-clojurescript-backend~ option to choose ClojureScript backend
+
+Before, a ClojureScript source block used the same backend as Clojure,
+configured in ~org-babel-clojure-backend~ and relied on an undocumented
+~:target~ paramter.
+
+Now, there's ~org-babel-clojurescript-backend~ to determine the
+backend used for evaluation of ClojureScript.
+
+*** Support for Clojure CLI in ~ob-clojure~
+
+~ob-clojure~ now supports executing babel source blocks with the
+official [[https://clojure.org/guides/deps_and_cli][Clojure CLI tools]].
+The command can be customized with ~ob-clojure-cli-command~.
+
** New features
*** ~org-metaup~ and ~org-metadown~ now act on headings in region
@@ -116,6 +131,14 @@ selection.
TODO state, priority, tags, statistics cookies, and COMMENT keywords
are allowed in the tree structure.
+** Miscellaneous
+*** Remove undocumented ~:target~ header parameter in ~ob-clojure~
+
+The ~:target~ header was only used internally to distinguish
+from Clojure and ClojureScript.
+This is now handled with an optional function parameter in
+the respective functions that need this information.
+
* Version 9.6
** Important announcements and breaking changes
diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el
index 5f589db00..f254fa204 100644
--- a/lisp/ob-clojure.el
+++ b/lisp/ob-clojure.el
@@ -25,20 +25,21 @@
;;; Commentary:
-;; Support for evaluating Clojure code
+;; Support for evaluating Clojure / ClojureScript code.
;; Requirements:
;; - Clojure (at least 1.2.0)
;; - clojure-mode
-;; - inf-clojure, Cider, SLIME, babashka or nbb
+;; - babashka, nbb, Clojure CLI tools, Cider, inf-clojure or SLIME
;; For clojure-mode, see https://github.com/clojure-emacs/clojure-mode
-;; For inf-clojure, see https://github.com/clojure-emacs/inf-clojure
-;; For Cider, see https://github.com/clojure-emacs/cider
-;; For SLIME, see https://slime.common-lisp.dev
;; For babashka, see https://github.com/babashka/babashka
;; For nbb, see https://github.com/babashka/nbb
+;; For Clojure CLI tools, see https://clojure.org/guides/deps_and_cli
+;; For Cider, see https://github.com/clojure-emacs/cider
+;; For inf-clojure, see https://github.com/clojure-emacs/inf-clojure
+;; For SLIME, see https://slime.common-lisp.dev
;; For SLIME, the best way to install its components is by following
;; the directions as set out by Phil Hagelberg (Technomancy) on the
@@ -78,20 +79,33 @@ defvar org-babel-header-args:clojurescript
(defcustom org-babel-clojure-backend (cond
((executable-find "bb") 'babashka)
- ((executable-find "nbb") 'nbb)
+ ((executable-find "clojure") 'clojure-cli)
((featurep 'cider) 'cider)
((featurep 'inf-clojure) 'inf-clojure)
((featurep 'slime) 'slime)
(t nil))
"Backend used to evaluate Clojure code blocks."
:group 'org-babel
- :package-version '(Org . "9.6")
+ :package-version '(Org . "9.7")
:type '(choice
- (const :tag "inf-clojure" inf-clojure)
+ (const :tag "babashka" babashka)
+ (const :tag "clojure-cli" clojure-cli)
(const :tag "cider" cider)
+ (const :tag "inf-clojure" inf-clojure)
(const :tag "slime" slime)
- (const :tag "babashka" babashka)
+ (const :tag "Not configured yet" nil)))
+
+(defcustom org-babel-clojurescript-backend
+ (cond
+ ((or (executable-find "nbb") (executable-find "npx")) 'nbb)
+ ((featurep 'cider) 'cider)
+ (t nil))
+ "Backend used to evaluate Clojure code blocks."
+ :group 'org-babel
+ :package-version '(Org . "9.7")
+ :type '(choice
(const :tag "nbb" nbb)
+ (const :tag "cider" cider)
(const :tag "Not configured yet" nil)))
(defcustom org-babel-clojure-default-ns "user"
@@ -105,14 +119,24 @@ defcustom ob-clojure-babashka-command
:group 'org-babel
:package-version '(Org . "9.6"))
-(defcustom ob-clojure-nbb-command (executable-find "nbb")
- "Path to the nbb executable."
- :type '(choice file (const nil))
+(defcustom ob-clojure-nbb-command (or (executable-find "nbb")
+ (when-let (npx (executable-find "npx"))
+ (concat npx " nbb")))
+ "Command to invoke the nbb executable."
+ :type '(choice string (const nil))
:group 'org-babel
- :package-version '(Org . "9.6"))
+ :package-version '(Org . "9.7"))
-(defun org-babel-expand-body:clojure (body params)
- "Expand BODY according to PARAMS, return the expanded body."
+(defcustom ob-clojure-cli-command (when-let (cmd (executable-find "clojure"))
+ (concat cmd " -M"))
+ "Clojure CLI command used to execute source blocks."
+ :type 'string
+ :group 'org-babel
+ :package-version '(Org . "9.7"))
+
+(defun org-babel-expand-body:clojure (body params &optional cljs-p)
+ "Expand BODY according to PARAMS, return the expanded body.
+When CLJS-P is non-nil, expand in a cljs context instead of clj."
(let* ((vars (org-babel--get-vars params))
(backend-override (cdr (assq :backend params)))
(org-babel-clojure-backend
@@ -146,10 +170,26 @@ defun org-babel-expand-body:clojure
vars
"\n ")
body))))))
- (if (or (member "code" result-params)
- (member "pp" result-params))
- (format "(clojure.pprint/pprint (do %s))" body)
- body)))
+ ;; If the result param is set to "output" we don't have to do
+ ;; anything special and just let the backend handle everything
+ (if (member "output" result-params)
+ body
+
+ ;; If the result is not "output" (i.e. it's "value"), disable
+ ;; stdout output and print the last returned value. Use pprint
+ ;; instead of prn when results param is "pp" or "code".
+ (concat
+ (if (or (member "code" result-params)
+ (member "pp" result-params))
+ (concat (if cljs-p
+ "(require '[cljs.pprint :refer [pprint]])"
+ "(require '[clojure.pprint :refer [pprint]])")
+ " (pprint ")
+ "(prn ")
+ (if cljs-p
+ "(binding [cljs.core/*print-fn* (constantly nil)]"
+ "(binding [*out* (java.io.StringWriter.)]")
+ body "))"))))
(defvar ob-clojure-inf-clojure-filter-out)
(defvar ob-clojure-inf-clojure-tmp-output)
@@ -225,32 +265,19 @@ defun ob-clojure-eval-with-inf-clojure
s))
(reverse ob-clojure-inf-clojure-tmp-output)))))
-(defun ob-clojure-eval-with-cider (expanded params)
- "Evaluate EXPANDED code block with PARAMS using cider."
+(defun ob-clojure-eval-with-cider (expanded params &optional cljs-p)
+ "Evaluate EXPANDED code block with PARAMS using cider.
+When CLJS-P is non-nil, use a cljs connection instead of clj."
(org-require-package 'cider "Cider")
- (let ((connection (cider-current-connection (cdr (assq :target params))))
- (result-params (cdr (assq :result-params params)))
- result0)
+ (let ((connection (cider-current-connection (if cljs-p "cljs" "clj"))))
(unless connection (sesman-start-session 'CIDER))
(if (not connection)
;; Display in the result instead of using `user-error'
- (setq result0 "Please reevaluate when nREPL is connected")
- (ob-clojure-with-temp-expanded expanded params
- (let ((response (nrepl-sync-request:eval exp connection)))
- (push (or (nrepl-dict-get response "root-ex")
- (nrepl-dict-get response "ex")
- (nrepl-dict-get
- response (if (or (member "output" result-params)
- (member "pp" result-params))
- "out"
- "value")))
- result0)))
- (ob-clojure-string-or-list
- ;; Filter out s-expressions that return nil (string "nil"
- ;; from nrepl eval) or comment forms (actual nil from nrepl)
- (reverse (delete "" (mapcar (lambda (r)
- (replace-regexp-in-string "nil" "" (or r "")))
- result0)))))))
+ "Please reevaluate when nREPL is connected"
+ (let ((response (nrepl-sync-request:eval expanded connection)))
+ (or (nrepl-dict-get response "root-ex")
+ (nrepl-dict-get response "ex")
+ (nrepl-dict-get response "out"))))))
(defun ob-clojure-eval-with-slime (expanded params)
"Evaluate EXPANDED code block with PARAMS using slime."
@@ -262,39 +289,49 @@ defun ob-clojure-eval-with-slime
,(buffer-substring-no-properties (point-min) (point-max)))
(cdr (assq :package params)))))
-(defun ob-clojure-eval-with-babashka (bb expanded)
- "Evaluate EXPANDED code block using BB (babashka or nbb)."
- (let ((script-file (org-babel-temp-file "clojure-bb-script-" ".clj")))
+(defun ob-clojure-eval-with-cmd (cmd expanded)
+ "Evaluate EXPANDED code block using CMD (babashka, clojure or nbb)."
+ (let ((script-file (org-babel-temp-file "clojure-cmd-script-" ".clj")))
(with-temp-file script-file
(insert expanded))
(org-babel-eval
- (format "%s %s" bb (org-babel-process-file-name script-file))
+ (format "%s %s" cmd (org-babel-process-file-name script-file))
"")))
-(defun org-babel-execute:clojure (body params)
- "Execute the BODY block of Clojure code with PARAMS using Babel."
+(defun org-babel-execute:clojure (body params &optional cljs-p)
+ "Execute the BODY block of Clojure code with PARAMS using Babel.
+When CLJS-P is non-nil, execute with a ClojureScript backend
+instead of Clojure."
(let* ((backend-override (cdr (assq :backend params)))
(org-babel-clojure-backend
(cond
(backend-override (intern backend-override))
- (org-babel-clojure-backend org-babel-clojure-backend)
- (t (user-error "You need to customize `org-babel-clojure-backend'
-or set the `:backend' header argument")))))
- (let* ((expanded (org-babel-expand-body:clojure body params))
+ (org-babel-clojure-backend (if cljs-p
+ org-babel-clojurescript-backend
+ org-babel-clojure-backend))
+ (t (user-error "You need to customize `%S'
+or set the `:backend' header argument"
+ (if cljs-p
+ org-babel-clojurescript-backend
+ org-babel-clojure-backend))))))
+ (let* ((expanded (org-babel-expand-body:clojure body params cljs-p))
(result-params (cdr (assq :result-params params)))
result)
(setq result
(cond
((eq org-babel-clojure-backend 'inf-clojure)
(ob-clojure-eval-with-inf-clojure expanded params))
+ ((eq org-babel-clojure-backend 'clojure-cli)
+ (ob-clojure-eval-with-cmd ob-clojure-cli-command expanded))
((eq org-babel-clojure-backend 'babashka)
- (ob-clojure-eval-with-babashka ob-clojure-babashka-command expanded))
+ (ob-clojure-eval-with-cmd ob-clojure-babashka-command expanded))
((eq org-babel-clojure-backend 'nbb)
- (ob-clojure-eval-with-babashka ob-clojure-nbb-command expanded))
+ (ob-clojure-eval-with-cmd ob-clojure-nbb-command expanded))
((eq org-babel-clojure-backend 'cider)
- (ob-clojure-eval-with-cider expanded params))
+ (ob-clojure-eval-with-cider expanded params cljs-p))
((eq org-babel-clojure-backend 'slime)
- (ob-clojure-eval-with-slime expanded params))))
+ (ob-clojure-eval-with-slime expanded params))
+ (t (user-error "Invalid backend"))))
(org-babel-result-cond result-params
result
(condition-case nil (org-babel-script-escape result)
@@ -302,7 +339,7 @@ defun org-babel-execute:clojure
(defun org-babel-execute:clojurescript (body params)
"Evaluate BODY with PARAMS as ClojureScript code."
- (org-babel-execute:clojure body (cons '(:target . "cljs") params)))
+ (org-babel-execute:clojure body params t))
(provide 'ob-clojure)
diff --git a/lisp/org-compat.el b/lisp/org-compat.el
index fadb51df6..c47a4e8c2 100644
--- a/lisp/org-compat.el
+++ b/lisp/org-compat.el
@@ -71,6 +71,7 @@
(declare-function outline-next-heading "outline" ())
(declare-function speedbar-line-directory "speedbar" (&optional depth))
(declare-function table--at-cell-p "table" (position &optional object at-column))
+(declare-function ob-clojure-eval-with-cmd "ob-clojure" (cmd expanded))
(declare-function org-fold-folded-p "org-fold" (&optional pos spec-or-alias))
(declare-function org-fold-hide-sublevels "org-fold" (levels))
(declare-function org-fold-hide-subtree "org-fold" ())
@@ -1127,6 +1128,9 @@ defconst org-babel-python-mode
"Only the built-in Python mode is supported in ob-python now."
"9.7")
+(define-obsolete-function-alias 'ob-clojure-eval-with-babashka
+ #'ob-clojure-eval-with-cmd "9.7")
+
;;;; Obsolete link types
(eval-after-load 'ol
--
2.39.2
^ permalink raw reply related [relevance 6%]
* Re: [patch] ob-clojure: Fix results output
@ 2023-03-15 11:22 6% ` Daniel Kraus
0 siblings, 0 replies; 25+ results
From: Daniel Kraus @ 2023-03-15 11:22 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 1008 bytes --]
Ihor Radchenko <yantar92@posteo.net> writes:
> What will happen with users who customized `org-babel-clojure-backend'
> to 'nbb in the past?
They would have gotten an error.
I changed it now that 'nbb backend is still allowed in a clojure
source block but it will internally treated as ClojureScript.
>> +(defcustom org-babel-clojurescript-backend
>> + (cond
>> + ((or (executable-find "nbb") (executable-find "npx")) 'nbb)
>> + ((featurep 'cider) 'cider)
>> + (t nil))
>> + "Backend used to evaluate Clojure code blocks."
>
> This docstring is exactly the same with `org-babel-clojure-backend'.
> What is the difference?
> I think ""Backend used to evaluate ClojureScript code blocks." will be
> more clear. I feel that other docstrings may also need to be clarified
> depending whether they affect Clojure or ClojureScript blocks.
I changed the docstrings to always mention either Clojure or ClojureScript.
I'm open for more improvements/suggestions.
Attached a new patch.
Thanks,
Daniel
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-ob-clojure.el-Fix-results-output-support-clojure-cli.patch --]
[-- Type: text/x-patch, Size: 15600 bytes --]
From 391bdd403f643fa75cceeb0c81f117996c2374b0 Mon Sep 17 00:00:00 2001
From: Daniel Kraus <daniel@kraus.my>
Date: Thu, 9 Mar 2023 16:11:27 +0100
Subject: [PATCH] ob-clojure.el: Fix results output, support clojure-cli
* lisp/ob-clojure.el (org-babel-clojure-backend): Add support for
clojure-cli.
* lisp/ob-clojure.el (org-babel-clojurescript-backend): Move nbb to
clojurescript.
* lisp/ob-clojure.el (org-babel-expand-body:clojure)
* lisp/ob-clojure.el (ob-clojure-eval-with-cider): Return only the
last expression when :results is not set or value, and return only
stdout when :results is set to output.
* lisp/ob-clojure.el (ob-clojure-eval-with-cmd): Rename function as
it is not only for babashka.
* lisp/ob-clojure.el (org-babel-execute:clojure): Differentiate
between Clojure and ClojureScript source blocks.
The problem was that the ob-clojure results where not correctly
taking the results parameter into account.
E.g. with the cider backend, you would get all printed or returned
values for each line in your block:
(def small-map {:a 2 :b 4 :c 8})
{:some :map}
(prn :xx)
(:b small-map)
| #'user/small-map |
| {:some :map} |
| 4 |
or for babashka you would only get the printed values but not the
last return value:
(def small-map {:a 2 :b 4 :c 8})
{:some :map}
(prn :xx)
(:b small-map)
: :xx
Now when you specify :results value, the result is only the last
returned value, and with :results output you get all values
printed to stdout.
So the examples above would all result in the same:
(def small-map {:a 2 :b 4 :c 8})
{:some :map}
(prn :xx)
(:b small-map)
: 4
---
etc/ORG-NEWS | 23 +++++++
lisp/ob-clojure.el | 156 ++++++++++++++++++++++++++++-----------------
lisp/org-compat.el | 4 ++
3 files changed, 126 insertions(+), 57 deletions(-)
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index b9d7b3459..4ca13af17 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -96,6 +96,21 @@ The face ~org-agenda-calendar-daterange~ is used to show entries with
a date range in the agenda. It inherits from the default face in
order to remain backward-compatible.
+*** New ~org-babel-clojurescript-backend~ option to choose ClojureScript backend
+
+Before, a ClojureScript source block used the same backend as Clojure,
+configured in ~org-babel-clojure-backend~ and relied on an undocumented
+~:target~ paramter.
+
+Now, there's ~org-babel-clojurescript-backend~ to determine the
+backend used for evaluation of ClojureScript.
+
+*** Support for Clojure CLI in ~ob-clojure~
+
+~ob-clojure~ now supports executing babel source blocks with the
+official [[https://clojure.org/guides/deps_and_cli][Clojure CLI tools]].
+The command can be customized with ~ob-clojure-cli-command~.
+
** New features
*** ~org-metaup~ and ~org-metadown~ now act on headings in region
@@ -116,6 +131,14 @@ selection.
TODO state, priority, tags, statistics cookies, and COMMENT keywords
are allowed in the tree structure.
+** Miscellaneous
+*** Remove undocumented ~:target~ header parameter in ~ob-clojure~
+
+The ~:target~ header was only used internally to distinguish
+from Clojure and ClojureScript.
+This is now handled with an optional function parameter in
+the respective functions that need this information.
+
* Version 9.6
** Important announcements and breaking changes
diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el
index 5f589db00..70e032154 100644
--- a/lisp/ob-clojure.el
+++ b/lisp/ob-clojure.el
@@ -25,20 +25,21 @@
;;; Commentary:
-;; Support for evaluating Clojure code
+;; Support for evaluating Clojure / ClojureScript code.
;; Requirements:
;; - Clojure (at least 1.2.0)
;; - clojure-mode
-;; - inf-clojure, Cider, SLIME, babashka or nbb
+;; - babashka, nbb, Clojure CLI tools, Cider, inf-clojure or SLIME
;; For clojure-mode, see https://github.com/clojure-emacs/clojure-mode
-;; For inf-clojure, see https://github.com/clojure-emacs/inf-clojure
-;; For Cider, see https://github.com/clojure-emacs/cider
-;; For SLIME, see https://slime.common-lisp.dev
;; For babashka, see https://github.com/babashka/babashka
;; For nbb, see https://github.com/babashka/nbb
+;; For Clojure CLI tools, see https://clojure.org/guides/deps_and_cli
+;; For Cider, see https://github.com/clojure-emacs/cider
+;; For inf-clojure, see https://github.com/clojure-emacs/inf-clojure
+;; For SLIME, see https://slime.common-lisp.dev
;; For SLIME, the best way to install its components is by following
;; the directions as set out by Phil Hagelberg (Technomancy) on the
@@ -78,20 +79,33 @@ defvar org-babel-header-args:clojurescript
(defcustom org-babel-clojure-backend (cond
((executable-find "bb") 'babashka)
- ((executable-find "nbb") 'nbb)
+ ((executable-find "clojure") 'clojure-cli)
((featurep 'cider) 'cider)
((featurep 'inf-clojure) 'inf-clojure)
((featurep 'slime) 'slime)
(t nil))
"Backend used to evaluate Clojure code blocks."
:group 'org-babel
- :package-version '(Org . "9.6")
+ :package-version '(Org . "9.7")
:type '(choice
- (const :tag "inf-clojure" inf-clojure)
+ (const :tag "babashka" babashka)
+ (const :tag "clojure-cli" clojure-cli)
(const :tag "cider" cider)
+ (const :tag "inf-clojure" inf-clojure)
(const :tag "slime" slime)
- (const :tag "babashka" babashka)
+ (const :tag "Not configured yet" nil)))
+
+(defcustom org-babel-clojurescript-backend
+ (cond
+ ((or (executable-find "nbb") (executable-find "npx")) 'nbb)
+ ((featurep 'cider) 'cider)
+ (t nil))
+ "Backend used to evaluate ClojureScript code blocks."
+ :group 'org-babel
+ :package-version '(Org . "9.7")
+ :type '(choice
(const :tag "nbb" nbb)
+ (const :tag "cider" cider)
(const :tag "Not configured yet" nil)))
(defcustom org-babel-clojure-default-ns "user"
@@ -100,19 +114,29 @@ defcustom org-babel-clojure-default-ns
:group 'org-babel)
(defcustom ob-clojure-babashka-command (executable-find "bb")
- "Path to the babashka executable."
+ "Babashka command used by the Clojure `babashka' backend."
:type '(choice file (const nil))
:group 'org-babel
:package-version '(Org . "9.6"))
-(defcustom ob-clojure-nbb-command (executable-find "nbb")
- "Path to the nbb executable."
- :type '(choice file (const nil))
+(defcustom ob-clojure-nbb-command (or (executable-find "nbb")
+ (when-let (npx (executable-find "npx"))
+ (concat npx " nbb")))
+ "Nbb command used by the ClojureScript `nbb' backend."
+ :type '(choice string (const nil))
:group 'org-babel
- :package-version '(Org . "9.6"))
+ :package-version '(Org . "9.7"))
-(defun org-babel-expand-body:clojure (body params)
- "Expand BODY according to PARAMS, return the expanded body."
+(defcustom ob-clojure-cli-command (when-let (cmd (executable-find "clojure"))
+ (concat cmd " -M"))
+ "Clojure CLI command used by the Clojure `clojure-cli' backend."
+ :type 'string
+ :group 'org-babel
+ :package-version '(Org . "9.7"))
+
+(defun org-babel-expand-body:clojure (body params &optional cljs-p)
+ "Expand BODY according to PARAMS, return the expanded body.
+When CLJS-P is non-nil, expand in a cljs context instead of clj."
(let* ((vars (org-babel--get-vars params))
(backend-override (cdr (assq :backend params)))
(org-babel-clojure-backend
@@ -146,10 +170,26 @@ defun org-babel-expand-body:clojure
vars
"\n ")
body))))))
- (if (or (member "code" result-params)
- (member "pp" result-params))
- (format "(clojure.pprint/pprint (do %s))" body)
- body)))
+ ;; If the result param is set to "output" we don't have to do
+ ;; anything special and just let the backend handle everything
+ (if (member "output" result-params)
+ body
+
+ ;; If the result is not "output" (i.e. it's "value"), disable
+ ;; stdout output and print the last returned value. Use pprint
+ ;; instead of prn when results param is "pp" or "code".
+ (concat
+ (if (or (member "code" result-params)
+ (member "pp" result-params))
+ (concat (if cljs-p
+ "(require '[cljs.pprint :refer [pprint]])"
+ "(require '[clojure.pprint :refer [pprint]])")
+ " (pprint ")
+ "(prn ")
+ (if cljs-p
+ "(binding [cljs.core/*print-fn* (constantly nil)]"
+ "(binding [*out* (java.io.StringWriter.)]")
+ body "))"))))
(defvar ob-clojure-inf-clojure-filter-out)
(defvar ob-clojure-inf-clojure-tmp-output)
@@ -225,32 +265,19 @@ defun ob-clojure-eval-with-inf-clojure
s))
(reverse ob-clojure-inf-clojure-tmp-output)))))
-(defun ob-clojure-eval-with-cider (expanded params)
- "Evaluate EXPANDED code block with PARAMS using cider."
+(defun ob-clojure-eval-with-cider (expanded params &optional cljs-p)
+ "Evaluate EXPANDED code block with PARAMS using cider.
+When CLJS-P is non-nil, use a cljs connection instead of clj."
(org-require-package 'cider "Cider")
- (let ((connection (cider-current-connection (cdr (assq :target params))))
- (result-params (cdr (assq :result-params params)))
- result0)
+ (let ((connection (cider-current-connection (if cljs-p "cljs" "clj"))))
(unless connection (sesman-start-session 'CIDER))
(if (not connection)
;; Display in the result instead of using `user-error'
- (setq result0 "Please reevaluate when nREPL is connected")
- (ob-clojure-with-temp-expanded expanded params
- (let ((response (nrepl-sync-request:eval exp connection)))
- (push (or (nrepl-dict-get response "root-ex")
- (nrepl-dict-get response "ex")
- (nrepl-dict-get
- response (if (or (member "output" result-params)
- (member "pp" result-params))
- "out"
- "value")))
- result0)))
- (ob-clojure-string-or-list
- ;; Filter out s-expressions that return nil (string "nil"
- ;; from nrepl eval) or comment forms (actual nil from nrepl)
- (reverse (delete "" (mapcar (lambda (r)
- (replace-regexp-in-string "nil" "" (or r "")))
- result0)))))))
+ "Please reevaluate when nREPL is connected"
+ (let ((response (nrepl-sync-request:eval expanded connection)))
+ (or (nrepl-dict-get response "root-ex")
+ (nrepl-dict-get response "ex")
+ (nrepl-dict-get response "out"))))))
(defun ob-clojure-eval-with-slime (expanded params)
"Evaluate EXPANDED code block with PARAMS using slime."
@@ -262,39 +289,54 @@ defun ob-clojure-eval-with-slime
,(buffer-substring-no-properties (point-min) (point-max)))
(cdr (assq :package params)))))
-(defun ob-clojure-eval-with-babashka (bb expanded)
- "Evaluate EXPANDED code block using BB (babashka or nbb)."
- (let ((script-file (org-babel-temp-file "clojure-bb-script-" ".clj")))
+(defun ob-clojure-eval-with-cmd (cmd expanded)
+ "Evaluate EXPANDED code block using CMD (babashka, clojure or nbb)."
+ (let ((script-file (org-babel-temp-file "clojure-cmd-script-" ".clj")))
(with-temp-file script-file
(insert expanded))
(org-babel-eval
- (format "%s %s" bb (org-babel-process-file-name script-file))
+ (format "%s %s" cmd (org-babel-process-file-name script-file))
"")))
-(defun org-babel-execute:clojure (body params)
- "Execute the BODY block of Clojure code with PARAMS using Babel."
+(defun org-babel-execute:clojure (body params &optional cljs-p)
+ "Execute the BODY block of Clojure code with PARAMS using Babel.
+When CLJS-P is non-nil, execute with a ClojureScript backend
+instead of Clojure."
(let* ((backend-override (cdr (assq :backend params)))
(org-babel-clojure-backend
(cond
(backend-override (intern backend-override))
- (org-babel-clojure-backend org-babel-clojure-backend)
- (t (user-error "You need to customize `org-babel-clojure-backend'
-or set the `:backend' header argument")))))
- (let* ((expanded (org-babel-expand-body:clojure body params))
+ (org-babel-clojure-backend (if cljs-p
+ org-babel-clojurescript-backend
+ org-babel-clojure-backend))
+ (t (user-error "You need to customize `%S'
+or set the `:backend' header argument"
+ (if cljs-p
+ org-babel-clojurescript-backend
+ org-babel-clojure-backend)))))
+ ;; We allow a Clojure source block to be evaluated with the
+ ;; nbb backend and therefore have to expand the body with
+ ;; ClojureScript syntax when we either evaluate a
+ ;; ClojureScript source block or use the nbb backend.
+ (cljs-p (or cljs-p (eq org-babel-clojure-backend 'nbb))))
+ (let* ((expanded (org-babel-expand-body:clojure body params cljs-p))
(result-params (cdr (assq :result-params params)))
result)
(setq result
(cond
((eq org-babel-clojure-backend 'inf-clojure)
(ob-clojure-eval-with-inf-clojure expanded params))
+ ((eq org-babel-clojure-backend 'clojure-cli)
+ (ob-clojure-eval-with-cmd ob-clojure-cli-command expanded))
((eq org-babel-clojure-backend 'babashka)
- (ob-clojure-eval-with-babashka ob-clojure-babashka-command expanded))
+ (ob-clojure-eval-with-cmd ob-clojure-babashka-command expanded))
((eq org-babel-clojure-backend 'nbb)
- (ob-clojure-eval-with-babashka ob-clojure-nbb-command expanded))
+ (ob-clojure-eval-with-cmd ob-clojure-nbb-command expanded))
((eq org-babel-clojure-backend 'cider)
- (ob-clojure-eval-with-cider expanded params))
+ (ob-clojure-eval-with-cider expanded params cljs-p))
((eq org-babel-clojure-backend 'slime)
- (ob-clojure-eval-with-slime expanded params))))
+ (ob-clojure-eval-with-slime expanded params))
+ (t (user-error "Invalid backend"))))
(org-babel-result-cond result-params
result
(condition-case nil (org-babel-script-escape result)
@@ -302,7 +344,7 @@ defun org-babel-execute:clojure
(defun org-babel-execute:clojurescript (body params)
"Evaluate BODY with PARAMS as ClojureScript code."
- (org-babel-execute:clojure body (cons '(:target . "cljs") params)))
+ (org-babel-execute:clojure body params t))
(provide 'ob-clojure)
diff --git a/lisp/org-compat.el b/lisp/org-compat.el
index fadb51df6..c47a4e8c2 100644
--- a/lisp/org-compat.el
+++ b/lisp/org-compat.el
@@ -71,6 +71,7 @@
(declare-function outline-next-heading "outline" ())
(declare-function speedbar-line-directory "speedbar" (&optional depth))
(declare-function table--at-cell-p "table" (position &optional object at-column))
+(declare-function ob-clojure-eval-with-cmd "ob-clojure" (cmd expanded))
(declare-function org-fold-folded-p "org-fold" (&optional pos spec-or-alias))
(declare-function org-fold-hide-sublevels "org-fold" (levels))
(declare-function org-fold-hide-subtree "org-fold" ())
@@ -1127,6 +1128,9 @@ defconst org-babel-python-mode
"Only the built-in Python mode is supported in ob-python now."
"9.7")
+(define-obsolete-function-alias 'ob-clojure-eval-with-babashka
+ #'ob-clojure-eval-with-cmd "9.7")
+
;;;; Obsolete link types
(eval-after-load 'ol
--
2.39.2
^ permalink raw reply related [relevance 6%]
* Re: Suggestion to increase usefulness of TAB key / 'org-cycle' function
@ 2023-04-30 17:17 6% ` Philipp Kiefer
0 siblings, 0 replies; 25+ results
From: Philipp Kiefer @ 2023-04-30 17:17 UTC (permalink / raw)
To: Dr. Arne Babenhauserheide; +Cc: emacs-orgmode
On 28.04.2023 19:41, Dr. Arne Babenhauserheide wrote:
> Philipp Kiefer <phil.kiefer@gmail.com> writes:
>> My suggestion was aimed at improving the out-of-the-box experience of (new) Org users by extending the usefulness of 'org-cycle' by
>> folding the subtree at point from anywhere inside it that is not itself a parent item rather than doing nothing at all in those positions.
>> I've used two flavours of dedicated outlining software for many years and both have easy shortcuts to fold the current subtree from
>> any position - it is a frequently used action.
> Do I understand you correctly that you mean tab should cycle visibility
> in this case?
>
> * headline
> some text
> CURSOR IS HERE
> - a list
Yes, I suggested that in those cases, org-cycle should fold the subtree
point is in, i. e. fold up to the next parent heading above.
> For me tab is useful as it is, because it indents whatever I am writing
> right now.
>
> That could be a list-item or a source-block or a verse.
>
> Org is not just for outlining but also for full-blown writing, and that
> would be disrupted if tab were to fold the entry away that I’m currently
> writing in.
Hm, for me, TAB does not currently seem to do any indenting anywhere in
an Org file. Have you changed anything from the default configuration?
Or maybe I did and forgot about it... But I can find any reference to /
binding for unmodified tab in my init.el. If so, is this indenting
handled by 'org-cycle' or is the binding of Tab to 'org-cycle' somehow
selective based on where in an Org file point is positioned?
If people use tab for indentation in Org out of the box when not on
headings (which it has never done for me, I think), my suggestion would
indeed be moot.
> That said: C-c C-t or M-x outline-hide-body
I tried out this command, but it does not do what I have in mind
(folding subtrees from a non-parent position, not hiding non-heading text).
If tab really does indent in Org files in the default configuration when
not on a heading, I'd limit my suggestion to the following:
Make 'org-fold-hide-subtree' and / or 'outline-hide-subtree' work from
anywhere inside a subtree that is not itself a parent heading - not just
when positioned on the parent heading of the subtree point is in.
Best,
Philipp
^ permalink raw reply [relevance 6%]
Results 1-25 of 25 | reverse | options above
-- pct% links below jump to the message on this page, permalinks otherwise --
2021-05-03 17:28 [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers Bastien
2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko
2022-01-29 11:37 13% ` [PATCH 02/35] Separate folding functions from org.el into new library: org-fold Ihor Radchenko
2022-01-29 11:38 12% ` [PATCH 09/35] Rename old function call to use org-fold Ihor Radchenko
2022-01-29 11:38 12% ` [PATCH 17/35] org-compat: Work around some third-party packages using outline-* functions Ihor Radchenko
2022-04-20 13:23 [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch Ihor Radchenko
2022-04-20 13:24 13% ` [PATCH v2 02/38] Separate folding functions from org.el into new library: org-fold Ihor Radchenko
2022-04-20 13:25 12% ` [PATCH v2 09/38] Rename old function call to use org-fold--- Ihor Radchenko
2022-04-20 13:26 12% ` [PATCH v2 17/38] org-compat: Work around some third-party packages using outline-* functions Ihor Radchenko
2022-05-05 15:55 [Style] Shouldn’t the macros in org-fold-core have (indent 0) Anders Johansson
2022-05-07 3:46 5% ` [PATCH] " Ihor Radchenko
2022-05-11 16:52 How to stop results being hidden when using ":results drawer"? Richard Stanton
2022-05-12 10:14 ` Ihor Radchenko
2022-05-12 13:07 ` John Kitchin
2022-05-13 12:11 ` Ihor Radchenko
2022-05-13 12:46 ` John Kitchin
2022-05-13 13:35 9% ` [PATCH] " Ihor Radchenko
2022-05-30 23:04 BUG: org cycling regression when using the legacy folding style overlays Kaushal Modi
2022-05-30 23:46 ` Ihor Radchenko
2022-05-31 3:07 6% ` Kaushal Modi
2023-02-22 7:29 12% PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode Karl Fogel
2023-02-22 15:57 7% ` Max Nikulin
2023-02-22 17:01 12% ` Karl Fogel
2023-02-23 2:35 7% ` Max Nikulin
2023-02-23 4:48 7% ` Samuel Wales
2023-02-25 8:01 7% ` Key binding in help (was: Re: PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode.) Max Nikulin
2023-02-25 23:32 7% ` Samuel Wales
2023-03-08 15:27 7% ` Max Nikulin
2023-02-23 19:02 6% ` PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode Karl Fogel
2023-02-25 0:13 10% ` Karl Fogel
2023-02-25 11:26 6% ` Max Nikulin
2023-02-25 17:33 14% ` Karl Fogel
2023-03-04 6:02 4% PATCH] orgcard.tex: Fix `org-force-cycle-archived' binding Max Nikulin
2023-03-09 15:40 [patch] ob-clojure: Fix results output Daniel Kraus
2023-03-10 12:35 ` Ihor Radchenko
2023-03-13 14:01 ` Daniel Kraus
2023-03-14 12:35 ` Ihor Radchenko
2023-03-14 13:38 ` Daniel Kraus
2023-03-14 14:27 6% ` Daniel Kraus
2023-03-15 10:20 ` Ihor Radchenko
2023-03-15 11:22 6% ` Daniel Kraus
2023-04-28 8:49 Suggestion to increase usefulness of TAB key / 'org-cycle' function Philipp Kiefer
2023-04-28 9:45 ` Fraga, Eric
2023-04-28 15:17 ` Philipp Kiefer
2023-04-28 17:41 ` Dr. Arne Babenhauserheide
2023-04-30 17:17 6% ` Philipp Kiefer
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).