org-element: Implement `org-element-secondary-p'

* lisp/org-element.el (org-element-secondary-p): New function.
* lisp/ox.el (org-export-get-previous-element,
  org-export-get-next-element): Use new function.
* testing/lisp/test-org-element.el (test-org-element/secondary-p): New
  test.
This commit is contained in:
Nicolas Goaziou 2013-11-30 15:23:07 +01:00
parent 0e376f2cd0
commit 0fd4245a43
3 changed files with 51 additions and 39 deletions

View File

@ -428,6 +428,16 @@ The function takes care of setting `:parent' property for NEW."
;; Transfer type. ;; Transfer type.
(setcar old (car new))) (setcar old (car new)))
(defun org-element-secondary-p (object)
"Non-nil when OBJECT belongs to a secondary string.
Return value is the property name, as a keyword, or nil."
(let* ((parent (org-element-property :parent object))
(property (cdr (assq (org-element-type parent)
org-element-secondary-value-alist))))
(and property
(memq object (org-element-property property parent))
property)))
(defsubst org-element-adopt-elements (parent &rest children) (defsubst org-element-adopt-elements (parent &rest children)
"Append elements to the contents of another element. "Append elements to the contents of another element.

View File

@ -5220,27 +5220,19 @@ When optional argument N is a positive integer, return a list
containing up to N siblings before BLOB, from farthest to containing up to N siblings before BLOB, from farthest to
closest. With any other non-nil value, return a list containing closest. With any other non-nil value, return a list containing
all of them." all of them."
(let ((siblings (let* ((secondary (org-element-secondary-p blob))
;; An object can belong to the contents of its parent or (parent (org-export-get-parent blob))
;; to a secondary string. We check the latter option (siblings
;; first. (if secondary (org-element-property secondary parent)
(let ((parent (org-export-get-parent blob))) (org-element-contents parent)))
(or (let ((sec-value (org-element-property prev)
(cdr (assq (org-element-type parent)
org-element-secondary-value-alist))
parent)))
(and (memq blob sec-value) sec-value))
(org-element-contents parent))))
prev)
(catch 'exit (catch 'exit
(mapc (lambda (obj) (dolist (obj (cdr (memq blob (reverse siblings))) prev)
(cond ((memq obj (plist-get info :ignore-list))) (cond ((memq obj (plist-get info :ignore-list)))
((null n) (throw 'exit obj)) ((null n) (throw 'exit obj))
((not (wholenump n)) (push obj prev)) ((not (wholenump n)) (push obj prev))
((zerop n) (throw 'exit prev)) ((zerop n) (throw 'exit prev))
(t (decf n) (push obj prev)))) (t (decf n) (push obj prev)))))))
(cdr (memq blob (reverse siblings))))
prev)))
(defun org-export-get-next-element (blob info &optional n) (defun org-export-get-next-element (blob info &optional n)
"Return next element or object. "Return next element or object.
@ -5253,26 +5245,20 @@ When optional argument N is a positive integer, return a list
containing up to N siblings after BLOB, from closest to farthest. containing up to N siblings after BLOB, from closest to farthest.
With any other non-nil value, return a list containing all of With any other non-nil value, return a list containing all of
them." them."
(let ((siblings (let* ((secondary (org-element-secondary-p blob))
;; An object can belong to the contents of its parent or to (parent (org-export-get-parent blob))
;; a secondary string. We check the latter option first. (siblings
(let ((parent (org-export-get-parent blob))) (cdr (memq blob
(or (let ((sec-value (org-element-property (if secondary (org-element-property secondary parent)
(cdr (assq (org-element-type parent) (org-element-contents parent)))))
org-element-secondary-value-alist)) next)
parent)))
(cdr (memq blob sec-value)))
(cdr (memq blob (org-element-contents parent))))))
next)
(catch 'exit (catch 'exit
(mapc (lambda (obj) (dolist (obj siblings (nreverse next))
(cond ((memq obj (plist-get info :ignore-list))) (cond ((memq obj (plist-get info :ignore-list)))
((null n) (throw 'exit obj)) ((null n) (throw 'exit obj))
((not (wholenump n)) (push obj next)) ((not (wholenump n)) (push obj next))
((zerop n) (throw 'exit (nreverse next))) ((zerop n) (throw 'exit (nreverse next)))
(t (decf n) (push obj next)))) (t (decf n) (push obj next)))))))
siblings)
(nreverse next))))
;;;; Translation ;;;; Translation

View File

@ -141,6 +141,22 @@ Some other text
(org-element-map tree 'italic 'identity nil t)) (org-element-map tree 'italic 'identity nil t))
(org-element-map tree 'paragraph 'identity nil t)))))) (org-element-map tree 'paragraph 'identity nil t))))))
(ert-deftest test-org-element/secondary-p ()
"Test `org-element-secondary-p' specifications."
;; In a secondary string, return property name.
(should
(eq :title
(org-test-with-temp-text "* Headline *object*"
(org-element-map (org-element-parse-buffer) 'bold
(lambda (object) (org-element-secondary-p object))
nil t))))
;; Outside a secondary string, return nil.
(should-not
(org-test-with-temp-text "Paragraph *object*"
(org-element-map (org-element-parse-buffer) 'bold
(lambda (object) (org-element-type (org-element-secondary-p object)))
nil t))))
(ert-deftest test-org-element/adopt-elements () (ert-deftest test-org-element/adopt-elements ()
"Test `org-element-adopt-elements' specifications." "Test `org-element-adopt-elements' specifications."
;; Adopt an element. ;; Adopt an element.