1  ;;; er-basic-expansions.el --- Words, symbols, strings, et al  -*- lexical-binding: t; -*-
  2  
  3  ;; Copyright (C) 2011-2023  Free Software Foundation, Inc
  4  
  5  ;; Author: Magnar Sveen <magnars@gmail.com>
  6  ;; Keywords: marking region
  7  
  8  ;; This program is free software; you can redistribute it and/or modify
  9  ;; it under the terms of the GNU General Public License as published by
 10  ;; the Free Software Foundation, either version 3 of the License, or
 11  ;; (at your option) any later version.
 12  
 13  ;; This program is distributed in the hope that it will be useful,
 14  ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 15  ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 16  ;; GNU General Public License for more details.
 17  
 18  ;; You should have received a copy of the GNU General Public License
 19  ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 20  
 21  ;;; Commentary:
 22  
 23  ;; Expansions that are useful in any major mode.
 24  
 25  ;;; Code:
 26  
 27  (require 'expand-region-core)
 28  
 29  (defun er/mark-word ()
 30    "Mark the entire word around or in front of point."
 31    (interactive)
 32    (let ((word-regexp "\\sw"))
 33      (when (or (looking-at word-regexp)
 34                (er/looking-back-on-line word-regexp))
 35        (skip-syntax-forward "w")
 36        (set-mark (point))
 37        (skip-syntax-backward "w"))))
 38  
 39  (defun er/mark-symbol ()
 40    "Mark the entire symbol around or in front of point."
 41    (interactive)
 42    (let ((symbol-regexp "\\s_\\|\\sw"))
 43      (when (or (looking-at symbol-regexp)
 44                (er/looking-back-on-line symbol-regexp))
 45        (skip-syntax-forward "_w")
 46        (set-mark (point))
 47        (skip-syntax-backward "_w"))))
 48  
 49  (defun er/mark-symbol-with-prefix ()
 50    "Mark the entire symbol around or in front of point, including prefix."
 51    (interactive)
 52    (let ((symbol-regexp "\\s_\\|\\sw")
 53          (prefix-regexp "\\s'"))
 54      (when (or (looking-at prefix-regexp)
 55                (looking-at symbol-regexp)
 56                (er/looking-back-on-line symbol-regexp))
 57        (skip-syntax-forward "'")
 58        (skip-syntax-forward "_w")
 59        (set-mark (point))
 60        (skip-syntax-backward "_w")
 61        (skip-syntax-backward "'"))))
 62  
 63  ;; Mark method call
 64  
 65  (defun er/mark-next-accessor ()
 66    "Presumes that current symbol is already marked, skips over one
 67  period and marks next symbol."
 68    (interactive)
 69    (when (use-region-p)
 70      (when (< (point) (mark))
 71        (exchange-point-and-mark))
 72      ;; (let ((symbol-regexp "\\s_\\|\\sw"))
 73        (when (looking-at "\\.")
 74          (forward-char 1)
 75          (skip-syntax-forward "_w")
 76          (exchange-point-and-mark)))) ;; )
 77  
 78  (defun er/mark-method-call ()
 79    "Mark the current symbol (including dots) and then paren to closing paren."
 80    (interactive)
 81    (let ((symbol-regexp "\\(\\s_\\|\\sw\\|\\.\\)+"))
 82      (when (or (looking-at symbol-regexp)
 83                (er/looking-back-on-line symbol-regexp))
 84        (skip-syntax-backward "_w.")
 85        (set-mark (point))
 86        (when (looking-at symbol-regexp)
 87          (goto-char (match-end 0)))
 88        (if (looking-at "(")
 89            (forward-list))
 90        (exchange-point-and-mark))))
 91  
 92  ;; Comments
 93  
 94  (defun er--point-is-in-comment-p ()
 95    "t if point is in comment, otherwise nil"
 96    (or (nth 4 (syntax-ppss))
 97        (memq (get-text-property (point) 'face) '(font-lock-comment-face font-lock-comment-delimiter-face))))
 98  
 99  (defun er/mark-comment ()
100    "Mark the entire comment around point."
101    (interactive)
102    (when (er--point-is-in-comment-p)
103      (let ((p (point)))
104        (while (and (er--point-is-in-comment-p) (not (eobp)))
105          (forward-char 1))
106        (skip-chars-backward "\n\r")
107        (set-mark (point))
108        (goto-char p)
109        (while (er--point-is-in-comment-p)
110          (forward-char -1))
111        (forward-char 1))))
112  
113  ;; Quotes
114  
115  (defun er--current-quotes-char ()
116    "The char that is the current quote delimiter"
117    (nth 3 (syntax-ppss)))
118  
119  (defalias 'er--point-inside-string-p #'er--current-quotes-char)
120  
121  (defun er--move-point-forward-out-of-string ()
122    "Move point forward until it exits the current quoted string."
123    (er--move-point-backward-out-of-string)
124    (forward-sexp))
125  
126  (defun er--move-point-backward-out-of-string ()
127    "Move point backward until it exits the current quoted string."
128    (goto-char (nth 8 (syntax-ppss))))
129  
130  (defun er/mark-inside-quotes ()
131    "Mark the inside of the current string, not including the quotation marks."
132    (interactive)
133    (when (er--point-inside-string-p)
134      (er--move-point-backward-out-of-string)
135      (forward-char)
136      (set-mark (point))
137      (er--move-point-forward-out-of-string)
138      (backward-char)
139      (exchange-point-and-mark)))
140  
141  (defun er/mark-outside-quotes ()
142    "Mark the current string, including the quotation marks."
143    (interactive)
144    (if (er--point-inside-string-p)
145        (er--move-point-backward-out-of-string)
146      (when (and (not (use-region-p))
147                 (er/looking-back-on-line "\\s\""))
148        (backward-char)
149        (er--move-point-backward-out-of-string)))
150    (when (looking-at "\\s\"")
151      (set-mark (point))
152      (forward-char)
153      (er--move-point-forward-out-of-string)
154      (exchange-point-and-mark)))
155  
156  ;; Pairs - ie [] () {} etc
157  
158  (defun er--point-inside-pairs-p ()
159    "Is point inside any pairs?"
160    (> (car (syntax-ppss)) 0))
161  
162  (defun er/mark-inside-pairs ()
163    "Mark inside pairs (as defined by the mode), not including the pairs."
164    (interactive)
165    (when (er--point-inside-pairs-p)
166      (goto-char (nth 1 (syntax-ppss)))
167      (set-mark (save-excursion
168                  (forward-char 1)
169                  (skip-chars-forward er--space-str)
170                  (point)))
171      (forward-list)
172      (backward-char)
173      (skip-chars-backward er--space-str)
174      (exchange-point-and-mark)))
175  
176  (defun er--looking-at-pair ()
177    "Is point looking at an opening pair char?"
178    (looking-at "\\s("))
179  
180  (defun er--looking-at-marked-pair ()
181    "Is point looking at a pair that is entirely marked?"
182    (and (er--looking-at-pair)
183         (use-region-p)
184         (>= (mark)
185             (save-excursion
186               (forward-list)
187               (point)))))
188  
189  (defun er/mark-outside-pairs ()
190    "Mark pairs (as defined by the mode), including the pair chars."
191    (interactive)
192    (if (and (er/looking-back-on-line "\\s)+\\=")
193             (not (er--looking-at-pair)))
194        (ignore-errors (backward-list 1))
195      (skip-chars-forward er--space-str))
196    (when (and (er--point-inside-pairs-p)
197               (or (not (er--looking-at-pair))
198                   (er--looking-at-marked-pair)))
199      (goto-char (nth 1 (syntax-ppss))))
200    (when (er--looking-at-pair)
201      (set-mark (point))
202      (forward-list)
203      (exchange-point-and-mark)))
204  
205  (require 'thingatpt)
206  
207  (defun er/mark-url ()
208    (interactive)
209    (end-of-thing 'url)
210    (set-mark (point))
211    (beginning-of-thing 'url))
212  
213  (defun er/mark-email ()
214    (interactive)
215    (end-of-thing 'email)
216    (set-mark (point))
217    (beginning-of-thing 'email))
218  
219  (defun er/mark-defun ()
220    "Mark defun around or in front of point."
221    (interactive)
222    (end-of-defun)
223    (skip-chars-backward er--space-str)
224    (set-mark (point))
225    (beginning-of-defun)
226    (skip-chars-forward er--space-str))
227  
228  ;; Methods to try expanding to
229  (setq er/try-expand-list
230        (append '(er/mark-word
231                  er/mark-symbol
232                  er/mark-symbol-with-prefix
233                  er/mark-next-accessor
234                  er/mark-method-call
235                  er/mark-inside-quotes
236                  er/mark-outside-quotes
237                  er/mark-inside-pairs
238                  er/mark-outside-pairs
239                  er/mark-comment
240                  er/mark-url
241                  er/mark-email
242                  er/mark-defun)
243                er/try-expand-list))
244  
245  (when (and (>= emacs-major-version 29)
246             (treesit-available-p))
247    (defun er/mark-ts-node ()
248      "Mark tree sitter node around or after point."
249      (interactive)
250      (when (treesit-language-at (point))
251        (let* ((node (if (use-region-p)
252                         (treesit-node-on (region-beginning) (region-end))
253                       (treesit-node-at (point))))
254               (node-start (treesit-node-start node))
255               (node-end (treesit-node-end node)))
256          ;; when the node fits the region exactly, try its parent node instead
257          (when (and (= (region-beginning) node-start)
258                     (= (region-end) node-end))
259            (when-let ((node (treesit-node-parent node)))
260              (setq node-start (treesit-node-start node)
261                    node-end (treesit-node-end node))))
262          (goto-char node-start)
263          (set-mark node-end))))
264    (setq er/try-expand-list (append er/try-expand-list '(er/mark-ts-node))))
265  
266  (provide 'er-basic-expansions)
267  ;;; er-basic-expansions.el ends here