branch: externals/org
commit 004ac14a5bacf311e3d0f14a7cd8345a49980bef
Author: Ihor Radchenko <yanta...@gmail.com>
Commit: Ihor Radchenko <yanta...@gmail.com>
Fix compatibility with Emacs 26
* lisp/org-compat.el (org-file-name-concat): Do not use
`string-empty-p'.
(combine-change-calls): Create a stub when `combine-change-calls' were
not yet available.
(org-replace-buffer-contents): Add compatibility function for
`replace-buffer-contents'.
* lisp/org-element.el (org-element--current-element): Do not use
`if-let'.
* lisp/org-persist.el (org-persist-gc): Do not use `when-let'.
* lisp/org-plot.el (org-plot/gnuplot): Do not use `if-let'.
* lisp/org-src.el (org-edit-src-save, org-edit-src-exit): Use
`org-replace-buffer-contents'.
* lisp/org.el (org-narrow-to-subtree, org--property-local-values,
org-entry-get-with-inheritance, org-in-commented-heading-p,
org-up-heading-safe, org-goto-first-child): Do not use
`if-let'/`when-let'.
* testing/org-test.el (org-test-at-time): Fallback to old
`decode-time' specification in older Emacs.
---
lisp/org-compat.el | 13 +-
lisp/org-element.el | 365 ++++++++++++++++++++++++++--------------------------
lisp/org-persist.el | 21 +--
lisp/org-plot.el | 7 +-
lisp/org-src.el | 8 +-
lisp/org.el | 322 ++++++++++++++++++++++-----------------------
testing/org-test.el | 9 +-
7 files changed, 385 insertions(+), 360 deletions(-)
diff --git a/lisp/org-compat.el b/lisp/org-compat.el
index 737f628..4019b06 100644
--- a/lisp/org-compat.el
+++ b/lisp/org-compat.el
@@ -90,7 +90,7 @@ inserted before contatenating."
(delq nil
(mapcar
(lambda (str)
- (when (and str (not (string-empty-p str))
+ (when (and str (not (seq-empty-p str))
(string-match "\\(.+\\)/?" str))
(match-string 1 str)))
(cons directory components)))
@@ -106,6 +106,17 @@ inserted before contatenating."
;;; Emacs < 27.1 compatibility
+(unless (fboundp 'combine-change-calls)
+ ;; A stub when `combine-change-calls' was not yet there.
+ (defmacro combine-change-calls (_beg _end &rest body)
+ (declare (debug (form form def-body)) (indent 2))
+ `(progn ,@body)))
+
+(if (version< emacs-version "27.1")
+ (defsubst org-replace-buffer-contents (source &optional _max-secs
_max-costs)
+ (replace-buffer-contents source))
+ (defalias 'org-replace-buffer-contents #'replace-buffer-contents))
+
(unless (fboundp 'proper-list-p)
;; `proper-list-p' was added in Emacs 27.1. The function below is
;; taken from Emacs subr.el 200195e824b^.
diff --git a/lisp/org-element.el b/lisp/org-element.el
index bcf5c62..42f97b4 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -4138,189 +4138,190 @@ not checked.
This function assumes point is always at the beginning of the
element it has to parse."
- (if-let* ((element (and (not (buffer-narrowed-p))
- (org-element--cache-active-p)
- (not org-element--cache-sync-requests)
- (org-element--cache-find (point) t)))
- (element (progn (while (and element
- (not (and (eq (point)
(org-element-property :begin element))
- (eq mode (org-element-property
:mode element)))))
- (setq element (org-element-property :parent
element)))
- element))
- (old-element element)
- (element (when
- (pcase (org-element-property :granularity element)
- (`nil t)
- (`object t)
- (`element (not (memq granularity '(nil object))))
- (`greater-element (not (memq granularity '(nil
object element))))
- (`headline (eq granularity 'headline)))
- element)))
- element
- (save-excursion
- (let ((case-fold-search t)
- ;; Determine if parsing depth allows for secondary strings
- ;; parsing. It only applies to elements referenced in
- ;; `org-element-secondary-value-alist'.
- (raw-secondary-p (and granularity (not (eq granularity 'object))))
- result)
- (setq
- result
- (cond
- ;; Item.
- ((eq mode 'item)
- (org-element-item-parser limit structure raw-secondary-p))
- ;; Table Row.
- ((eq mode 'table-row) (org-element-table-row-parser limit))
- ;; Node Property.
- ((eq mode 'node-property) (org-element-node-property-parser limit))
- ;; Headline.
- ((org-with-limited-levels (org-at-heading-p))
- (org-element-headline-parser limit raw-secondary-p))
- ;; Sections (must be checked after headline).
- ((eq mode 'section) (org-element-section-parser limit))
- ((eq mode 'first-section)
- (org-element-section-parser
- (or (save-excursion (org-with-limited-levels
(outline-next-heading)))
- limit)))
- ;; Comments.
- ((looking-at "^[ \t]*#\\(?: \\|$\\)")
- (org-element-comment-parser limit))
- ;; Planning.
- ((and (eq mode 'planning)
- (eq ?* (char-after (line-beginning-position 0)))
- (looking-at org-planning-line-re))
- (org-element-planning-parser limit))
- ;; Property drawer.
- ((and (pcase mode
- (`planning (eq ?* (char-after (line-beginning-position 0))))
- ((or `property-drawer `top-comment)
- (save-excursion
- (beginning-of-line 0)
- (not (looking-at "[[:blank:]]*$"))))
- (_ nil))
- (looking-at org-property-drawer-re))
- (org-element-property-drawer-parser limit))
- ;; When not at bol, point is at the beginning of an item or
- ;; a footnote definition: next item is always a paragraph.
- ((not (bolp)) (org-element-paragraph-parser limit (list (point))))
- ;; Clock.
- ((looking-at org-clock-line-re) (org-element-clock-parser limit))
- ;; Inlinetask.
- ((looking-at "^\\*+ ")
- (org-element-inlinetask-parser limit raw-secondary-p))
- ;; From there, elements can have affiliated keywords.
- (t (let ((affiliated (org-element--collect-affiliated-keywords
- limit (memq granularity '(nil object)))))
- (cond
- ;; Jumping over affiliated keywords put point off-limits.
- ;; Parse them as regular keywords.
- ((and (cdr affiliated) (>= (point) limit))
- (goto-char (car affiliated))
- (org-element-keyword-parser limit nil))
- ;; LaTeX Environment.
- ((looking-at org-element--latex-begin-environment)
- (org-element-latex-environment-parser limit affiliated))
- ;; Drawer.
- ((looking-at org-drawer-regexp)
- (org-element-drawer-parser limit affiliated))
- ;; Fixed Width
- ((looking-at "[ \t]*:\\( \\|$\\)")
- (org-element-fixed-width-parser limit affiliated))
- ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
- ;; Keywords.
- ((looking-at "[ \t]*#\\+")
- (goto-char (match-end 0))
+ (let* ((element (and (not (buffer-narrowed-p))
+ (org-element--cache-active-p)
+ (not org-element--cache-sync-requests)
+ (org-element--cache-find (point) t)))
+ (element (progn (while (and element
+ (not (and (eq (point)
(org-element-property :begin element))
+ (eq mode (org-element-property
:mode element)))))
+ (setq element (org-element-property :parent
element)))
+ element))
+ (old-element element)
+ (element (when
+ (pcase (org-element-property :granularity element)
+ (`nil t)
+ (`object t)
+ (`element (not (memq granularity '(nil object))))
+ (`greater-element (not (memq granularity '(nil object
element))))
+ (`headline (eq granularity 'headline)))
+ element)))
+ (if element
+ element
+ (save-excursion
+ (let ((case-fold-search t)
+ ;; Determine if parsing depth allows for secondary strings
+ ;; parsing. It only applies to elements referenced in
+ ;; `org-element-secondary-value-alist'.
+ (raw-secondary-p (and granularity (not (eq granularity 'object))))
+ result)
+ (setq
+ result
+ (cond
+ ;; Item.
+ ((eq mode 'item)
+ (org-element-item-parser limit structure raw-secondary-p))
+ ;; Table Row.
+ ((eq mode 'table-row) (org-element-table-row-parser limit))
+ ;; Node Property.
+ ((eq mode 'node-property) (org-element-node-property-parser limit))
+ ;; Headline.
+ ((org-with-limited-levels (org-at-heading-p))
+ (org-element-headline-parser limit raw-secondary-p))
+ ;; Sections (must be checked after headline).
+ ((eq mode 'section) (org-element-section-parser limit))
+ ((eq mode 'first-section)
+ (org-element-section-parser
+ (or (save-excursion (org-with-limited-levels
(outline-next-heading)))
+ limit)))
+ ;; Comments.
+ ((looking-at "^[ \t]*#\\(?: \\|$\\)")
+ (org-element-comment-parser limit))
+ ;; Planning.
+ ((and (eq mode 'planning)
+ (eq ?* (char-after (line-beginning-position 0)))
+ (looking-at org-planning-line-re))
+ (org-element-planning-parser limit))
+ ;; Property drawer.
+ ((and (pcase mode
+ (`planning (eq ?* (char-after (line-beginning-position 0))))
+ ((or `property-drawer `top-comment)
+ (save-excursion
+ (beginning-of-line 0)
+ (not (looking-at "[[:blank:]]*$"))))
+ (_ nil))
+ (looking-at org-property-drawer-re))
+ (org-element-property-drawer-parser limit))
+ ;; When not at bol, point is at the beginning of an item or
+ ;; a footnote definition: next item is always a paragraph.
+ ((not (bolp)) (org-element-paragraph-parser limit (list (point))))
+ ;; Clock.
+ ((looking-at org-clock-line-re) (org-element-clock-parser limit))
+ ;; Inlinetask.
+ ((looking-at "^\\*+ ")
+ (org-element-inlinetask-parser limit raw-secondary-p))
+ ;; From there, elements can have affiliated keywords.
+ (t (let ((affiliated (org-element--collect-affiliated-keywords
+ limit (memq granularity '(nil object)))))
(cond
- ((looking-at "BEGIN_\\(\\S-+\\)")
- (beginning-of-line)
- (funcall (pcase (upcase (match-string 1))
- ("CENTER" #'org-element-center-block-parser)
- ("COMMENT" #'org-element-comment-block-parser)
- ("EXAMPLE" #'org-element-example-block-parser)
- ("EXPORT" #'org-element-export-block-parser)
- ("QUOTE" #'org-element-quote-block-parser)
- ("SRC" #'org-element-src-block-parser)
- ("VERSE" #'org-element-verse-block-parser)
- (_ #'org-element-special-block-parser))
- limit
- affiliated))
- ((looking-at "CALL:")
- (beginning-of-line)
- (org-element-babel-call-parser limit affiliated))
- ((looking-at "BEGIN:? ")
- (beginning-of-line)
- (org-element-dynamic-block-parser limit affiliated))
- ((looking-at "\\S-+:")
- (beginning-of-line)
- (org-element-keyword-parser limit affiliated))
- (t
- (beginning-of-line)
- (org-element-paragraph-parser limit affiliated))))
- ;; Footnote Definition.
- ((looking-at org-footnote-definition-re)
- (org-element-footnote-definition-parser limit affiliated))
- ;; Horizontal Rule.
- ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
- (org-element-horizontal-rule-parser limit affiliated))
- ;; Diary Sexp.
- ((looking-at "%%(")
- (org-element-diary-sexp-parser limit affiliated))
- ;; Table.
- ((or (looking-at "[ \t]*|")
- ;; There is no strict definition of a table.el
- ;; table. Try to prevent false positive while being
- ;; quick.
- (let ((rule-regexp
- (rx (zero-or-more (any " \t"))
- "+"
- (one-or-more (one-or-more "-") "+")
- (zero-or-more (any " \t"))
- eol))
- (non-table.el-line
- (rx bol
- (zero-or-more (any " \t"))
- (or eol (not (any "+| \t")))))
- (next (line-beginning-position 2)))
- ;; Start with a full rule.
- (and
- (looking-at rule-regexp)
- (< next limit) ;no room for a table.el table
- (save-excursion
- (end-of-line)
- (cond
- ;; Must end with a full rule.
- ((not (re-search-forward non-table.el-line limit
'move))
- (if (bolp) (forward-line -1) (beginning-of-line))
- (looking-at rule-regexp))
- ;; Ignore pseudo-tables with a single
- ;; rule.
- ((= next (line-beginning-position))
- nil)
- ;; Must end with a full rule.
- (t
- (forward-line -1)
- (looking-at rule-regexp)))))))
- (org-element-table-parser limit affiliated))
- ;; List.
- ((looking-at (org-item-re))
- (org-element-plain-list-parser
- limit affiliated
- (or structure (org-element--list-struct limit))))
- ;; Default element: Paragraph.
- (t (org-element-paragraph-parser limit affiliated)))))))
- (when result
- (org-element-put-property result :mode mode)
- (org-element-put-property result :granularity granularity))
- (when (and (not (buffer-narrowed-p))
- (org-element--cache-active-p)
- (not org-element--cache-sync-requests)
- add-to-cache)
- (if (not old-element)
- (setq result (org-element--cache-put result))
- (org-element-set-element old-element result)
- (setq result old-element)))
- result))))
+ ;; Jumping over affiliated keywords put point off-limits.
+ ;; Parse them as regular keywords.
+ ((and (cdr affiliated) (>= (point) limit))
+ (goto-char (car affiliated))
+ (org-element-keyword-parser limit nil))
+ ;; LaTeX Environment.
+ ((looking-at org-element--latex-begin-environment)
+ (org-element-latex-environment-parser limit affiliated))
+ ;; Drawer.
+ ((looking-at org-drawer-regexp)
+ (org-element-drawer-parser limit affiliated))
+ ;; Fixed Width
+ ((looking-at "[ \t]*:\\( \\|$\\)")
+ (org-element-fixed-width-parser limit affiliated))
+ ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
+ ;; Keywords.
+ ((looking-at "[ \t]*#\\+")
+ (goto-char (match-end 0))
+ (cond
+ ((looking-at "BEGIN_\\(\\S-+\\)")
+ (beginning-of-line)
+ (funcall (pcase (upcase (match-string 1))
+ ("CENTER" #'org-element-center-block-parser)
+ ("COMMENT" #'org-element-comment-block-parser)
+ ("EXAMPLE" #'org-element-example-block-parser)
+ ("EXPORT" #'org-element-export-block-parser)
+ ("QUOTE" #'org-element-quote-block-parser)
+ ("SRC" #'org-element-src-block-parser)
+ ("VERSE" #'org-element-verse-block-parser)
+ (_ #'org-element-special-block-parser))
+ limit
+ affiliated))
+ ((looking-at "CALL:")
+ (beginning-of-line)
+ (org-element-babel-call-parser limit affiliated))
+ ((looking-at "BEGIN:? ")
+ (beginning-of-line)
+ (org-element-dynamic-block-parser limit affiliated))
+ ((looking-at "\\S-+:")
+ (beginning-of-line)
+ (org-element-keyword-parser limit affiliated))
+ (t
+ (beginning-of-line)
+ (org-element-paragraph-parser limit affiliated))))
+ ;; Footnote Definition.
+ ((looking-at org-footnote-definition-re)
+ (org-element-footnote-definition-parser limit affiliated))
+ ;; Horizontal Rule.
+ ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
+ (org-element-horizontal-rule-parser limit affiliated))
+ ;; Diary Sexp.
+ ((looking-at "%%(")
+ (org-element-diary-sexp-parser limit affiliated))
+ ;; Table.
+ ((or (looking-at "[ \t]*|")
+ ;; There is no strict definition of a table.el
+ ;; table. Try to prevent false positive while being
+ ;; quick.
+ (let ((rule-regexp
+ (rx (zero-or-more (any " \t"))
+ "+"
+ (one-or-more (one-or-more "-") "+")
+ (zero-or-more (any " \t"))
+ eol))
+ (non-table.el-line
+ (rx bol
+ (zero-or-more (any " \t"))
+ (or eol (not (any "+| \t")))))
+ (next (line-beginning-position 2)))
+ ;; Start with a full rule.
+ (and
+ (looking-at rule-regexp)
+ (< next limit) ;no room for a table.el table
+ (save-excursion
+ (end-of-line)
+ (cond
+ ;; Must end with a full rule.
+ ((not (re-search-forward non-table.el-line limit
'move))
+ (if (bolp) (forward-line -1) (beginning-of-line))
+ (looking-at rule-regexp))
+ ;; Ignore pseudo-tables with a single
+ ;; rule.
+ ((= next (line-beginning-position))
+ nil)
+ ;; Must end with a full rule.
+ (t
+ (forward-line -1)
+ (looking-at rule-regexp)))))))
+ (org-element-table-parser limit affiliated))
+ ;; List.
+ ((looking-at (org-item-re))
+ (org-element-plain-list-parser
+ limit affiliated
+ (or structure (org-element--list-struct limit))))
+ ;; Default element: Paragraph.
+ (t (org-element-paragraph-parser limit affiliated)))))))
+ (when result
+ (org-element-put-property result :mode mode)
+ (org-element-put-property result :granularity granularity))
+ (when (and (not (buffer-narrowed-p))
+ (org-element--cache-active-p)
+ (not org-element--cache-sync-requests)
+ add-to-cache)
+ (if (not old-element)
+ (setq result (org-element--cache-put result))
+ (org-element-set-element old-element result)
+ (setq result old-element)))
+ result)))))
;; Most elements can have affiliated keywords. When looking for an
diff --git a/lisp/org-persist.el b/lisp/org-persist.el
index 6c054c2..78347e6 100644
--- a/lisp/org-persist.el
+++ b/lisp/org-persist.el
@@ -249,16 +249,17 @@ When BUFFER is `all', unregister VAR in all buffers."
"Remove stored data for not existing files or unregistered variables."
(let (new-index)
(dolist (index org-persist--index)
- (when-let ((file (plist-get index :path))
- (persist-file (org-file-name-concat
- org-persist-path
- (plist-get index :persist-file))))
- (if (file-exists-p file)
- (push index new-index)
- (when (file-exists-p persist-file)
- (delete-file persist-file)
- (when (org-directory-empty-p (file-name-directory persist-file))
- (delete-directory (file-name-directory persist-file)))))))
+ (let ((file (plist-get index :path))
+ (persist-file (org-file-name-concat
+ org-persist-path
+ (plist-get index :persist-file))))
+ (when (and file persist-file)
+ (if (file-exists-p file)
+ (push index new-index)
+ (when (file-exists-p persist-file)
+ (delete-file persist-file)
+ (when (org-directory-empty-p (file-name-directory persist-file))
+ (delete-directory (file-name-directory persist-file))))))))
(setq org-persist--index (nreverse new-index))))
(add-hook 'kill-emacs-hook #'org-persist-gc)
diff --git a/lisp/org-plot.el b/lisp/org-plot.el
index 4f14c7d..815cc6f 100644
--- a/lisp/org-plot.el
+++ b/lisp/org-plot.el
@@ -682,9 +682,10 @@ line directly before or after the table."
(looking-at "[[:space:]]*#\\+"))
(setf params (org-plot/collect-options params))))
;; Dump table to datafile
- (if-let ((dump-func (plist-get type :data-dump)))
- (funcall dump-func table data-file num-cols params)
- (org-plot/gnuplot-to-data table data-file params))
+ (let ((dump-func (plist-get type :data-dump)))
+ (if dump-func
+ (funcall dump-func table data-file num-cols params)
+ (org-plot/gnuplot-to-data table data-file params)))
;; Check type of ind column (timestamp? text?)
(when (plist-get params :check-ind-type)
(let* ((ind (1- (plist-get params :ind)))
diff --git a/lisp/org-src.el b/lisp/org-src.el
index 23e1964..f1948bf 100644
--- a/lisp/org-src.el
+++ b/lisp/org-src.el
@@ -1241,7 +1241,7 @@ EVENT is passed to `mouse-set-point'."
(insert (with-current-buffer write-back-buf
(buffer-string))))
(save-restriction
(narrow-to-region beg end)
- (replace-buffer-contents write-back-buf 0.1 nil)
+ (org-replace-buffer-contents write-back-buf 0.1 nil)
(goto-char (point-max))))
(when (and expecting-bol (not (bolp))) (insert "\n")))
(kill-buffer write-back-buf)
@@ -1278,8 +1278,8 @@ EVENT is passed to `mouse-set-point'."
(org-with-wide-buffer
(when (and write-back
(not (equal (buffer-substring beg end)
- (with-current-buffer write-back-buf
- (buffer-string)))))
+ (with-current-buffer write-back-buf
+ (buffer-string)))))
(undo-boundary)
(goto-char beg)
(let ((expecting-bol (bolp)))
@@ -1289,7 +1289,7 @@ EVENT is passed to `mouse-set-point'."
(buffer-string))))
(save-restriction
(narrow-to-region beg end)
- (replace-buffer-contents write-back-buf 0.1 nil)
+ (org-replace-buffer-contents write-back-buf 0.1 nil)
(goto-char (point-max))))
(when (and expecting-bol (not (bolp))) (insert "\n")))))
(when write-back-buf (kill-buffer write-back-buf))
diff --git a/lisp/org.el b/lisp/org.el
index 75ddfa8..1b8f0e6 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -7918,14 +7918,15 @@ If yes, remember the marker and the distance to BEG."
"Narrow buffer to the current subtree."
(interactive)
(if (org-element--cache-active-p)
- (if-let* ((heading (org-element-lineage
- (or element (org-element-at-point))
- '(headline) t))
- (end (org-element-property :end heading)))
- (narrow-to-region (org-element-property :begin heading)
- (if (= end (point-max))
- end (1- end)))
- (signal 'outline-before-first-heading nil))
+ (let* ((heading (org-element-lineage
+ (or element (org-element-at-point))
+ '(headline) t))
+ (end (org-element-property :end heading)))
+ (if (and heading end)
+ (narrow-to-region (org-element-property :begin heading)
+ (if (= end (point-max))
+ end (1- end)))
+ (signal 'outline-before-first-heading nil)))
(save-excursion
(save-match-data
(org-with-limited-levels
@@ -13153,34 +13154,35 @@ Value is a list whose car is the base value for
PROPERTY and cdr
a list of accumulated values. Return nil if neither is found in
the entry. Also return nil when PROPERTY is set to \"nil\",
unless LITERAL-NIL is non-nil."
- (if-let ((element (or element
- (and (org-element--cache-active-p)
- (org-element-at-point nil 'cached)))))
- (let* ((element (org-element-lineage element '(headline org-data
inlinetask) 'with-self))
- (base-value (org-element-property (intern (concat ":" (upcase
property))) element))
- (base-value (if literal-nil base-value (org-not-nil base-value)))
- (extra-value (org-element-property (intern (concat ":" (upcase
property) "+")) element))
- (extra-value (if (listp extra-value) extra-value (list
extra-value)))
- (value (cons base-value extra-value)))
- (and (not (equal value '(nil))) value))
- (let ((range (org-get-property-block)))
- (when range
- (goto-char (car range))
- (let* ((case-fold-search t)
- (end (cdr range))
- (value
- ;; Base value.
- (save-excursion
- (let ((v (and (re-search-forward
- (org-re-property property nil t) end t)
- (match-string-no-properties 3))))
- (list (if literal-nil v (org-not-nil v)))))))
- ;; Find additional values.
- (let* ((property+ (org-re-property (concat property "+") nil t)))
- (while (re-search-forward property+ end t)
- (push (match-string-no-properties 3) value)))
- ;; Return final values.
- (and (not (equal value '(nil))) (nreverse value)))))))
+ (let ((element (or element
+ (and (org-element--cache-active-p)
+ (org-element-at-point nil 'cached)))))
+ (if element
+ (let* ((element (org-element-lineage element '(headline org-data
inlinetask) 'with-self))
+ (base-value (org-element-property (intern (concat ":" (upcase
property))) element))
+ (base-value (if literal-nil base-value (org-not-nil
base-value)))
+ (extra-value (org-element-property (intern (concat ":" (upcase
property) "+")) element))
+ (extra-value (if (listp extra-value) extra-value (list
extra-value)))
+ (value (cons base-value extra-value)))
+ (and (not (equal value '(nil))) value))
+ (let ((range (org-get-property-block)))
+ (when range
+ (goto-char (car range))
+ (let* ((case-fold-search t)
+ (end (cdr range))
+ (value
+ ;; Base value.
+ (save-excursion
+ (let ((v (and (re-search-forward
+ (org-re-property property nil t) end t)
+ (match-string-no-properties 3))))
+ (list (if literal-nil v (org-not-nil v)))))))
+ ;; Find additional values.
+ (let* ((property+ (org-re-property (concat property "+") nil t)))
+ (while (re-search-forward property+ end t)
+ (push (match-string-no-properties 3) value)))
+ ;; Return final values.
+ (and (not (equal value '(nil))) (nreverse value))))))))
(defun org--property-global-or-keyword-value (property literal-nil)
"Return value for PROPERTY as defined by global properties or by keyword.
@@ -13328,59 +13330,60 @@ However, if LITERAL-NIL is set, return the string
value \"nil\" instead."
(org-with-wide-buffer
(let (value at-bob-no-heading)
(catch 'exit
- (if-let ((element (or element
- (and (org-element--cache-active-p)
- (org-element-at-point nil 'cached)))))
- (let ((element (org-element-lineage element '(headline org-data
inlinetask) 'with-self)))
- (while t
- (let* ((v (org--property-local-values property literal-nil
element))
- (v (if (listp v) v (list v))))
- (when v
- (setq value
- (concat (mapconcat #'identity (delq nil v) " ")
- (and value " ")
- value)))
- (cond
- ((car v)
- (move-marker org-entry-property-inherited-from
(org-element-property :begin element))
- (throw 'exit nil))
- ((org-element-property :parent element)
- (setq element (org-element-property :parent element)))
- (t
- (let ((global (org--property-global-or-keyword-value
property literal-nil)))
- (cond ((not global))
- (value (setq value (concat global " " value)))
- (t (setq value global))))
- (throw 'exit nil))))))
- (while t
- (let ((v (org--property-local-values property literal-nil)))
- (when v
- (setq value
- (concat (mapconcat #'identity (delq nil v) " ")
- (and value " ")
- value)))
- (cond
- ((car v)
- (org-back-to-heading-or-point-min t)
- (move-marker org-entry-property-inherited-from (point))
- (throw 'exit nil))
- ((or (org-up-heading-safe)
- (and (not (bobp))
- (goto-char (point-min))
- nil)
- ;; `org-up-heading-safe' returned nil. We are at low
- ;; level heading or bob. If there is headline
- ;; there, do not try to fetch its properties.
- (and (bobp)
- (not at-bob-no-heading)
- (not (org-at-heading-p))
- (setq at-bob-no-heading t))))
- (t
- (let ((global (org--property-global-or-keyword-value property
literal-nil)))
- (cond ((not global))
- (value (setq value (concat global " " value)))
- (t (setq value global))))
- (throw 'exit nil)))))))
+ (let ((element (or element
+ (and (org-element--cache-active-p)
+ (org-element-at-point nil 'cached)))))
+ (if element
+ (let ((element (org-element-lineage element '(headline org-data
inlinetask) 'with-self)))
+ (while t
+ (let* ((v (org--property-local-values property literal-nil
element))
+ (v (if (listp v) v (list v))))
+ (when v
+ (setq value
+ (concat (mapconcat #'identity (delq nil v) " ")
+ (and value " ")
+ value)))
+ (cond
+ ((car v)
+ (move-marker org-entry-property-inherited-from
(org-element-property :begin element))
+ (throw 'exit nil))
+ ((org-element-property :parent element)
+ (setq element (org-element-property :parent element)))
+ (t
+ (let ((global (org--property-global-or-keyword-value
property literal-nil)))
+ (cond ((not global))
+ (value (setq value (concat global " " value)))
+ (t (setq value global))))
+ (throw 'exit nil))))))
+ (while t
+ (let ((v (org--property-local-values property literal-nil)))
+ (when v
+ (setq value
+ (concat (mapconcat #'identity (delq nil v) " ")
+ (and value " ")
+ value)))
+ (cond
+ ((car v)
+ (org-back-to-heading-or-point-min t)
+ (move-marker org-entry-property-inherited-from (point))
+ (throw 'exit nil))
+ ((or (org-up-heading-safe)
+ (and (not (bobp))
+ (goto-char (point-min))
+ nil)
+ ;; `org-up-heading-safe' returned nil. We are at low
+ ;; level heading or bob. If there is headline
+ ;; there, do not try to fetch its properties.
+ (and (bobp)
+ (not at-bob-no-heading)
+ (not (org-at-heading-p))
+ (setq at-bob-no-heading t))))
+ (t
+ (let ((global (org--property-global-or-keyword-value property
literal-nil)))
+ (cond ((not global))
+ (value (setq value (concat global " " value)))
+ (t (setq value global))))
+ (throw 'exit nil))))))))
(if literal-nil value (org-not-nil value)))))
(defvar org-property-changed-functions nil
@@ -20711,25 +20714,26 @@ unless optional argument NO-INHERITANCE is non-nil.
Optional argument ELEMENT contains element at point."
(save-match-data
- (if-let ((el (or element (org-element-at-point nil 'cached))))
- (catch :found
- (setq el (org-element-lineage el '(headline) 'include-self))
- (if no-inheritance
- (org-element-property :commentedp el)
- (while el
- (when (org-element-property :commentedp el)
- (throw :found t))
- (setq el (org-element-property :parent el)))))
- (cond
- ((org-before-first-heading-p) nil)
- ((let ((headline (nth 4 (org-heading-components))))
- (and headline
- (let ((case-fold-search nil))
- (string-match-p (concat "^" org-comment-string "\\(?: \\|$\\)")
- headline)))))
- (no-inheritance nil)
- (t
- (save-excursion (and (org-up-heading-safe)
(org-in-commented-heading-p))))))))
+ (let ((el (or element (org-element-at-point nil 'cached))))
+ (if el
+ (catch :found
+ (setq el (org-element-lineage el '(headline) 'include-self))
+ (if no-inheritance
+ (org-element-property :commentedp el)
+ (while el
+ (when (org-element-property :commentedp el)
+ (throw :found t))
+ (setq el (org-element-property :parent el)))))
+ (cond
+ ((org-before-first-heading-p) nil)
+ ((let ((headline (nth 4 (org-heading-components))))
+ (and headline
+ (let ((case-fold-search nil))
+ (string-match-p (concat "^" org-comment-string "\\(?:
\\|$\\)")
+ headline)))))
+ (no-inheritance nil)
+ (t
+ (save-excursion (and (org-up-heading-safe)
(org-in-commented-heading-p)))))))))
(defun org-in-archived-heading-p (&optional no-inheritance element)
"Non-nil if point is under an archived heading.
@@ -20809,42 +20813,43 @@ headline found, or nil if no higher level is found.
Also, this function will be a lot faster than `outline-up-heading',
because it relies on stars being the outline starters. This can really
make a significant difference in outlines with very many siblings."
- (if-let ((element (and (org-element--cache-active-p)
- (org-element-at-point nil t))))
- (let* ((current-heading (org-element-lineage element '(headline)
'with-self))
- (parent (org-element-lineage current-heading '(headline))))
- (if (and parent
- (<= (point-min) (org-element-property :begin parent)))
- (progn
- (goto-char (org-element-property :begin parent))
- (org-element-property :level parent))
- (when (and current-heading
- (<= (point-min) (org-element-property :begin
current-heading)))
- (goto-char (org-element-property :begin current-heading))
- nil)))
- (when (ignore-errors (org-back-to-heading t))
- (let (level-cache)
- (unless org--up-heading-cache
- (setq org--up-heading-cache (make-hash-table)))
- (if (and (eq (buffer-chars-modified-tick) org--up-heading-cache-tick)
- (setq level-cache (gethash (point) org--up-heading-cache)))
- (when (<= (point-min) (car level-cache) (point-max))
- ;; Parent is inside accessible part of the buffer.
- (progn (goto-char (car level-cache))
- (cdr level-cache)))
- ;; Buffer modified. Invalidate cache.
- (unless (eq (buffer-chars-modified-tick) org--up-heading-cache-tick)
- (setq-local org--up-heading-cache-tick
- (buffer-chars-modified-tick))
- (clrhash org--up-heading-cache))
- (let* ((level-up (1- (funcall outline-level)))
- (pos (point))
- (result (and (> level-up 0)
- (re-search-backward
- (format "^\\*\\{1,%d\\} " level-up) nil t)
- (funcall outline-level))))
- (when result (puthash pos (cons (point) result)
org--up-heading-cache))
- result))))))
+ (let ((element (and (org-element--cache-active-p)
+ (org-element-at-point nil t))))
+ (if element
+ (let* ((current-heading (org-element-lineage element '(headline)
'with-self))
+ (parent (org-element-lineage current-heading '(headline))))
+ (if (and parent
+ (<= (point-min) (org-element-property :begin parent)))
+ (progn
+ (goto-char (org-element-property :begin parent))
+ (org-element-property :level parent))
+ (when (and current-heading
+ (<= (point-min) (org-element-property :begin
current-heading)))
+ (goto-char (org-element-property :begin current-heading))
+ nil)))
+ (when (ignore-errors (org-back-to-heading t))
+ (let (level-cache)
+ (unless org--up-heading-cache
+ (setq org--up-heading-cache (make-hash-table)))
+ (if (and (eq (buffer-chars-modified-tick) org--up-heading-cache-tick)
+ (setq level-cache (gethash (point) org--up-heading-cache)))
+ (when (<= (point-min) (car level-cache) (point-max))
+ ;; Parent is inside accessible part of the buffer.
+ (progn (goto-char (car level-cache))
+ (cdr level-cache)))
+ ;; Buffer modified. Invalidate cache.
+ (unless (eq (buffer-chars-modified-tick)
org--up-heading-cache-tick)
+ (setq-local org--up-heading-cache-tick
+ (buffer-chars-modified-tick))
+ (clrhash org--up-heading-cache))
+ (let* ((level-up (1- (funcall outline-level)))
+ (pos (point))
+ (result (and (> level-up 0)
+ (re-search-backward
+ (format "^\\*\\{1,%d\\} " level-up) nil t)
+ (funcall outline-level))))
+ (when result (puthash pos (cons (point) result)
org--up-heading-cache))
+ result)))))))
(defun org-up-heading-or-point-min ()
"Move to the heading line of which the present is a subheading, or point-min.
@@ -20906,20 +20911,21 @@ move point."
Return t when a child was found. Otherwise don't move point and
return nil."
(if (org-element--cache-active-p)
- (when-let ((heading (org-element-lineage
- (or element (org-element-at-point))
- '(headline inlinetask org-data)
- t)))
- (unless (or (eq 'inlinetask (org-element-type heading))
- (not (org-element-property :contents-begin heading)))
- (let ((pos (point)))
- (goto-char (org-element-property :contents-begin heading))
- (if (re-search-forward
- org-outline-regexp-bol
- (org-element-property :end heading)
- t)
- (progn (goto-char (match-beginning 0)) t)
- (goto-char pos) nil))))
+ (let ((heading (org-element-lineage
+ (or element (org-element-at-point))
+ '(headline inlinetask org-data)
+ t)))
+ (when heading
+ (unless (or (eq 'inlinetask (org-element-type heading))
+ (not (org-element-property :contents-begin heading)))
+ (let ((pos (point)))
+ (goto-char (org-element-property :contents-begin heading))
+ (if (re-search-forward
+ org-outline-regexp-bol
+ (org-element-property :end heading)
+ t)
+ (progn (goto-char (match-beginning 0)) t)
+ (goto-char pos) nil)))))
(let (level (pos (point)) (re org-outline-regexp-bol))
(when (org-back-to-heading-or-point-min t)
(setq level (org-outline-level))
diff --git a/testing/org-test.el b/testing/org-test.el
index 30adb97..ae4f32b 100644
--- a/testing/org-test.el
+++ b/testing/org-test.el
@@ -466,8 +466,13 @@ TIME can be a non-nil Lisp time value, or a string
specifying a date and time."
(apply ,(symbol-function 'current-time-zone)
(or time ,at) args)))
((symbol-function 'decode-time)
- (lambda (&optional time zone form) (funcall ,(symbol-function
'decode-time)
- (or time ,at) zone form)))
+ (lambda (&optional time zone form)
+ (condition-case err
+ (funcall ,(symbol-function 'decode-time)
+ (or time ,at) zone form)
+ ;; Fallback for Emacs <27.1.
+ (error (funcall ,(symbol-function 'decode-time)
+ (or time ,at) zone)))))
((symbol-function 'encode-time)
(lambda (time &rest args)
(apply ,(symbol-function 'encode-time) (or time ,at) args)))
