Browse Source

org-element: Modify output from `org-element-at-point' and `org-element-context'

* lisp/org-element.el (org-element-at-point): Add :parent property to
  output.
(org-element-context): Add :parent property to output.  Also return
a single element or object instead of a list of parents.
(org-element-forward, org-element-up): Apply changes.
* testing/lisp/test-org-element.el: Add tests.
Nicolas Goaziou 12 years ago
parent
commit
7cf9e5afb5
2 changed files with 86 additions and 68 deletions
  1. 50 54
      lisp/org-element.el
  2. 36 14
      testing/lisp/test-org-element.el

+ 50 - 54
lisp/org-element.el

@@ -4042,8 +4042,11 @@ indentation is not done with TAB characters."
 
 
 Return value is a list like (TYPE PROPS) where TYPE is the type
 Return value is a list like (TYPE PROPS) where TYPE is the type
 of the element and PROPS a plist of properties associated to the
 of the element and PROPS a plist of properties associated to the
-element.  Possible types are defined in
-`org-element-all-elements'.
+element.
+
+Possible types are defined in `org-element-all-elements'.
+Properties depend on element or object type, but always
+include :begin, :end, :parent and :post-blank properties.
 
 
 As a special case, if point is at the very beginning of a list or
 As a special case, if point is at the very beginning of a list or
 sub-list, returned element will be that list instead of the first
 sub-list, returned element will be that list instead of the first
@@ -4070,7 +4073,7 @@ first element of current section."
      (let ((origin (point))
      (let ((origin (point))
 	   (end (save-excursion
 	   (end (save-excursion
 		  (org-with-limited-levels (outline-next-heading)) (point)))
 		  (org-with-limited-levels (outline-next-heading)) (point)))
-	   element type special-flag trail struct prevs)
+	   element type special-flag trail struct prevs parent)
        (org-with-limited-levels
        (org-with-limited-levels
 	(if (org-with-limited-levels (org-before-first-heading-p))
 	(if (org-with-limited-levels (org-before-first-heading-p))
 	    (goto-char (point-min))
 	    (goto-char (point-min))
@@ -4085,7 +4088,8 @@ first element of current section."
            (setq element
            (setq element
 		 (org-element--current-element end 'element special-flag struct)
 		 (org-element--current-element end 'element special-flag struct)
                  type (car element))
                  type (car element))
-	   (push element trail)
+	   (org-element-put-property element :parent parent)
+	   (when keep-trail (push element trail))
            (cond
            (cond
 	    ;; 1. Skip any element ending before point or at point
 	    ;; 1. Skip any element ending before point or at point
 	    ;;    because the following element has started.  On the
 	    ;;    because the following element has started.  On the
@@ -4113,6 +4117,7 @@ first element of current section."
 		       (and (= cend origin) (/= (point-max) origin))
 		       (and (= cend origin) (/= (point-max) origin))
 		       (and (= cbeg origin) (memq type '(plain-list table))))
 		       (and (= cbeg origin) (memq type '(plain-list table))))
 		   (throw 'exit (if keep-trail trail element))
 		   (throw 'exit (if keep-trail trail element))
+		 (setq parent element)
 		 (case type
 		 (case type
 		   (plain-list
 		   (plain-list
 		    (setq special-flag 'item
 		    (setq special-flag 'item
@@ -4123,25 +4128,21 @@ first element of current section."
 		 (goto-char cbeg)))))))))))
 		 (goto-char cbeg)))))))))))
 
 
 (defun org-element-context ()
 (defun org-element-context ()
-  "Return list of all elements and objects around point.
+  "Return closest element or object around point.
 
 
 Return value is a list like (TYPE PROPS) where TYPE is the type
 Return value is a list like (TYPE PROPS) where TYPE is the type
 of the element or object and PROPS a plist of properties
 of the element or object and PROPS a plist of properties
-associated to it.  Possible types are defined in
-`org-element-all-elements' and `org-element-all-objects'.
+associated to it.
 
 
-All elements and objects returned belong to the current section
-and are ordered from closest to farthest."
+Possible types are defined in `org-element-all-elements' and
+`org-element-all-objects'.  Properties depend on element or
+object type, but always include :begin, :end, :parent
+and :post-blank properties."
   (org-with-wide-buffer
   (org-with-wide-buffer
    (let* ((origin (point))
    (let* ((origin (point))
-	  ;; Remove elements not containing point from trail.
-	  (elements (org-remove-if
-		     (lambda (el)
-		       (or (> (org-element-property :begin el) origin)
-			   (< (org-element-property :end el) origin)))
-		     (org-element-at-point 'keep-trail)))
-	  (element (car elements))
-	  (type (car element)) end)
+	  (element (org-element-at-point))
+	  (type (car element))
+	  end)
      ;; Check if point is inside an element containing objects or at
      ;; Check if point is inside an element containing objects or at
      ;; a secondary string.  In that case, move to beginning of the
      ;; a secondary string.  In that case, move to beginning of the
      ;; element or secondary string and set END to the other side.
      ;; element or secondary string and set END to the other side.
@@ -4162,7 +4163,7 @@ and are ordered from closest to farthest."
 		       (progn (beginning-of-line)
 		       (progn (beginning-of-line)
 			      (skip-chars-forward "* ")
 			      (skip-chars-forward "* ")
 			      (setq end (point-at-eol))))
 			      (setq end (point-at-eol))))
-		  (and (memq (car element) '(paragraph table-cell verse-block))
+		  (and (memq type '(paragraph table-cell verse-block))
 		       (let ((cbeg (org-element-property
 		       (let ((cbeg (org-element-property
 				    :contents-begin element))
 				    :contents-begin element))
 			     (cend (org-element-property
 			     (cend (org-element-property
@@ -4170,8 +4171,10 @@ and are ordered from closest to farthest."
 			 (and (>= origin cbeg)
 			 (and (>= origin cbeg)
 			      (<= origin cend)
 			      (<= origin cend)
 			      (progn (goto-char cbeg) (setq end cend)))))))
 			      (progn (goto-char cbeg) (setq end cend)))))))
-	 elements
-       (let ((restriction (org-element-restriction element)) candidates)
+	 element
+       (let ((restriction (org-element-restriction element))
+	     (parent element)
+	     candidates)
 	 (catch 'exit
 	 (catch 'exit
 	   (while (setq candidates (org-element--get-next-object-candidates
 	   (while (setq candidates (org-element--get-next-object-candidates
 				    end restriction candidates))
 				    end restriction candidates))
@@ -4179,7 +4182,7 @@ and are ordered from closest to farthest."
 					candidates)))
 					candidates)))
 	       ;; If ORIGIN is before next object in element, there's
 	       ;; If ORIGIN is before next object in element, there's
 	       ;; no point in looking further.
 	       ;; no point in looking further.
-	       (if (> (cdr closest-cand) origin) (throw 'exit elements)
+	       (if (> (cdr closest-cand) origin) (throw 'exit element)
 		 (let* ((object
 		 (let* ((object
 			 (progn (goto-char (cdr closest-cand))
 			 (progn (goto-char (cdr closest-cand))
 				(funcall (intern (format "org-element-%s-parser"
 				(funcall (intern (format "org-element-%s-parser"
@@ -4193,13 +4196,14 @@ and are ordered from closest to farthest."
 		    ;; ORIGIN is within a non-recursive object or at an
 		    ;; ORIGIN is within a non-recursive object or at an
 		    ;; object boundaries: Return that object.
 		    ;; object boundaries: Return that object.
 		    ((or (not cbeg) (> cbeg origin) (< cend origin))
 		    ((or (not cbeg) (> cbeg origin) (< cend origin))
-		     (throw 'exit (cons object elements)))
+		     (throw 'exit
+			    (org-element-put-property object :parent parent)))
 		    ;; Otherwise, move within current object and restrict
 		    ;; Otherwise, move within current object and restrict
 		    ;; search to the end of its contents.
 		    ;; search to the end of its contents.
 		    (t (goto-char cbeg)
 		    (t (goto-char cbeg)
-		       (setq end cend)
-		       (push object elements)))))))
-	   elements))))))
+		       (org-element-put-property object :parent parent)
+		       (setq parent object end cend)))))))
+	   parent))))))
 
 
 
 
 ;; Once the local structure around point is well understood, it's easy
 ;; Once the local structure around point is well understood, it's easy
@@ -4300,23 +4304,20 @@ end of ELEM-A."
   "Move forward by one element.
   "Move forward by one element.
 Move to the next element at the same level, when possible."
 Move to the next element at the same level, when possible."
   (interactive)
   (interactive)
-  (if (org-with-limited-levels (org-at-heading-p))
-      (let ((origin (point)))
-	(org-forward-same-level 1)
-	(unless (org-with-limited-levels (org-at-heading-p))
-	  (goto-char origin)
-	  (error "Cannot move further down")))
-    (let* ((trail (org-element-at-point 'keep-trail))
-	   (elem (pop trail))
-	   (end (org-element-property :end elem))
-	   (parent (loop for prev in trail
-			 when (>= (org-element-property :end prev) end)
-			 return prev)))
-      (cond
-       ((eobp) (error "Cannot move further down"))
-       ((and parent (= (org-element-property :contents-end parent) end))
-	(goto-char (org-element-property :end parent)))
-       (t (goto-char end))))))
+  (cond ((eobp) (error "Cannot move further down"))
+	((org-with-limited-levels (org-at-heading-p))
+	 (let ((origin (point)))
+	   (org-forward-same-level 1)
+	   (unless (org-with-limited-levels (org-at-heading-p))
+	     (goto-char origin)
+	     (error "Cannot move further down"))))
+	(t
+	 (let* ((elem (org-element-at-point))
+		(end (org-element-property :end elem))
+		(parent (org-element-property :parent elem)))
+	   (if (and parent (= (org-element-property :contents-end parent) end))
+	       (goto-char (org-element-property :end parent))
+	     (goto-char end))))))
 
 
 (defun org-element-backward ()
 (defun org-element-backward ()
   "Move backward by one element.
   "Move backward by one element.
@@ -4345,18 +4346,13 @@ Move to the previous element at the same level, when possible."
   "Move to upper element."
   "Move to upper element."
   (interactive)
   (interactive)
   (if (org-with-limited-levels (org-at-heading-p))
   (if (org-with-limited-levels (org-at-heading-p))
-      (unless (org-up-heading-safe)
-	(error "No surrounding element"))
-    (let* ((trail (org-element-at-point 'keep-trail))
-	   (elem (pop trail))
-	   (end (org-element-property :end elem))
-	   (parent (loop for prev in trail
-			 when (>= (org-element-property :end prev) end)
-			 return prev)))
-      (cond
-       (parent (goto-char (org-element-property :begin parent)))
-       ((org-before-first-heading-p) (error "No surrounding element"))
-       (t (org-back-to-heading))))))
+      (unless (org-up-heading-safe) (error "No surrounding element"))
+    (let* ((elem (org-element-at-point))
+	   (parent (org-element-property :parent elem)))
+      (if parent (goto-char (org-element-property :begin parent))
+	(if (org-with-limited-levels (org-before-first-heading-p))
+	    (error "No surrounding element")
+	  (org-with-limited-levels (org-back-to-heading)))))))
 
 
 (defun org-element-down ()
 (defun org-element-down ()
   "Move to inner element."
   "Move to inner element."

+ 36 - 14
testing/lisp/test-org-element.el

@@ -2225,6 +2225,19 @@ Paragraph \\alpha."
 
 
 (ert-deftest test-org-element/at-point ()
 (ert-deftest test-org-element/at-point ()
   "Test `org-element-at-point' specifications."
   "Test `org-element-at-point' specifications."
+  ;; Return closest element containing point.
+  (should
+   (eq 'paragraph
+       (org-test-with-temp-text "#+BEGIN_CENTER\nA\n#+END_CENTER"
+	 (progn (search-forward "A")
+		(org-element-type (org-element-at-point))))))
+  ;; Correctly set `:parent' property.
+  (should
+   (eq 'center-block
+       (org-test-with-temp-text "#+BEGIN_CENTER\nA\n#+END_CENTER"
+	 (progn (search-forward "A")
+		(org-element-type
+		 (org-element-property :parent (org-element-at-point)))))))
   ;; Special case: at the very beginning of a table, return `table'
   ;; Special case: at the very beginning of a table, return `table'
   ;; object instead of `table-row'.
   ;; object instead of `table-row'.
   (should
   (should
@@ -2236,26 +2249,35 @@ Paragraph \\alpha."
   (should
   (should
    (eq 'plain-list
    (eq 'plain-list
        (org-test-with-temp-text "- item"
        (org-test-with-temp-text "- item"
-	 (org-element-type (org-element-at-point))))))
+	 (org-element-type (org-element-at-point)))))
+  ;; With an optional argument, return trail.
+  (should
+   (equal '(paragraph center-block)
+	  (org-test-with-temp-text "#+BEGIN_CENTER\nA\n#+END_CENTER\nZ"
+	    (progn (search-forward "Z")
+		   (mapcar 'org-element-type (org-element-at-point t)))))))
 
 
 (ert-deftest test-org-element/context ()
 (ert-deftest test-org-element/context ()
   "Test `org-element-context' specifications."
   "Test `org-element-context' specifications."
-  ;; List all objects and elements containing point.
+  ;; Return closest object containing point.
   (should
   (should
-   (equal
-    '(subscript bold paragraph)
-    (mapcar 'car
-	    (org-test-with-temp-text "Some *text with _underline_*"
-	      (progn (search-forward "under")
-		     (org-element-context))))))
+   (eq 'underline
+       (org-test-with-temp-text "Some *text with _underline_ text*"
+	 (progn (search-forward "under")
+		(org-element-type (org-element-context))))))
   ;; Find objects in secondary strings.
   ;; Find objects in secondary strings.
   (should
   (should
-   (equal
-    '(underline headline)
-    (mapcar 'car
-	    (org-test-with-temp-text "* Headline _with_ underlining"
-	      (progn (search-forward "w")
-		     (org-element-context)))))))
+   (eq 'underline
+       (org-test-with-temp-text "* Headline _with_ underlining"
+	 (progn (search-forward "w")
+		(org-element-type (org-element-context))))))
+  ;; Correctly set `:parent' property.
+  (should
+   (eq 'paragraph
+       (org-test-with-temp-text "Some *bold* text"
+	 (progn (search-forward "bold")
+		(org-element-type
+		 (org-element-property :parent (org-element-context))))))))
 
 
 (ert-deftest test-org-element/forward ()
 (ert-deftest test-org-element/forward ()
   "Test `org-element-forward' specifications."
   "Test `org-element-forward' specifications."