org-element-map: Allow TYPES t and add new arg NO-UNDEFER

* lisp/org-element-ast.el (org-element-ast-map):
* lisp/org-element.el (org-element-map): Treat TYPES t as all possible
types.  Add new optional parameter to no resolve deferred while
traversing the AST.
This commit is contained in:
Ihor Radchenko 2023-04-28 11:55:43 +02:00
parent c22697f472
commit 23f9347d1a
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
2 changed files with 108 additions and 75 deletions

View File

@ -817,13 +817,18 @@ The function takes care of setting `:parent' property for NEW."
old)
(defun org-element-ast-map
(data types fun &optional ignore first-match no-recursion with-properties no-secondary)
( data types fun
&optional
ignore first-match no-recursion
with-properties no-secondary no-undefer)
"Map a function on selected syntax nodes.
DATA is a syntax tree. TYPES is a symbol or list of symbols of
node types. FUN is the function called on the matching nodes.
It has to accept one argument: the node itself.
When TYPES is t, call FUN for all the node types.
When optional argument IGNORE is non-nil, it should be a list holding
nodes to be skipped. In that case, the listed nodes and their
contents will be skipped.
@ -843,61 +848,78 @@ secondary properties.
When optional argument NO-SECONDARY is non-nil, do not recurse into
secondary strings.
When optional argument NO-UNDEFER is non-nil, do not resolve deferred
values.
FUN may also throw `:org-element-skip' signal. Then,
`org-element-ast-map' will not recurse into the current node.
Nil values returned from FUN do not appear in the results."
(declare (indent 2))
;; Ensure TYPES and NO-RECURSION are a list, even of one node.
(let* ((types (if (listp types) types (list types)))
(no-recursion (if (listp no-recursion) no-recursion
(list no-recursion)))
--acc)
(letrec ((--walk-tree
(lambda (--data)
;; Recursively walk DATA. INFO, if non-nil, is a plist
;; holding contextual information.
(let ((--type (org-element-type --data))
recurse)
(cond
((not --data))
;; Ignored node in an export context.
((and ignore (memq --data ignore)))
;; List of elements or objects.
((not --type) (mapc --walk-tree --data))
(t
;; Check if TYPE is matching among TYPES. If so,
;; apply FUN to --DATA and accumulate return value
;; into --ACC (or exit if FIRST-MATCH is non-nil).
(setq recurse t)
(when (memq --type types)
(let ((result
(catch :org-element-skip
(setq recurse nil)
(prog1 (funcall fun --data)
(setq recurse t)))))
(cond ((not result))
(first-match (throw :--map-first-match result))
(t (push result --acc)))))
;; Determine if a recursion into --DATA is possible.
(when types
(let* ((types (pcase types
((pred listp) types)
(`t t)
(_ (list types))))
(no-recursion (if (listp no-recursion) no-recursion
(list no-recursion)))
--acc)
(letrec ((--walk-tree
(lambda (--data)
;; Recursively walk DATA. INFO, if non-nil, is a plist
;; holding contextual information.
(let ((--type (org-element-type --data t))
recurse)
(cond
;; No recursion requested.
((not recurse))
;; --TYPE is explicitly removed from recursion.
((memq --type no-recursion))
;; In any other case, map secondary, affiliated, and contents.
((not --data))
((not --type))
;; Ignored node in an export context.
((and ignore (memq --data ignore)))
;; List of elements or objects.
((eq --type 'anonymous)
(mapc --walk-tree (org-element-contents --data)))
(t
(when with-properties
(dolist (p with-properties)
(funcall --walk-tree (org-element-property p --data))))
(unless no-secondary
(dolist (p (org-element-property :secondary --data))
(funcall --walk-tree (org-element-property p --data))))
(mapc --walk-tree (org-element-contents --data))))))))))
(catch :--map-first-match
(funcall --walk-tree data)
;; Return value in a proper order.
(nreverse --acc)))))
;; Check if TYPE is matching among TYPES. If so,
;; apply FUN to --DATA and accumulate return value
;; into --ACC (or exit if FIRST-MATCH is non-nil).
(setq recurse t)
(when (or (eq types t) (memq --type types))
(let ((result
(catch :org-element-skip
(setq recurse nil)
(prog1 (funcall fun --data)
(setq recurse t)))))
(cond ((not result))
(first-match (throw :--map-first-match result))
(t (push result --acc)))))
;; Determine if a recursion into --DATA is possible.
(cond
;; No recursion requested.
((not recurse))
;; --TYPE is explicitly removed from recursion.
((memq --type no-recursion))
;; In any other case, map secondary, affiliated, and contents.
(t
(when with-properties
(dolist (p with-properties)
(funcall
--walk-tree
(if no-undefer
(org-element-property-1 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 p --data)))))
(mapc --walk-tree (org-element-contents --data))))))))))
(catch :--map-first-match
(funcall --walk-tree data)
;; Return value in a proper order.
(nreverse --acc))))))
(defun org-element-create (type &optional props &rest children)
"Create a new syntax node of TYPE.

View File

@ -4568,7 +4568,10 @@ If STRING is the empty string or nil, return nil."
rtn)))))
(defun org-element-map
(data types fun &optional info first-match no-recursion with-affiliated)
( data types fun
&optional
info first-match no-recursion
with-affiliated no-undefer)
"Map a function on selected elements or objects.
DATA is a parse tree (for example, returned by
@ -4579,6 +4582,8 @@ elements or object types (see `org-element-all-elements' and
function called on the matching element or object. It has to accept
one argument: the element or object itself.
When TYPES is t, call FUN for all the elements and objects.
When optional argument INFO is non-nil, it should be a plist
holding export options. In that case, elements of the parse tree
\\(compared with `eq') not exportable according to `:ignore-list'
@ -4596,6 +4601,9 @@ When optional argument WITH-AFFILIATED is non-nil, FUN will also
apply to matching objects within parsed affiliated keywords (see
`org-element-parsed-keywords').
When optional argument NO-UNDEFER is non-nil, do not resolve deferred
values.
FUN may throw `:org-element-skip' signal. Then, `org-element-map'
will not recurse into the current element.
@ -4641,32 +4649,35 @@ looking into captions:
nil nil nil t)"
(declare (indent 2))
;; Ensure TYPES and NO-RECURSION are a list, even of one element.
(let* ((types (if (listp types) types (list types)))
(ignore-list (plist-get info :ignore-list))
(objects?
(cl-intersection
(cons 'plain-text org-element-all-objects) types))
(no-recursion
(append
(if (listp no-recursion) no-recursion
(list no-recursion))
(unless objects?
org-element-all-objects)
(unless objects?
;; Do not recurse into elements that can only contain
;; objects.
(cl-set-difference
org-element-all-elements
org-element-greater-elements)))))
(org-element-ast-map
data types fun
ignore-list first-match
no-recursion
;; Affiliated keywords may only contain objects.
(when (and with-affiliated objects?)
(mapcar #'cdr org-element--parsed-properties-alist))
;; Secondary strings may only contain objects.
(not objects?))))
(when (and types data)
(let* ((ignore-list (plist-get info :ignore-list))
(objects?
(or (eq types t)
(cl-intersection
(cons 'plain-text org-element-all-objects)
(if (listp types) types (list types)))))
(no-recursion
(append
(if (listp no-recursion) no-recursion
(list no-recursion))
(unless objects?
org-element-all-objects)
(unless objects?
;; Do not recurse into elements that can only contain
;; objects.
(cl-set-difference
org-element-all-elements
org-element-greater-elements)))))
(org-element-ast-map
data types fun
ignore-list first-match
no-recursion
;; Affiliated keywords may only contain objects.
(when (and with-affiliated objects?)
(mapcar #'cdr org-element--parsed-properties-alist))
;; Secondary strings may only contain objects.
(not objects?)
no-undefer))))
;; The following functions are internal parts of the parser.
;;