org-element: `org-element-map' applies to strings and secondary strings
* contrib/lisp/org-element.el (org-element-map): `org-element-map' now applies to strings and secondary strings. * testing/lisp/test-org-element.el: Add tests.
This commit is contained in:
parent
8fb20b7f93
commit
88032eed64
|
@ -3324,62 +3324,60 @@ Nil values returned from FUN do not appear in the results."
|
||||||
;; Recursion depth is determined by --CATEGORY.
|
;; Recursion depth is determined by --CATEGORY.
|
||||||
(let* ((--category
|
(let* ((--category
|
||||||
(cond
|
(cond
|
||||||
((loop for type in types
|
((every (lambda (el) (memq el org-element-greater-elements)) types)
|
||||||
always (memq type org-element-greater-elements))
|
|
||||||
'greater-elements)
|
'greater-elements)
|
||||||
((loop for type in types
|
((every (lambda (el) (memq el org-element-all-elements)) types)
|
||||||
always (memq type org-element-all-elements))
|
|
||||||
'elements)
|
'elements)
|
||||||
(t 'objects)))
|
(t 'objects)))
|
||||||
;; --RESTRICTS is a list of element types whose secondary
|
|
||||||
;; string could possibly contain an object with a type among
|
|
||||||
;; TYPES.
|
|
||||||
(--restricts
|
|
||||||
(and (eq --category 'objects)
|
|
||||||
(loop for el in org-element-secondary-value-alist
|
|
||||||
when
|
|
||||||
(loop for o in types
|
|
||||||
thereis (memq o (org-element-restriction (car el))))
|
|
||||||
collect (car el))))
|
|
||||||
--acc
|
--acc
|
||||||
(--walk-tree
|
(--walk-tree
|
||||||
(function
|
(function
|
||||||
(lambda (--data)
|
(lambda (--data)
|
||||||
;; Recursively walk DATA. INFO, if non-nil, is
|
;; Recursively walk DATA. INFO, if non-nil, is a plist
|
||||||
;; a plist holding contextual information.
|
;; holding contextual information.
|
||||||
(mapc
|
(let ((--type (org-element-type --data)))
|
||||||
(lambda (--blob)
|
(cond
|
||||||
(unless (and info (member --blob (plist-get info :ignore-list)))
|
((not --data))
|
||||||
(let ((--type (org-element-type --blob)))
|
;; Ignored element in an export context.
|
||||||
|
((and info (member --data (plist-get info :ignore-list))))
|
||||||
|
;; Secondary string: only objects can be found there.
|
||||||
|
((not --type)
|
||||||
|
(when (eq --category 'objects) (mapc --walk-tree --data)))
|
||||||
|
;; Unconditionally enter parse trees.
|
||||||
|
((eq --type 'org-data)
|
||||||
|
(mapc --walk-tree (org-element-contents --data)))
|
||||||
|
(t
|
||||||
;; Check if TYPE is matching among TYPES. If so,
|
;; Check if TYPE is matching among TYPES. If so,
|
||||||
;; apply FUN to --BLOB and accumulate return value
|
;; apply FUN to --DATA and accumulate return value
|
||||||
;; into --ACC (or exit if FIRST-MATCH is non-nil).
|
;; into --ACC (or exit if FIRST-MATCH is non-nil).
|
||||||
(when (memq --type types)
|
(when (memq --type types)
|
||||||
(let ((result (funcall fun --blob)))
|
(let ((result (funcall fun --data)))
|
||||||
(cond ((not result))
|
(cond ((not result))
|
||||||
(first-match (throw 'first-match result))
|
(first-match (throw 'first-match result))
|
||||||
(t (push result --acc)))))
|
(t (push result --acc)))))
|
||||||
;; If --BLOB has a secondary string that can
|
;; If --DATA has a secondary string that can contain
|
||||||
;; contain objects with their type among TYPES,
|
;; objects with their type among TYPES, look into it.
|
||||||
;; look into that string.
|
(when (eq --category 'objects)
|
||||||
(when (memq --type --restricts)
|
(let ((sec-prop
|
||||||
(funcall
|
(assq --type org-element-secondary-value-alist)))
|
||||||
--walk-tree
|
(when sec-prop
|
||||||
`(org-data
|
(funcall --walk-tree
|
||||||
nil
|
(org-element-property (cdr sec-prop) --data)))))
|
||||||
,@(org-element-property
|
;; Determine if a recursion into --DATA is possible.
|
||||||
(cdr (assq --type org-element-secondary-value-alist))
|
(cond
|
||||||
--blob))))
|
;; --TYPE is explicitly removed from recursion.
|
||||||
;; Now determine if a recursion into --BLOB is
|
((memq --type no-recursion))
|
||||||
;; possible. If so, do it.
|
;; --DATA has no contents.
|
||||||
(unless (memq --type no-recursion)
|
((not (org-element-contents --data)))
|
||||||
(when (or (and (memq --type org-element-greater-elements)
|
;; Looking for greater elements but --DATA is simply
|
||||||
(not (eq --category 'greater-elements)))
|
;; an element or an object.
|
||||||
(and (memq --type org-element-all-elements)
|
((and (eq --category 'greater-elements)
|
||||||
(not (eq --category 'elements)))
|
(not (memq --type org-element-greater-elements))))
|
||||||
(org-element-contents --blob))
|
;; Looking for elements but --DATA is an object.
|
||||||
(funcall --walk-tree --blob))))))
|
((and (eq --category 'elements)
|
||||||
(org-element-contents --data))))))
|
(memq --type org-element-all-objects)))
|
||||||
|
;; In any other case, map contents.
|
||||||
|
(t (mapc --walk-tree (org-element-contents --data)))))))))))
|
||||||
(catch 'first-match
|
(catch 'first-match
|
||||||
(funcall --walk-tree data)
|
(funcall --walk-tree data)
|
||||||
;; Return value in a proper order.
|
;; Return value in a proper order.
|
||||||
|
|
|
@ -33,6 +33,41 @@ Return interpreted string."
|
||||||
(org-element-interpret-data (org-element-parse-buffer))))
|
(org-element-interpret-data (org-element-parse-buffer))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
;;; Test `org-element-map'
|
||||||
|
|
||||||
|
(ert-deftest test-org-element/map ()
|
||||||
|
"Test `org-element-map'."
|
||||||
|
;; Can map to `plain-text' objects.
|
||||||
|
(should
|
||||||
|
(= 2
|
||||||
|
(org-test-with-temp-text "Some text \alpha
|
||||||
|
#+BEGIN_CENTER
|
||||||
|
Some other text
|
||||||
|
#+END_CENTER"
|
||||||
|
(let ((count 0))
|
||||||
|
(org-element-map
|
||||||
|
(org-element-parse-buffer) 'plain-text
|
||||||
|
(lambda (s) (when (string-match "text" s) (incf count))))
|
||||||
|
count))))
|
||||||
|
;; Applies to secondary strings
|
||||||
|
(should
|
||||||
|
(org-element-map '("some " (bold nil "bold") "text") 'bold 'identity))
|
||||||
|
;; Enter secondary strings before entering contents.
|
||||||
|
(should
|
||||||
|
(equal
|
||||||
|
"alpha"
|
||||||
|
(org-element-property
|
||||||
|
:name
|
||||||
|
(org-test-with-temp-text "* Some \\alpha headline\n\\beta entity."
|
||||||
|
(org-element-map (org-element-parse-buffer) 'entity 'identity nil t)))))
|
||||||
|
;; Apply NO-RECURSION argument.
|
||||||
|
(should-not
|
||||||
|
(org-test-with-temp-text "#+BEGIN_CENTER\n\\alpha\n#+END_CENTER"
|
||||||
|
(org-element-map
|
||||||
|
(org-element-parse-buffer) 'entity 'identity nil nil 'center-block))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;;; Test Parsers
|
;;; Test Parsers
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue