mirrors
/
org-mode
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git
0
0
Fork 1
Code Releases Activity

Rename `org-element-property-1' to `org-element-property-raw' 

The new name is more readable.

Link: https://orgmode.org/list/87sfail69e.fsf@localhost
This commit is contained in:
Ihor Radchenko 2023-06-30 16:49:08 +03:00
parent 66c8e94732
commit 948c896448
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
4 changed files with 94 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
etc/ORG-NEWS
View File

@ -109,12 +109,12 @@ When cache is enabled, the macro is identical to ~progn~. When cache
is disabled, the macro arranges a new fresh cache that is discarded
upon completion of =BODY=.
***** New function ~org-element-property-1~
***** New function ~org-element-property-raw~
This function is like ~org-element-property~ but does not try to
resolve deferred properties.
~org-element-property-1~ can be used with ~setf~.
~org-element-property-raw~ can be used with ~setf~.
***** New function ~org-element-put-property-2~

24
lisp/org-element-ast.el
View File

@ -248,7 +248,7 @@ Return value is the containing property name, as a keyword, or nil."
val)
(catch 'exit
(dolist (p properties)
(setq val (org-element-property-1 p parent))
(setq val (org-element-property-raw p parent))
(when (or (eq node val) (memq node val))
(throw 'exit p))))))
@ -399,7 +399,7 @@ Ignore standard property array."
(if (plist-member (nth 1 ,node) ,property)
nil ,dflt))))))))
(define-inline org-element-property-1 (property node &optional dflt)
(define-inline org-element-property-raw (property node &optional dflt)
"Extract the value for PROPERTY of an NODE.
Do not resolve deferred values.
If PROPERTY is not present, return DFLT."
@ -489,22 +489,22 @@ See `org-element-put-property' for the meaning of PROPERTY and VALUE."
Return DFLT when PROPERTY is not present.
When FORCE-UNDEFER is non-nil, unconditionally resolve deferred
properties, replacing their values in NODE."
(let ((value (org-element-property-1 property node 'org-element-ast--nil)))
(let ((value (org-element-property-raw property node 'org-element-ast--nil)))
;; PROPERTY not present.
(when (and (eq 'org-element-ast--nil value)
(org-element-deferred-p
(org-element-property-1 :deferred node)))
(org-element-property-raw :deferred node)))
;; If :deferred has `org-element-deferred' type, resolve it for
;; side-effects, and re-assign the new value.
(org-element--property :deferred node nil 'force-undefer)
;; Try to retrieve the value again.
(setq value (org-element-property-1 property node dflt)))
(setq value (org-element-property-raw property node dflt)))
;; Deferred property. Resolve it recursively.
(when (org-element-deferred-p value)
(let ((retry t) (firstiter t))
(while retry
(if firstiter (setq firstiter nil) ; avoid extra call to `org-element-property-1'.
(setq value (org-element-property-1 property node 'org-element-ast--nil)))
(if firstiter (setq firstiter nil) ; avoid extra call to `org-element-property-raw'.
(setq value (org-element-property-raw property node 'org-element-ast--nil)))
(catch :org-element-deferred-retry
(pcase-let
((`(,resolved . ,value-to-store)
@ -531,7 +531,7 @@ except `:deferred', may not be resolved."
(org-element--property-idx (inline-const-val property)))
;; This is an important optimization, making common org-element
;; API calls much faster.
(inline-quote (org-element-property-1 ,property ,node ,dflt))
(inline-quote (org-element-property-raw ,property ,node ,dflt))
(inline-quote (org-element--property ,property ,node ,dflt ,force-undefer))))
(define-inline org-element-property-2 (node property &optional dflt force-undefer)
@ -548,7 +548,7 @@ except `:deferred', may not be resolved."
(gv-define-setter org-element-property (value property node &optional _)
`(org-element-put-property ,node ,property ,value))
(gv-define-setter org-element-property-1 (value property node &optional _)
(gv-define-setter org-element-property-raw (value property node &optional _)
`(org-element-put-property ,node ,property ,value))
(defun org-element--properties-mapc (fun node &optional collect no-standard)
@ -797,7 +797,7 @@ When DATUM is `plain-text', all the properties are removed."
(_
(let ((node-copy (copy-sequence datum)))
;; Copy `:standard-properties'
(when-let ((parray (org-element-property-1 :standard-properties node-copy)))
(when-let ((parray (org-element-property-raw :standard-properties node-copy)))
(org-element-put-property node-copy :standard-properties (copy-sequence parray)))
;; Clear `:parent'.
(org-element-put-property node-copy :parent nil)
@ -921,14 +921,14 @@ Nil values returned from FUN do not appear in the results."
(funcall
--walk-tree
(if no-undefer
(org-element-property-1 p --data)
(org-element-property-raw p --data)
(org-element-property p --data)))))
(unless no-secondary
(dolist (p (org-element-property :secondary --data))
(funcall
--walk-tree
(if no-undefer
(org-element-property-1 p --data)
(org-element-property-raw p --data)
(org-element-property p --data)))))
(mapc --walk-tree (org-element-contents --data))))))))))
(catch :--map-first-match

32
lisp/org-element.el
View File

@ -5902,7 +5902,7 @@ the cache."
(setq node (avl-tree--node-right node)))
((and (org-element-type-p element '(item table-row))
;; Cached elements cannot have deferred `:parent'.
(let ((parent (org-element-property-1 :parent element)))
(let ((parent (org-element-property-raw :parent element)))
(and (= (org-element-begin element)
(org-element-contents-begin parent))
(setq node nil
@ -5959,9 +5959,9 @@ Assume ELEMENT belongs to cache and that a cache is active."
;; Invalidate contents of parent.
(when (org-element-contents
;; Cached elements cannot have deferred `:parent'.
(org-element-property-1 :parent element))
(org-element-property-raw :parent element))
(org-element-set-contents
(org-element-property-1 :parent element) nil))
(org-element-property-raw :parent element) nil))
(when (org-element-type-p element '(headline inlinetask))
(cl-decf org-element--headline-cache-size)
(avl-tree-delete org-element--headline-cache element))
@ -6030,7 +6030,7 @@ Properties are modified by side-effect."
(org-element-type-p element 'plain-list)
(not (org-element-type-p
;; Cached elements cannot have deferred `:parent'.
(org-element-property-1 :parent element)
(org-element-property-raw :parent element)
'item)))
(let ((structure (org-element-property :structure element)))
(dolist (item structure)
@ -6368,7 +6368,7 @@ completing the request."
'(:contents-end :end :robust-end)
'(:contents-end :end))))
;; Cached elements cannot have deferred `:parent'.
(setq up (org-element-property-1 :parent up)))))
(setq up (org-element-property-raw :parent up)))))
(org-element--cache-log-message
"New parent at %S: %S::%S"
limit
@ -6445,7 +6445,7 @@ completing the request."
(while (and parent (<= (org-element-end parent) begin))
(setq parent
;; Cached elements cannot have deferred `:parent'.
(org-element-property-1 :parent parent)))
(org-element-property-raw :parent parent)))
(cond ((and (not parent) (zerop offset)) (throw 'org-element--cache-quit nil))
;; Consider scenario when DATA lays within
;; sensitive lines of PARENT that was found
@ -6487,7 +6487,7 @@ completing the request."
((and parent
(not (eq parent data))
;; Cached elements cannot have deferred `:parent'.
(let ((p (org-element-property-1 :parent data)))
(let ((p (org-element-property-raw :parent data)))
(or (not p)
(< (org-element-begin p)
(org-element-begin parent))
@ -6499,7 +6499,7 @@ completing the request."
"Updating parent in %S\n Old parent: %S\n New parent: %S"
(org-element--format-element data)
(org-element--format-element
(org-element-property-1 :parent data))
(org-element-property-raw :parent data))
(org-element--format-element parent))
(when (and (org-element-type-p parent 'org-data)
(not (org-element-type-p data 'headline)))
@ -6654,12 +6654,12 @@ the expected result."
element up
mode (org-element--next-mode (org-element-property :mode element) (org-element-type element) nil)
;; Cached elements cannot have deferred `:parent'.
up (org-element-property-1 :parent up)))
up (org-element-property-raw :parent up)))
(when next (goto-char next))
(when up (setq element up)))))
;; Parse successively each element until we reach POS.
(let ((end (or (org-element-end element) (point-max)))
(parent (org-element-property-1 :parent element)))
(parent (org-element-property-raw :parent element)))
(while t
(when (org-element--cache-interrupt-p time-limit)
(throw 'org-element--cache-interrupt nil))
@ -7085,12 +7085,12 @@ known element in cache (it may start after END)."
(org-element--format-element up))
(setq before up)
(when robust-flag (setq robust-flag nil))))
(unless (or (org-element-property-1 :parent up)
(unless (or (org-element-property-raw :parent up)
(org-element-type-p up 'org-data))
(org-element--cache-warn "Got element without parent. Please report it to Org mode mailing list (M-x org-submit-bug-report).\n%S" up)
(org-element-cache-reset)
(error "org-element--cache: Emergency exit"))
(setq up (org-element-property-1 :parent up)))
(setq up (org-element-property-raw :parent up)))
;; We're at top level element containing ELEMENT: if it's
;; altered by buffer modifications, it is first element in
;; cache to be removed. Otherwise, that first element is the
@ -7162,7 +7162,7 @@ change, as an integer."
(org-element--request-end next)))
(setf (org-element--request-parent next)
;; Cached elements cannot have deferred `:parent'.
(org-element-property-1 :parent first))))
(org-element-property-raw :parent first))))
;; The current and NEXT modifications are intersecting
;; with current modification starting before NEXT and NEXT
;; ending after current. We need to update the common
@ -7186,7 +7186,7 @@ change, as an integer."
(org-element--request-end next)))
(setf (org-element--request-parent next)
;; Cached elements cannot have deferred `:parent'.
(org-element-property-1 :parent first))))))
(org-element-property-raw :parent first))))))
;; Ensure cache is correct up to END. Also make sure that NEXT,
;; if any, is no longer a 0-phase request, thus ensuring that
;; phases are properly ordered. We need to provide OFFSET as
@ -7217,7 +7217,7 @@ change, as an integer."
(when (> first-end end)
(org-element--cache-log-message "Extending to non-robust element %S" (org-element--format-element first))
(vector key first-beg first-end offset
(org-element-property-1 :parent first) 0))))
(org-element-property-raw :parent first) 0))))
(t
;; Now, FIRST is the first element after BEG or
;; non-robust element containing BEG. However,
@ -7232,7 +7232,7 @@ change, as an integer."
(up element))
(while (and (not (eq up first))
;; Cached elements cannot have deferred `:parent'.
(setq up (org-element-property-1 :parent up))
(setq up (org-element-property-raw :parent up))
(>= (org-element-begin up) first-beg))
;; Note that UP might have been already
;; shifted if it is a robust element. After

128
testing/lisp/test-org-element.el
View File

@ -60,92 +60,92 @@ Return interpreted string."
(should (org-element-type-p "string" 'plain-text))
(should (org-element-type-p '((foo)) 'anonymous)))
(ert-deftest test-org-element/org-element-property-1 ()
"Test `org-element-property-1' specifications."
(ert-deftest test-org-element/org-element-property-raw ()
"Test `org-element-property-raw' specifications."
;; No properties.
(dolist (element `( nil
(headline nil)
(headline nil (headline))
"string"))
(should-not (org-element-property-1 :begin element))
(should (eq 'default (org-element-property-1 :begin element 'default)))
(should-not (org-element-property-1 :begin1 element))
(should (eq 'default (org-element-property-1 :begin1 element 'default)))
(should-not (org-element-property-raw :begin element))
(should (eq 'default (org-element-property-raw :begin element 'default)))
(should-not (org-element-property-raw :begin1 element))
(should (eq 'default (org-element-property-raw :begin1 element 'default)))
(dolist (prop '(:begin))
(should-not (org-element-property-1 prop element))
(should (eq 'default (org-element-property-1 prop element 'default))))
(should-not (org-element-property-raw prop element))
(should (eq 'default (org-element-property-raw prop element 'default))))
(dolist (prop '(:begin1))
(should-not (org-element-property-1 prop element))
(should (eq 'default (org-element-property-1 prop element 'default)))))
(should-not (org-element-property-raw prop element))
(should (eq 'default (org-element-property-raw prop element 'default)))))
;; Only non-standard properties.
(dolist (element `((headline (:begin1 1))
(headline (:begin1 1) (headline))
,(propertize "string" :begin1 1)))
(should-not (org-element-property-1 :begin element))
(should (eq 'default (org-element-property-1 :begin element 'default)))
(should (= 1 (org-element-property-1 :begin1 element)))
(should (= 1 (org-element-property-1 :begin1 element 'default)))
(should-not (org-element-property-raw :begin element))
(should (eq 'default (org-element-property-raw :begin element 'default)))
(should (= 1 (org-element-property-raw :begin1 element)))
(should (= 1 (org-element-property-raw :begin1 element 'default)))
(dolist (prop '(:begin))
(should-not (org-element-property-1 prop element))
(should (eq 'default (org-element-property-1 prop element 'default))))
(should-not (org-element-property-raw prop element))
(should (eq 'default (org-element-property-raw prop element 'default))))
(dolist (prop '(:begin1))
(should (= 1 (org-element-property-1 prop element)))
(should (= 1 (org-element-property-1 prop element 'default)))))
(should (= 1 (org-element-property-raw prop element)))
(should (= 1 (org-element-property-raw prop element 'default)))))
;; Only standard properties.
(dolist (element `((headline (:standard-properties ,(make-vector 10 'test)))
(headline (:standard-properties ,(make-vector 10 'test)) (headline))))
(should (eq 'test (org-element-property-1 :begin element)))
(should (eq 'test (org-element-property-1 :begin element 'default)))
(should-not (org-element-property-1 :begin1 element))
(should (eq 'default (org-element-property-1 :begin1 element 'default)))
(should (eq 'test (org-element-property-raw :begin element)))
(should (eq 'test (org-element-property-raw :begin element 'default)))
(should-not (org-element-property-raw :begin1 element))
(should (eq 'default (org-element-property-raw :begin1 element 'default)))
(dolist (prop '(:begin))
(should (eq 'test (org-element-property-1 prop element)))
(should (eq 'test (org-element-property-1 prop element 'default))))
(should (eq 'test (org-element-property-raw prop element)))
(should (eq 'test (org-element-property-raw prop element 'default))))
(dolist (prop '(:begin1))
(should-not (org-element-property-1 prop element))
(should (eq 'default (org-element-property-1 prop element 'default)))))
(should-not (org-element-property-raw prop element))
(should (eq 'default (org-element-property-raw prop element 'default)))))
;; Standard properties in the plist.
(dolist (element `((headline (:begin 1))
(headline (:begin 1) (headline))
,(propertize "string" :begin 1)))
(should (= 1 (org-element-property-1 :begin element)))
(should (= 1 (org-element-property-1 :begin element 'default)))
(should-not (org-element-property-1 :begin1 element))
(should (eq 'default (org-element-property-1 :begin1 element 'default)))
(should (= 1 (org-element-property-raw :begin element)))
(should (= 1 (org-element-property-raw :begin element 'default)))
(should-not (org-element-property-raw :begin1 element))
(should (eq 'default (org-element-property-raw :begin1 element 'default)))
(dolist (prop '(:begin))
(should (= 1 (org-element-property-1 prop element)))
(should (= 1 (org-element-property-1 prop element 'default))))
(should (= 1 (org-element-property-raw prop element)))
(should (= 1 (org-element-property-raw prop element 'default))))
(dolist (prop '(:begin1))
(should-not (org-element-property-1 prop element))
(should (eq 'default (org-element-property-1 prop element 'default)))))
(should-not (org-element-property-raw prop element))
(should (eq 'default (org-element-property-raw prop element 'default)))))
;; Standard properties mixed in the plist and standard array.
(dolist (element `((headline (:standard-properties ,(make-vector 10 'test) :begin 1))
(headline (:begin 1 :standard-properties ,(make-vector 10 'test)))
(headline (:standard-properties ,(make-vector 10 'test) :begin 1) (headline))))
(should (eq 'test (org-element-property-1 :begin element)))
(should (eq 'test (org-element-property-1 :begin element 'default)))
(should-not (org-element-property-1 :begin1 element))
(should (eq 'default (org-element-property-1 :begin1 element 'default)))
(should (eq 'test (org-element-property-raw :begin element)))
(should (eq 'test (org-element-property-raw :begin element 'default)))
(should-not (org-element-property-raw :begin1 element))
(should (eq 'default (org-element-property-raw :begin1 element 'default)))
(dolist (prop '(:begin))
(should (eq 'test (org-element-property-1 prop element)))
(should (eq 'test (org-element-property-1 prop element 'default))))
(should (eq 'test (org-element-property-raw prop element)))
(should (eq 'test (org-element-property-raw prop element 'default))))
(dolist (prop '(:begin1))
(should-not (org-element-property-1 prop element))
(should (eq 'default (org-element-property-1 prop element 'default)))))
(should-not (org-element-property-raw prop element))
(should (eq 'default (org-element-property-raw prop element 'default)))))
;; General case.
(dolist (element `((headline (:standard-properties ,(make-vector 10 'test) :begin1 1))
(headline (:begin1 1 :standard-properties ,(make-vector 10 'test)))
(headline (:standard-properties ,(make-vector 10 'test) :begin1 1) (headline))))
(should (eq 'test (org-element-property-1 :begin element)))
(should (eq 'test (org-element-property-1 :begin element 'default)))
(should (= 1 (org-element-property-1 :begin1 element)))
(should (= 1 (org-element-property-1 :begin1 element 'default)))
(should (eq 'test (org-element-property-raw :begin element)))
(should (eq 'test (org-element-property-raw :begin element 'default)))
(should (= 1 (org-element-property-raw :begin1 element)))
(should (= 1 (org-element-property-raw :begin1 element 'default)))
(dolist (prop '(:begin))
(should (eq 'test (org-element-property-1 prop element)))
(should (eq 'test (org-element-property-1 prop element 'default))))
(should (eq 'test (org-element-property-raw prop element)))
(should (eq 'test (org-element-property-raw prop element 'default))))
(dolist (prop '(:begin1))
(should (= 1 (org-element-property-1 prop element)))
(should (= 1 (org-element-property-1 prop element 'default))))))
(should (= 1 (org-element-property-raw prop element)))
(should (= 1 (org-element-property-raw prop element 'default))))))
(ert-deftest test-org-element/property ()
"Test resolving deferred properties."
@ -171,7 +171,7 @@ Return interpreted string."
,(org-element-deferred-create
t (lambda (_) 'bar))))))
(should (eq 'bar (org-element-property :foo el)))
(should (eq 'bar (org-element-property-1 :foo el))))
(should (eq 'bar (org-element-property-raw :foo el))))
;; Force undefer.
(let ((el (org-element-create
'dummy
@ -179,9 +179,9 @@ Return interpreted string."
,(org-element-deferred-create
nil (lambda (_) 'bar))))))
(should (eq 'bar (org-element-property :foo el)))
(should-not (eq 'bar (org-element-property-1 :foo el)))
(should-not (eq 'bar (org-element-property-raw :foo el)))
(should (eq 'bar (org-element-property :foo el nil 'force)))
(should (eq 'bar (org-element-property-1 :foo el))))
(should (eq 'bar (org-element-property-raw :foo el))))
;; Test deferred alias.
(let ((el (org-element-create
'dummy
@ -240,13 +240,13 @@ Return interpreted string."
(org-element-put-property el :baz 3)))))))
;; Resolve conditionally.
(setq el (org-element-properties-resolve el))
(should (eq 1 (org-element-property-1 :foo el)))
(should-not (eq 2 (org-element-property-1 :bar el)))
(should (eq 1 (org-element-property-raw :foo el)))
(should-not (eq 2 (org-element-property-raw :bar el)))
(should (eq 2 (org-element-property :bar el)))
(should (eq 3 (org-element-property-1 :baz el)))
(should (eq 3 (org-element-property-raw :baz el)))
;; Resolve unconditionally.
(setq el (org-element-properties-resolve el 'force))
(should (eq 2 (org-element-property-1 :bar el)))))
(should (eq 2 (org-element-property-raw :bar el)))))
(ert-deftest test-org-element/secondary-p ()
"Test `org-element-secondary-p' specifications."
@ -491,7 +491,7 @@ Some other text
(org-element-properties-map
(lambda (prop val node)
(if (eq prop :baz)
(1+ (org-element-property-1 :baz node))
(1+ (org-element-property-raw :baz node))
val))
el)))))
@ -547,22 +547,22 @@ Some other text
(let ((element (list 'heading (list :standard-properties (make-vector (length org-element--standard-properties) 'foo)))))
(should
(= 1
(org-element-property-1 :begin (org-element-put-property element :begin 1)))))
(org-element-property-raw :begin (org-element-put-property element :begin 1)))))
;; Adding standard properties when other standard properties are defined manually in the plist.
(let ((element (list 'heading (list :begin 1 :end 20 :foo 'foo))))
(should
(= 2
(org-element-property-1 :begin (org-element-put-property element :begin 2))))
(org-element-property-raw :begin (org-element-put-property element :begin 2))))
;; Check setter.
(cl-incf (org-element-property-1 :begin element))
(cl-incf (org-element-property-raw :begin element))
(should
(= 3 (org-element-property-1 :begin element)))
(= 3 (org-element-property-raw :begin element)))
(should
(= 20
(org-element-property-1 :end element)))
(org-element-property-raw :end element)))
(should
(eq 'foo
(org-element-property-1 :foo element)))))
(org-element-property-raw :foo element)))))
(ert-deftest test-org-element/put-property-2 ()
"Test `org-element-put-property-2' specifications."