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.
(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)
"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
closest. With any other non-nil value, return a list containing
all of them."
(let ((siblings
;; An object can belong to the contents of its parent or
;; to a secondary string. We check the latter option
;; first.
(let ((parent (org-export-get-parent blob)))
(or (let ((sec-value (org-element-property
(cdr (assq (org-element-type parent)
org-element-secondary-value-alist))
parent)))
(and (memq blob sec-value) sec-value))
(org-element-contents parent))))
prev)
(let* ((secondary (org-element-secondary-p blob))
(parent (org-export-get-parent blob))
(siblings
(if secondary (org-element-property secondary parent)
(org-element-contents parent)))
prev)
(catch 'exit
(mapc (lambda (obj)
(cond ((memq obj (plist-get info :ignore-list)))
((null n) (throw 'exit obj))
((not (wholenump n)) (push obj prev))
((zerop n) (throw 'exit prev))
(t (decf n) (push obj prev))))
(cdr (memq blob (reverse siblings))))
prev)))
(dolist (obj (cdr (memq blob (reverse siblings))) prev)
(cond ((memq obj (plist-get info :ignore-list)))
((null n) (throw 'exit obj))
((not (wholenump n)) (push obj prev))
((zerop n) (throw 'exit prev))
(t (decf n) (push obj prev)))))))
(defun org-export-get-next-element (blob info &optional n)
"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.
With any other non-nil value, return a list containing all of
them."
(let ((siblings
;; An object can belong to the contents of its parent or to
;; a secondary string. We check the latter option first.
(let ((parent (org-export-get-parent blob)))
(or (let ((sec-value (org-element-property
(cdr (assq (org-element-type parent)
org-element-secondary-value-alist))
parent)))
(cdr (memq blob sec-value)))
(cdr (memq blob (org-element-contents parent))))))
next)
(let* ((secondary (org-element-secondary-p blob))
(parent (org-export-get-parent blob))
(siblings
(cdr (memq blob
(if secondary (org-element-property secondary parent)
(org-element-contents parent)))))
next)
(catch 'exit
(mapc (lambda (obj)
(cond ((memq obj (plist-get info :ignore-list)))
((null n) (throw 'exit obj))
((not (wholenump n)) (push obj next))
((zerop n) (throw 'exit (nreverse next)))
(t (decf n) (push obj next))))
siblings)
(nreverse next))))
(dolist (obj siblings (nreverse next))
(cond ((memq obj (plist-get info :ignore-list)))
((null n) (throw 'exit obj))
((not (wholenump n)) (push obj next))
((zerop n) (throw 'exit (nreverse next)))
(t (decf n) (push obj next)))))))
;;;; Translation

View File

@ -141,6 +141,22 @@ Some other text
(org-element-map tree 'italic '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 ()
"Test `org-element-adopt-elements' specifications."
;; Adopt an element.