diff --git a/lisp/org-element-ast.el b/lisp/org-element-ast.el index c575f2aad..c47cdb671 100644 --- a/lisp/org-element-ast.el +++ b/lisp/org-element-ast.el @@ -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. diff --git a/lisp/org-element.el b/lisp/org-element.el index 1b45e0ab7..5e907937f 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -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. ;;