forked from mirrors/org-mode
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:
parent
0e376f2cd0
commit
0fd4245a43
|
@ -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.
|
||||
|
||||
|
|
64
lisp/ox.el
64
lisp/ox.el
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
Loading…
Reference in New Issue