tec/org-mode
tec/org-mode
1
0
Fork 0
forked from mirrors/org-mode
Code Pull requests Releases Activity

org.el/org-entry-get-with-inheritance: Support cache and passing element arg

Browse source 
* lisp/org.el (org-entry-get-with-inheritance): Add cache support.
Add new optional argument---an element to get properties from.  Fix
getting top-level properties when a headline is located at BOB.
This commit is contained in:
Ihor Radchenko 2021-10-16 23:33:10 +08:00
parent 7b83168295
commit 5bf5fdbc28
No known key found for this signature in database
GPG key ID: 6470762A7DA11D8B
1 changed files with 55 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

76
lisp/org.el
View file

@ -13209,7 +13209,7 @@ no match, the marker will point nowhere.
Note that also `org-entry-get' calls this function, if the INHERIT flag Note that also `org-entry-get' calls this function, if the INHERIT flag
is set.") is set.")
(defun org-entry-get-with-inheritance (property &optional literal-nil) (defun org-entry-get-with-inheritance (property &optional literal-nil element)
"Get PROPERTY of entry or content at point, search higher levels if needed. "Get PROPERTY of entry or content at point, search higher levels if needed.
The search will stop at the first ancestor which has the property defined. The search will stop at the first ancestor which has the property defined.
If the value found is \"nil\", return nil to show that the property If the value found is \"nil\", return nil to show that the property
@ -13217,27 +13217,61 @@ should be considered as undefined (this is the meaning of nil here).
However, if LITERAL-NIL is set, return the string value \"nil\" instead." However, if LITERAL-NIL is set, return the string value \"nil\" instead."
(move-marker org-entry-property-inherited-from nil) (move-marker org-entry-property-inherited-from nil)
(org-with-wide-buffer (org-with-wide-buffer
(let (value) (let (value at-bob-no-heading)
(catch 'exit (catch 'exit
(while t (if-let ((element (or element
(let ((v (org--property-local-values property literal-nil))) (and (org-element--cache-active-p)
(when v (org-element-at-point nil 'cached)))))
(setq value (let ((element (org-element-lineage element '(headline org-data inlinetask) 'with-self)))
(concat (mapconcat #'identity (delq nil v) " ") (while t
(and value " ") (let* ((v (org--property-local-values property literal-nil element))
value))) (v (if (listp v) v (list v))))
(cond (when v
((car v) (setq value
(org-back-to-heading-or-point-min t) (concat (mapconcat #'identity (delq nil v) " ")
(move-marker org-entry-property-inherited-from (point)) (and value " ")
(throw 'exit nil)) value)))
((org-up-heading-or-point-min)) (cond
(t ((car v)
(let ((global (org--property-global-or-keyword-value property literal-nil))) (move-marker org-entry-property-inherited-from (org-element-property :begin element))
(cond ((not global)) (throw 'exit nil))
(value (setq value (concat global " " value))) ((org-element-property :parent element)
(t (setq value global)))) (setq element (org-element-property :parent element)))
(throw 'exit nil)))))) (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))))) (if literal-nil value (org-not-nil value)))))
(defvar org-property-changed-functions nil (defvar org-property-changed-functions nil