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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

65
lisp/org-element.el
View File

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