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:
Nicolas Goaziou 2012-05-05 15:56:12 +02:00
parent 8fb20b7f93
commit 88032eed64
2 changed files with 82 additions and 49 deletions

View File

@ -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.
;; Check if TYPE is matching among TYPES. If so, ((and info (member --data (plist-get info :ignore-list))))
;; apply FUN to --BLOB and accumulate return value ;; Secondary string: only objects can be found there.
;; into --ACC (or exit if FIRST-MATCH is non-nil). ((not --type)
(when (memq --type types) (when (eq --category 'objects) (mapc --walk-tree --data)))
(let ((result (funcall fun --blob))) ;; Unconditionally enter parse trees.
(cond ((not result)) ((eq --type 'org-data)
(first-match (throw 'first-match result)) (mapc --walk-tree (org-element-contents --data)))
(t (push result --acc))))) (t
;; If --BLOB has a secondary string that can ;; Check if TYPE is matching among TYPES. If so,
;; contain objects with their type among TYPES, ;; apply FUN to --DATA and accumulate return value
;; look into that string. ;; into --ACC (or exit if FIRST-MATCH is non-nil).
(when (memq --type --restricts) (when (memq --type types)
(funcall (let ((result (funcall fun --data)))
--walk-tree (cond ((not result))
`(org-data (first-match (throw 'first-match result))
nil (t (push result --acc)))))
,@(org-element-property ;; If --DATA has a secondary string that can contain
(cdr (assq --type org-element-secondary-value-alist)) ;; objects with their type among TYPES, look into it.
--blob)))) (when (eq --category 'objects)
;; Now determine if a recursion into --BLOB is (let ((sec-prop
;; possible. If so, do it. (assq --type org-element-secondary-value-alist)))
(unless (memq --type no-recursion) (when sec-prop
(when (or (and (memq --type org-element-greater-elements) (funcall --walk-tree
(not (eq --category 'greater-elements))) (org-element-property (cdr sec-prop) --data)))))
(and (memq --type org-element-all-elements) ;; Determine if a recursion into --DATA is possible.
(not (eq --category 'elements))) (cond
(org-element-contents --blob)) ;; --TYPE is explicitly removed from recursion.
(funcall --walk-tree --blob)))))) ((memq --type no-recursion))
(org-element-contents --data)))))) ;; --DATA has no contents.
((not (org-element-contents --data)))
;; Looking for greater elements but --DATA is simply
;; an element or an object.
((and (eq --category 'greater-elements)
(not (memq --type org-element-greater-elements))))
;; Looking for elements but --DATA is an object.
((and (eq --category 'elements)
(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.

View File

@ -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