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.
|
;; 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.
|
||||||
|
|
||||||
|
|
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
|
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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
Loading…
Reference in New Issue