Browse Source

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.
Nicolas Goaziou 11 years ago
parent
commit
0fd4245a43
3 changed files with 51 additions and 39 deletions
  1. 10 0
      lisp/org-element.el
  2. 25 39
      lisp/ox.el
  3. 16 0
      testing/lisp/test-org-element.el

+ 10 - 0
lisp/org-element.el

@@ -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.
 

+ 25 - 39
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

+ 16 - 0
testing/lisp/test-org-element.el

@@ -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.