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.
This commit is contained in:
Nicolas Goaziou 2012-07-07 00:47:51 +02:00
parent e2c2afe013
commit 3a70c90667
2 changed files with 101 additions and 0 deletions

View File

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

View File

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