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:
parent
8ceb9e7902
commit
004ac14a5b
|
@ -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^.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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))
|
||||
|
|
322
lisp/org.el
322
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))
|
||||
|
|
|
@ -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)))
|
||||
|
|
Loading…
Reference in New Issue