gusbrs/expand-region-org-element.el

## expand-region-org-element.el
(defun my/er/mark-org-sentence ()
  "Marks one sentence."
  (interactive)
  (let* ((el (org-element-context))
         (type (org-element-type el))
         (par-el (org-element-property :parent el)))
    ;; FIXME: Consider if we should simply disable sentence marking in
    ;; certain element types, e.g. src-blocks.
    (save-restriction
      ;; Do not mark sentences beyond the limits of paragraphs.
      (cond
       ((and (eq type 'paragraph)
             (<= (point-min)
                 (org-element-property :contents-begin el))
             (>= (point)
                 (org-element-property :contents-begin el)))
        (narrow-to-region (org-element-property :contents-begin el)
                          (org-element-property :contents-end el)))
       ((and (memq type org-element-all-objects)
             (eq (org-element-type par-el) 'paragraph)
             (<= (point-min)
                 (org-element-property :contents-begin par-el))
             (>= (point)
                 (org-element-property :contents-begin par-el)))
        (narrow-to-region (org-element-property :contents-begin par-el)
                          (org-element-property :contents-end par-el))))
      (forward-char 1)
      (org-backward-sentence 1)
      (set-mark (point))
      (org-forward-sentence 1)
      (exchange-point-and-mark))))

(defun my/er/mark-org-symbol ()
  "Mark the entire symbol around or in front of point."
  (interactive)
  (let ((symbol-regexp "\\s_\\|\\sw")
        (emph-regexp
         (format "\\([%s]\\)" (mapconcat #'car org-emphasis-alist ""))))
    (when (or (looking-at symbol-regexp)
              (er/looking-back-on-line symbol-regexp))
      (skip-syntax-forward "_w")
      (re-search-backward emph-regexp (1- (point)) t)
      (set-mark (point))
      (skip-syntax-backward "_w")
      (re-search-forward (if (match-string 1)
                             (format "\\(%s\\)" (match-string 1))
                           emph-regexp)
                         (1+ (point)) t)
      (if (match-string 1) (goto-char (match-end 1))))))

(defun my/er/mark-org-element (&optional parent)
  (interactive)
  (let* ((el-at-point (org-element-context))
         (par-el-at-point (org-element-property :parent el-at-point))
         (el (if parent
                 (cond
                  ((not par-el-at-point)
                   (save-excursion
                     (ignore-errors (org-up-element))
                     ;; Given el-at-point has no parent at this point,
                     ;; `org-up-element' will bring point to a heading
                     ;; (back-to-heading, if not on a heading, and
                     ;; up-heading, if on one), unless it is before the
                     ;; first one. Note: headlines have no parents.
                     (when (org-with-limited-levels (org-at-heading-p))
                       (org-element-at-point))))
                  ((and
                    (memq (org-element-type el-at-point)
                          org-element-all-objects)
                    (eq (org-element-type par-el-at-point) 'paragraph)
                    (memq (org-element-type
                           (org-element-property :parent par-el-at-point))
                          '(item quote-block center-block drawer)))
                   ;; Corner case, when an 'object' is also the first thing
                   ;; on a plain list item.  In this case, if we simply get
                   ;; the parent, it will be paragraph, and further
                   ;; expansion will lose the list structure from there.
                   ;; Same thing happens on quote-blocks.  So, if element at
                   ;; point is an object, its parent is a paragraph, and its
                   ;; grandparent is one of those types, we pass the
                   ;; grandparent, to follow the structure properly.
                   ;; Probably, other cases will emerge with use, which can
                   ;; just be added here.  Unfortunately, we cannot simply
                   ;; pass the granparent for all cases: e.g. if the parent
                   ;; is a headline, there is no grandparent.
                   (org-element-property :parent par-el-at-point))
                  (t
                   par-el-at-point))
               el-at-point))
         (type (org-element-type el))
         beg end)
    (when el
      (cond
       ((memq type org-element-all-objects)
        (setq beg (org-element-property :begin el))
        (setq end (- (org-element-property :end el)
                     (org-element-property :post-blank el))))
       ((memq type '(src-block center-block comment-block
                               example-block export-block quote-block
                               special-block verse-block
                               latex-environment
                               drawer property-drawer))
        (setq beg (org-element-property :begin el))
        (setq end (save-excursion
                    (goto-char (org-element-property :end el))
                    (forward-line
                     (- (org-element-property :post-blank el)))
                    (point))))
       (t
        (setq beg (org-element-property :begin el))
        (setq end (org-element-property :end el)))))
    (when (and beg end)
      (goto-char end)
      (set-mark (point))
      (goto-char beg))))

(defun my/er/mark-org-element-parent ()
  (interactive)
  (my/er/mark-org-element t))

(defun my/er/mark-org-element-inside ()
  (interactive)
  (let* ((el (org-element-context))
         (type (org-element-type el))
         beg end)
    ;; Here we handle just special cases, remaining ones will fall back to
    ;; 'my/er/mark-org-element'. So, there is no need for a residual
    ;; condition.
    (cond
     ((memq type '(bold italic strike-through underline
                        quote-block special-block verse-block
                        drawer property-drawer))
      (setq beg (org-element-property :contents-begin el))
      (setq end (org-element-property :contents-end el)))
     ((memq type '(code verbatim))
      (setq beg (1+ (org-element-property :begin el)))
      (setq end (- (org-element-property :end el)
                   (org-element-property :post-blank el)
                   1)))
     ((memq type '(src-block center-block comment-block
                             example-block export-block
                             latex-environment))
      (setq beg (save-excursion
                  (goto-char (org-element-property :begin el))
                  (forward-line)
                  (point)))
      (setq end (save-excursion
                  (goto-char (org-element-property :end el))
                  (forward-line
                   (1- (- (org-element-property :post-blank el))))
                  (point))))
     ((eq type 'headline)
      (save-excursion
        ;; Following the steps of 'org-element-headline-parser' to get the
        ;; start and end position of the title.
        (goto-char (org-element-property :begin el))
        (skip-chars-forward "*")
        (skip-chars-forward " \t")
        (and org-todo-regexp
             (let (case-fold-search) (looking-at (concat org-todo-regexp " ")))
             (goto-char (match-end 0))
             (skip-chars-forward " \t"))
        (when (looking-at "\\[#.\\][ \t]*")
          (goto-char (match-end 0)))
        (when (let (case-fold-search) (looking-at org-comment-string))
          (goto-char (match-end 0)))
        (setq beg (point))
        (when (re-search-forward
               "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
               (line-end-position)
               'move)
          (goto-char (match-beginning 0)))
        (setq end (point)))))
    (when (and beg end)
      (goto-char end)
      (set-mark (point))
      (goto-char beg))))

;; expand-region configuration for Org mode
(defun my/er/config-org-mode-expansions ()
  (when (< emacs-major-version 27)
    (require 'seq))
  (setq-local er/try-expand-list
              (append
               ;; Removing some expansions from the list
               (seq-remove
                (lambda (x)
                  (memq x '(;; The expansions based on the Org element API
                            ;; cover most of the default expansion, others
                            ;; don't seem that useful and may induce noise.
                            org-mark-subtree
                            er/mark-org-element
                            er/mark-org-element-parent
                            er/mark-org-code-block
                            er/mark-org-parent
                            er/mark-comment
                            er/mark-url
                            er/mark-email
                            mark-page

                            ;; The basic symbol and method-call expansion
                            ;; consider Org emphasis markers as part of the
                            ;; unit.  So I created a dedicated function for
                            ;; symbol, and left out symbol-with-prefix and
                            ;; method-call.
                            er/mark-symbol
                            er/mark-symbol-with-prefix
                            er/mark-method-call

                            ;; er/mark-paragraph actually confuses
                            ;; expand-region on plain lists, and paragraphs
                            ;; actually do work with the other expansions on
                            ;; the list (as an org-element).
                            er/mark-paragraph
                            ;; For the same reason, remove
                            ;; er/mark-text-paragraph
                            er/mark-text-paragraph

                            ;; remove er/mark-sentence, better to work with
                            ;; Org sentence commands, which are in
                            ;; my/er/mark-org-sentence
                            er/mark-sentence
                            ;; For the same reason remove
                            ;; er/mark-text-sentence
                            er/mark-text-sentence)))
                er/try-expand-list)
               '(my/er/mark-org-symbol
                 my/er/mark-org-element
                 my/er/mark-org-element-parent
                 my/er/mark-org-element-inside
                 my/er/mark-org-sentence))))
	(defun my/er/mark-org-sentence ()
	"Marks one sentence."
	(interactive)
	(let* ((el (org-element-context))
	(type (org-element-type el))
	(par-el (org-element-property :parent el)))
	;; FIXME: Consider if we should simply disable sentence marking in
	;; certain element types, e.g. src-blocks.
	(save-restriction
	;; Do not mark sentences beyond the limits of paragraphs.
	(cond
	((and (eq type 'paragraph)
	(<= (point-min)
	(org-element-property :contents-begin el))
	(>= (point)
	(org-element-property :contents-begin el)))
	(narrow-to-region (org-element-property :contents-begin el)
	(org-element-property :contents-end el)))
	((and (memq type org-element-all-objects)
	(eq (org-element-type par-el) 'paragraph)
	(<= (point-min)
	(org-element-property :contents-begin par-el))
	(>= (point)
	(org-element-property :contents-begin par-el)))
	(narrow-to-region (org-element-property :contents-begin par-el)
	(org-element-property :contents-end par-el))))
	(forward-char 1)
	(org-backward-sentence 1)
	(set-mark (point))
	(org-forward-sentence 1)
	(exchange-point-and-mark))))

	(defun my/er/mark-org-symbol ()
	"Mark the entire symbol around or in front of point."
	(interactive)
	(let ((symbol-regexp "\\s_\\\|\\sw")
	(emph-regexp
	(format "\\([%s]\\)" (mapconcat #'car org-emphasis-alist ""))))
	(when (or (looking-at symbol-regexp)
	(er/looking-back-on-line symbol-regexp))
	(skip-syntax-forward "_w")
	(re-search-backward emph-regexp (1- (point)) t)
	(set-mark (point))
	(skip-syntax-backward "_w")
	(re-search-forward (if (match-string 1)
	(format "\\(%s\\)" (match-string 1))
	emph-regexp)
	(1+ (point)) t)
	(if (match-string 1) (goto-char (match-end 1))))))

	(defun my/er/mark-org-element (&optional parent)
	(interactive)
	(let* ((el-at-point (org-element-context))
	(par-el-at-point (org-element-property :parent el-at-point))
	(el (if parent
	(cond
	((not par-el-at-point)
	(save-excursion
	(ignore-errors (org-up-element))
	;; Given el-at-point has no parent at this point,
	;; `org-up-element' will bring point to a heading
	;; (back-to-heading, if not on a heading, and
	;; up-heading, if on one), unless it is before the
	;; first one. Note: headlines have no parents.
	(when (org-with-limited-levels (org-at-heading-p))
	(org-element-at-point))))
	((and
	(memq (org-element-type el-at-point)
	org-element-all-objects)
	(eq (org-element-type par-el-at-point) 'paragraph)
	(memq (org-element-type
	(org-element-property :parent par-el-at-point))
	'(item quote-block center-block drawer)))
	;; Corner case, when an 'object' is also the first thing
	;; on a plain list item. In this case, if we simply get
	;; the parent, it will be paragraph, and further
	;; expansion will lose the list structure from there.
	;; Same thing happens on quote-blocks. So, if element at
	;; point is an object, its parent is a paragraph, and its
	;; grandparent is one of those types, we pass the
	;; grandparent, to follow the structure properly.
	;; Probably, other cases will emerge with use, which can
	;; just be added here. Unfortunately, we cannot simply
	;; pass the granparent for all cases: e.g. if the parent
	;; is a headline, there is no grandparent.
	(org-element-property :parent par-el-at-point))
	(t
	par-el-at-point))
	el-at-point))
	(type (org-element-type el))
	beg end)
	(when el
	(cond
	((memq type org-element-all-objects)
	(setq beg (org-element-property :begin el))
	(setq end (- (org-element-property :end el)
	(org-element-property :post-blank el))))
	((memq type '(src-block center-block comment-block
	example-block export-block quote-block
	special-block verse-block
	latex-environment
	drawer property-drawer))
	(setq beg (org-element-property :begin el))
	(setq end (save-excursion
	(goto-char (org-element-property :end el))
	(forward-line
	(- (org-element-property :post-blank el)))
	(point))))
	(t
	(setq beg (org-element-property :begin el))
	(setq end (org-element-property :end el)))))
	(when (and beg end)
	(goto-char end)
	(set-mark (point))
	(goto-char beg))))

	(defun my/er/mark-org-element-parent ()
	(interactive)
	(my/er/mark-org-element t))

	(defun my/er/mark-org-element-inside ()
	(interactive)
	(let* ((el (org-element-context))
	(type (org-element-type el))
	beg end)
	;; Here we handle just special cases, remaining ones will fall back to
	;; 'my/er/mark-org-element'. So, there is no need for a residual
	;; condition.
	(cond
	((memq type '(bold italic strike-through underline
	quote-block special-block verse-block
	drawer property-drawer))
	(setq beg (org-element-property :contents-begin el))
	(setq end (org-element-property :contents-end el)))
	((memq type '(code verbatim))
	(setq beg (1+ (org-element-property :begin el)))
	(setq end (- (org-element-property :end el)
	(org-element-property :post-blank el)
	1)))
	((memq type '(src-block center-block comment-block
	example-block export-block
	latex-environment))
	(setq beg (save-excursion
	(goto-char (org-element-property :begin el))
	(forward-line)
	(point)))
	(setq end (save-excursion
	(goto-char (org-element-property :end el))
	(forward-line
	(1- (- (org-element-property :post-blank el))))
	(point))))
	((eq type 'headline)
	(save-excursion
	;; Following the steps of 'org-element-headline-parser' to get the
	;; start and end position of the title.
	(goto-char (org-element-property :begin el))
	(skip-chars-forward "*")
	(skip-chars-forward " \t")
	(and org-todo-regexp
	(let (case-fold-search) (looking-at (concat org-todo-regexp " ")))
	(goto-char (match-end 0))
	(skip-chars-forward " \t"))
	(when (looking-at "\\[#.\\][ \t]*")
	(goto-char (match-end 0)))
	(when (let (case-fold-search) (looking-at org-comment-string))
	(goto-char (match-end 0)))
	(setq beg (point))
	(when (re-search-forward
	"[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
	(line-end-position)
	'move)
	(goto-char (match-beginning 0)))
	(setq end (point)))))
	(when (and beg end)
	(goto-char end)
	(set-mark (point))
	(goto-char beg))))

	;; expand-region configuration for Org mode
	(defun my/er/config-org-mode-expansions ()
	(when (< emacs-major-version 27)
	(require 'seq))
	(setq-local er/try-expand-list
	(append
	;; Removing some expansions from the list
	(seq-remove
	(lambda (x)
	(memq x '(;; The expansions based on the Org element API
	;; cover most of the default expansion, others
	;; don't seem that useful and may induce noise.
	org-mark-subtree
	er/mark-org-element
	er/mark-org-element-parent
	er/mark-org-code-block
	er/mark-org-parent
	er/mark-comment
	er/mark-url
	er/mark-email
	mark-page

	;; The basic symbol and method-call expansion
	;; consider Org emphasis markers as part of the
	;; unit. So I created a dedicated function for
	;; symbol, and left out symbol-with-prefix and
	;; method-call.
	er/mark-symbol
	er/mark-symbol-with-prefix
	er/mark-method-call

	;; er/mark-paragraph actually confuses
	;; expand-region on plain lists, and paragraphs
	;; actually do work with the other expansions on
	;; the list (as an org-element).
	er/mark-paragraph
	;; For the same reason, remove
	;; er/mark-text-paragraph
	er/mark-text-paragraph

	;; remove er/mark-sentence, better to work with
	;; Org sentence commands, which are in
	;; my/er/mark-org-sentence
	er/mark-sentence
	;; For the same reason remove
	;; er/mark-text-sentence
	er/mark-text-sentence)))
	er/try-expand-list)
	'(my/er/mark-org-symbol
	my/er/mark-org-element
	my/er/mark-org-element-parent
	my/er/mark-org-element-inside
	my/er/mark-org-sentence))))