mirror/org-mode
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-11-26 07:33:39 +00:00
Code

org-export: Add an optional argument to previous an next elements getters

Browse Source 
* contrib/lisp/org-export.el (org-export-get-previous-element,
  org-export-get-next-element): Change signature.
* testing/lisp/test-org-export.el: Add tests.
This commit is contained in:
Nicolas Goaziou 2012-12-08 18:57:10 +01:00
parent 2f9ddaf699
commit cbb96d69d3
2 changed files with 78 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
contrib/lisp/org-export.el
View File

@ -4627,53 +4627,74 @@ OBJECT is either a `table-cell' or `table-element' type object."
(not (eq (org-element-type parent) 'table))))
parent))
(defun org-export-get-previous-element (blob info)
(defun org-export-get-previous-element (blob info &optional n)
"Return previous element or object.
BLOB is an element or object. INFO is a plist used as
a communication channel. Return previous exportable element or
object, a string, or nil."
(let (prev)
object, a string, or nil.
When optional argument N is a positive integer, return a list
containing up to N siblings before BLOB, from closest to
farthest."
(when (and n (not (wholenump n))) (setq n nil))
(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 (and (not (memq (org-element-type blob)
org-element-all-elements))
(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)
(catch 'exit
(mapc (lambda (obj)
(cond ((eq obj blob) (throw 'exit prev))
((memq obj (plist-get info :ignore-list)))
(t (setq prev obj))))
;; 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 (and (not (memq (org-element-type blob)
org-element-all-elements))
(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)))))))
(cond ((memq obj (plist-get info :ignore-list)))
((null n) (throw 'exit obj))
((zerop n) (throw 'exit (nreverse prev)))
(t (decf n) (push obj prev))))
(cdr (memq blob (reverse siblings))))
(nreverse prev))))
(defun org-export-get-next-element (blob info)
(defun org-export-get-next-element (blob info &optional n)
"Return next element or object.
BLOB is an element or object. INFO is a plist used as
a communication channel. Return next exportable element or
object, a string, or nil."
(catch 'found
(mapc (lambda (obj)
(unless (memq obj (plist-get info :ignore-list))
(throw 'found obj)))
;; 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 (and (not (memq (org-element-type blob)
org-element-all-objects))
(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))))))
nil))
object, a string, or nil.
When optional argument N is a positive integer, return a list
containing up to N siblings after BLOB, from closest to
farthest."
(when (and n (not (wholenump n))) (setq n nil))
(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 (and (not (memq (org-element-type blob)
org-element-all-objects))
(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)
(catch 'exit
(mapc (lambda (obj)
(cond ((memq obj (plist-get info :ignore-list)))
((null n) (throw 'exit obj))
((zerop n) (throw 'exit (nreverse next)))
(t (decf n) (push obj next))))
siblings)
(nreverse next))))
;;;; Translation

21
testing/lisp/test-org-export.el
View File

@ -2211,7 +2211,16 @@ Another text. (ref:text)
(org-test-with-parsed-data "#+CAPTION: a =verb=\nParagraph"
(org-element-type
(org-export-get-next-element
(org-element-map tree 'plain-text 'identity info t nil t) info))))))
(org-element-map tree 'plain-text 'identity info t nil t) info)))))
;; With optional argument N, return a list containing up to
;; N following elements.
(should
(equal
'(bold code)
(org-test-with-parsed-data "_a_ /b/ *c* ~d~"
(mapcar 'car
(org-export-get-next-element
(org-element-map tree 'italic 'identity info t) info 2))))))
(ert-deftest test-org-export/get-previous-element ()
"Test `org-export-get-previous-element' specifications."
@ -2253,7 +2262,15 @@ Another text. (ref:text)
(org-test-with-parsed-data "#+CAPTION: =verb= a\nParagraph"
(org-element-type
(org-export-get-previous-element
(org-element-map tree 'plain-text 'identity info t nil t) info))))))
(org-element-map tree 'plain-text 'identity info t nil t) info)))))
;; With optional argument N, return a list containing up to
;; N previous elements.
(should
(equal '(bold italic)
(org-test-with-parsed-data "_a_ /b/ *c* ~d~"
(mapcar 'car
(org-export-get-previous-element
(org-element-map tree 'code 'identity info t) info 2))))))
(provide 'test-org-export)