From 3a70c906671f75574b6faefebe711442ed776d7e Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <n.goaziou@gmail.com>
Date: Sat, 7 Jul 2012 00:47:51 +0200
Subject: [PATCH] org-element: Implement a function to find object at point

* contrib/lisp/org-element.el (org-element-context): New function.
* testing/lisp/test-org-element.el: Add tests.
---
 contrib/lisp/org-element.el      | 82 ++++++++++++++++++++++++++++++++
 testing/lisp/test-org-element.el | 19 ++++++++
 2 files changed, 101 insertions(+)

diff --git a/contrib/lisp/org-element.el b/contrib/lisp/org-element.el
index 7c20f9ca2..fb0dbf662 100644
--- a/contrib/lisp/org-element.el
+++ b/contrib/lisp/org-element.el
@@ -3853,6 +3853,9 @@ indentation is not done with TAB characters."
 ;; and moves, element after element, with
 ;; `org-element-current-element' until the container is found.
 ;;
+;; At a deeper level, `org-element-context' lists all elements and
+;; objects containing point.
+;;
 ;; Note: When using `org-element-at-point', secondary values are never
 ;; parsed since the function focuses on elements, not on objects.
 
@@ -3929,6 +3932,85 @@ first element of current section."
 		 (narrow-to-region beg end)
 		 (goto-char beg)))))))))))
 
+(defun org-element-context ()
+  "Return list of all elements and objects around point.
+
+Return value is a list like (TYPE PROPS) where TYPE is the type
+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'.
+
+All elements and objects returned belong to the current section
+and are ordered from closest to farthest."
+  (org-with-wide-buffer
+   (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)
+     ;; Check if point is inside an element containing objects or at
+     ;; a secondary string.  In that case, move to beginning of the
+     ;; element or secondary string and set END to the other side.
+     (if (not (or (and (eq type 'item)
+		       (let ((tag (org-element-property :tag element)))
+			 (and tag
+			      (progn
+				(beginning-of-line)
+				(search-forward tag (point-at-eol))
+				(goto-char (match-beginning 0))
+				(and (>= origin (point))
+				     (<= origin
+					 ;; `1+' is required so some
+					 ;; successors can match
+					 ;; properly their object.
+					 (setq end (1+ (match-end 0)))))))))
+		  (and (memq type '(headline inlinetask))
+		       (progn (beginning-of-line)
+			      (skip-chars-forward "* ")
+			      (setq end (point-at-eol))))
+		  (and (memq (car element) '(paragraph table-cell verse-block))
+		       (let ((cbeg (org-element-property
+				    :contents-begin element))
+			     (cend (org-element-property
+				    :contents-end element)))
+			 (and (>= origin cbeg)
+			      (<= origin cend)
+			      (progn (goto-char cbeg) (setq end cend)))))))
+	 elements
+       (let ((restriction (org-element-restriction element)) candidates)
+	 (catch 'exit
+	   (while (setq candidates (org-element-get-next-object-candidates
+				    end restriction candidates))
+	     (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
+					candidates)))
+	       ;; If ORIGIN is before next object in element, there's
+	       ;; no point in looking further.
+	       (if (> (cdr closest-cand) origin) (throw 'exit elements)
+		 (let* ((object
+			 (progn (goto-char (cdr closest-cand))
+				(funcall (intern (format "org-element-%s-parser"
+							 (car closest-cand))))))
+			(cbeg (org-element-property :contents-begin object))
+			(cend (org-element-property :contents-end object)))
+		   (cond
+		    ;; ORIGIN is after OBJECT, so skip it.
+		    ((< (org-element-property :end object) origin)
+		     (goto-char (org-element-property :end object)))
+		    ;; ORIGIN is within a non-recursive object or at an
+		    ;; object boundaries: Return that object.
+		    ((or (not cbeg) (> cbeg origin) (< cend origin))
+		     (throw 'exit (cons object elements)))
+		    ;; Otherwise, move within current object and restrict
+		    ;; search to the end of its contents.
+		    (t (goto-char cbeg)
+		       (setq end cend)
+		       (push object elements)))))))
+	   elements))))))
+
 
 ;; Once the local structure around point is well understood, it's easy
 ;; to implement some replacements for `forward-paragraph'
diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el
index cb6b1f599..ad8bc0be6 100644
--- a/testing/lisp/test-org-element.el
+++ b/testing/lisp/test-org-element.el
@@ -2072,6 +2072,25 @@ Paragraph \\alpha."
        (org-test-with-temp-text "- item"
 	 (org-element-type (org-element-at-point))))))
 
+(ert-deftest test-org-element/context ()
+  "Test `org-element-context' specifications."
+  ;; List all objects and elements containing point.
+  (should
+   (equal
+    '(subscript bold paragraph)
+    (mapcar 'car
+	    (org-test-with-temp-text "Some *text with _underline_*"
+	      (progn (search-forward "under")
+		     (org-element-context))))))
+  ;; Find objects in secondary strings.
+  (should
+   (equal
+    '(underline headline)
+    (mapcar 'car
+	    (org-test-with-temp-text "* Headline _with_ underlining"
+	      (progn (search-forward "w")
+		     (org-element-context)))))))
+
 (ert-deftest test-org-element/forward ()
   "Test `org-element-forward' specifications."
   ;; 1. At EOB: should error.