summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <n.goaziou@gmail.com>2012-12-08 18:57:10 +0100
committerNicolas Goaziou <n.goaziou@gmail.com>2012-12-08 18:57:10 +0100
commitcbb96d69d312a611a25be86369d7d055af4a7200 (patch)
treebbe770f196ab75aeeace04e61ee741924665a10c
parent2f9ddaf69981f334812ca4ae32600afdcdaa6aa7 (diff)
downloadorg-mode-cbb96d69d312a611a25be86369d7d055af4a7200.tar.gz
org-export: Add an optional argument to previous an next elements getters
* 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.
-rw-r--r--contrib/lisp/org-export.el99
-rw-r--r--testing/lisp/test-org-export.el21
2 files changed, 79 insertions, 41 deletions
diff --git a/contrib/lisp/org-export.el b/contrib/lisp/org-export.el
index 00a5ef5..0a44e4d 100644
--- a/contrib/lisp/org-export.el
+++ b/contrib/lisp/org-export.el
@@ -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)))))))
-
-(defun org-export-get-next-element (blob info)
+ (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 &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
diff --git a/testing/lisp/test-org-export.el b/testing/lisp/test-org-export.el
index dc67059..3693978 100644
--- a/testing/lisp/test-org-export.el
+++ b/testing/lisp/test-org-export.el
@@ -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)