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.
This commit is contained in:
Ihor Radchenko 2021-10-17 14:34:10 +08:00
parent 8ceb9e7902
commit 004ac14a5b
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
7 changed files with 385 additions and 360 deletions

View File

@ -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^.

View File

@ -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

View File

@ -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)

View File

@ -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)))

View File

@ -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))

View File

@ -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))

View File

@ -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)))