It's been a while since my question on this mailing list about block
boundaries [1]. For my private code I came up with the function below
to both get and test on all sorts of block boundaries. Like this:
(and-let* ((element (or element (org-element-at-point)))
;; returns nil if point is outside of markup
(boundaries (org-element-boundaries element 'markup t))
(start (car boundaries))
(end (cdr boundaries)))
...)
API and code are surely rather sound than ingenious, but if you
consider it (or some variation of it) useful for inclusion into Org
mode, just let me know, I'd prepare a proper patch plus tests plus ...
The second part of the code is for interactive testing only.
If you feel I should provide examples where this could be actually
used in Org's code base, just let me know - I can set up some example
patches as well.
Thanks!
[1]:
https://list.orgmode.org/628222e2-d516-4ff0-b244-66f20f286...@vodafonemail.de/
(defun org-element-boundaries (element boundary-type &optional point-test)
"Return a cons (START . END) of the boundaries of ELEMENT.
Determine START and END depending on BOUNDARY-TYPE, which can be any of the
following symbols:
`element', `gross-elt': Return the outer element boundaries, which include
leading affiliated keywords and trailing blank lines [1].
`markup', `net-elt': Return the boundaries of the element sans affiliated
keywords and trailing blank lines. For block-like elements this coincides
with the markup boundaries [2].
For block-like elements, that is, elements having separate markup lines
like source blocks, the following boundary types are also available:
`contents', `gross-contents': Return the boundaries of the block contents
[3].
`net-contents': Return the boundaries of the block contents sans leading
and trailing whitespace (' \\t\\n\\r') [4].
Here is an example block that shows the boundaries as returned by this
function (leading and trailing blanks denoted with underscores):
[1...#+name: foo
[2...#+begin_example
[3...__[4...foo
bar
__baz...4]__
__...3]
#+end_example__...2]
__...1]
Bar.
BOUNDARY-TYPE can also be a cons (START-TYPE . END-TYPE) to determine START
and END with respect to different boundary types.
For certain combinations of contents-based boundary types and degenerate
blocks, the literal interpretation of above rules could result in END being
smaller than START. In these cases this function returns START and END
equal to CONTENTS-START, where CONTENTS-START is the position of the
beginning of line after the opening markup line.
Except for that special case and boundary type `net-contents' in general,
START is always at the beginning and END is always at the end of a line.
START is always smaller than or equal to END.
If optional parameter POINT-TEST equals `exclusive', this function returns
nil instead of the cons if point is not exclusively/strictly between START
and END. Any other non-nil value changes that to a non-exclusive test,
where point is allowed to equal START or END. POINT-TEST can also be a
cons (START-TEST . END-TEST) to test START or END vs. point with respect to
different values of strictness."
(let* ((start-type (or (car-safe boundary-type) boundary-type))
(end-type (or (cdr-safe boundary-type) boundary-type))
(start-test (if (consp point-test) (car point-test) point-test))
(end-test (if (consp point-test) (cdr point-test) point-test))
(point (point))
start end contents-start)
(org-with-wide-buffer
(setq start
(pcase-exhaustive start-type
((or 'element 'gross-elt)
(org-element-begin element))
((or 'markup 'net-elt)
(org-element-post-affiliated element))
((or 'contents 'gross-contents)
(goto-char (org-element-post-affiliated element))
(forward-line 1)
(setq contents-start (point))
(point))
('net-contents
(goto-char (org-element-post-affiliated element))
(forward-line 1)
(setq contents-start (point))
(skip-chars-forward " \t\n\r")
(point))))
(setq end
(progn
(goto-char (org-element-end element))
(pcase-exhaustive end-type
;; adjust element end depending on the
;; surrounding or following element
((or 'element 'gross-elt)
(if (looking-at "[ \t\n\r]*$")
(line-end-position 1)
(line-end-position 0)))
((or 'markup 'net-elt)
(skip-chars-backward " \t\n\r")
(line-end-position 1))
((or 'contents 'gross-contents)
(skip-chars-backward " \t\n\r")
(line-end-position 0))
('net-contents
(skip-chars-backward " \t\n\r")
(forward-line 0)
(skip-chars-backward " \t\n\r")
(point)))))
;; handle empty or whitespace-only blocks. CONTENTS-START
;; is nil if START-TYPE is not contents-based. Which is OK,
;; since in that case END is larger than START.
(when (< end start)
(setq start contents-start
end contents-start))
(and (cond ((not start-test))
((eq start-test 'exclusive)
(< start point))
((<= start point)))
(cond ((not end-test))
((eq end-test 'exclusive)
(< point end))
((<= point end)))
(cons start end)))))
;;; for interactive test purposes only
(defface org-element-boundaries-test-point-ok
'((t :background "green" :foreground "black" :weight bold))
"Face to show if point is inside boundaries.")
(defface org-element-boundaries-test-point-nok
'((t :background "red" :foreground "black" :weight bold))
"Face to show if point is not inside boundaries.")
(defvar org-element-boundaries-test-element nil)
(defvar org-element-boundaries-test-overlay nil)
(defun org-element-boundaries-test (element btct)
"Test `org-element-boundaries' in an interactive way.
Use `org-element-boundaries-test-element' as default for ELEMENT and map
numeric prefix argument BTCT per digits to boundary type and test type
as follows:
0: ('gross-elt nil)
1: ('gross-elt nil)
2: ('net-elt nil)
3: ('gross-contents nil)
4: ('net-contents nil)
N: ('gross-elt nil)
NM: ((N . M) nil)
NM0: ((N . M) nil)
NM1: ((N . M) t)
NM2: ((N . M) 'exclusive)
NMI: ((N . M) nil)
NMIJ: ((N . M) (I . J))
So a prefix argument 1312 results in a call
(org-element-boundaries ELEMENT '(gross-elt . gross-contents)
'(t . exclusive))"
(interactive
(list (or org-element-boundaries-test-element
(org-element-at-point))
(prefix-numeric-value current-prefix-arg)))
(let* ((bt [gross-elt gross-elt net-elt gross-contents net-contents
gross-elt gross-elt gross-elt gross-elt gross-elt])
(ct [nil t exclusive nil nil nil nil nil nil nil])
(btct (cond ((< btct 0) 1100)
((<= btct 9) (+ (* btct 1000) (* btct 100)))
((<= btct 99) (* btct 100))
((<= btct 999) (+ (* btct 10) (% btct 10)))
(t (% btct 10000))))
(btct (mapcar (lambda (n) (- n 48)) (number-to-string btct)))
(n (aref bt (nth 0 btct)))
(m (aref bt (nth 1 btct)))
(i (aref ct (nth 2 btct)))
(j (aref ct (nth 3 btct)))
(b (org-element-boundaries element (cons n m) nil))
(bt (org-element-boundaries element (cons n m) (cons i j))))
(if org-element-boundaries-test-overlay
(move-overlay org-element-boundaries-test-overlay (car b) (cdr b))
(setq org-element-boundaries-test-overlay
(make-overlay (car b) (cdr b))))
(if bt
(overlay-put org-element-boundaries-test-overlay
'face 'org-element-boundaries-test-point-ok)
(overlay-put org-element-boundaries-test-overlay
'face 'org-element-boundaries-test-point-nok)
(message "POINT OUT OF BOUNDARIES"))))
