Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 402 lines (340 sloc) 13.274 kb
1be37698 » magnars
2012-02-27 Loosen dependency between core and mode expansions.
1 ;;; expand-region-core.el --- Increase selected region by semantic units.
2
3 ;; Copyright (C) 2011 Magnar Sveen
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 ;; The core functionality of expand-region.
24
25 ;; All changes to this file must be accompanied by feature tests.
26 ;; They are written in [Ecukes](http://ecukes.info), a Cucumber for Emacs.
27 ;;
28 ;; To fetch the test dependencies:
29 ;;
30 ;; $ cd /path/to/expand-region
31 ;; $ git submodule init
32 ;; $ git submodule update
33 ;;
34 ;; Run the tests with:
35 ;;
36 ;; $ ./util/ecukes/ecukes features
37
38 ;;; Code:
39
40 (defvar er/history '()
41 "A history of start and end points so we can contract after expanding.")
42
43 ;; history is always local to a single buffer
44 (make-variable-buffer-local 'er/history)
45
46 (defvar er--space-str " \t\n")
47 (defvar er--blank-list (append er--space-str nil))
48
49 ;; Default expansions
50
51 (defun er/mark-word ()
52 "Mark the entire word around or in front of point."
53 (interactive)
54 (let ((word-regexp "\\sw"))
55 (when (or (looking-at word-regexp)
56 (looking-back word-regexp))
57 (skip-syntax-forward "w")
58 (set-mark (point))
59 (while (looking-back word-regexp)
60 (backward-char)))))
61
62 (defun er/mark-symbol ()
63 "Mark the entire symbol around or in front of point."
64 (interactive)
65 (let ((symbol-regexp "\\s_\\|\\sw"))
66 (when (or (looking-at symbol-regexp)
67 (looking-back symbol-regexp))
68 (skip-syntax-forward "_w")
69 (set-mark (point))
70 (while (looking-back symbol-regexp)
71 (backward-char)))))
72
73 (defun er/mark-symbol-with-prefix ()
74 "Mark the entire symbol around or in front of point, including prefix."
75 (interactive)
76 (let ((symbol-regexp "\\s_\\|\\sw")
77 (prefix-regexp "\\s'"))
78 (when (or (looking-at prefix-regexp)
79 (looking-at symbol-regexp)
80 (looking-back symbol-regexp))
81 (skip-syntax-forward "'")
82 (skip-syntax-forward "_w")
83 (set-mark (point))
84 (while (or (looking-back symbol-regexp)
85 (looking-back prefix-regexp))
86 (backward-char)))))
87
88 ;; Mark method call
89
90 (defun er/mark-next-accessor ()
91 "Presumes that current symbol is already marked, skips over one
92 period and marks next symbol."
93 (interactive)
94 (when (use-region-p)
95 (when (< (point) (mark))
96 (exchange-point-and-mark))
97 (let ((symbol-regexp "\\s_\\|\\sw"))
98 (when (looking-at "\\.")
99 (forward-char 1)
100 (skip-syntax-forward "_w")
101 (exchange-point-and-mark)))))
102
103 (defun er/mark-method-call ()
104 "Mark the current symbol (including dots) and then paren to closing paren."
105 (interactive)
106 (let ((symbol-regexp "\\s_\\|\\sw\\|\\."))
107 (when (or (looking-at symbol-regexp)
108 (looking-back symbol-regexp))
109 (skip-syntax-backward "_w.")
110 (set-mark (point))
111 (while (looking-at symbol-regexp)
112 (forward-char))
113 (if (looking-at "(")
114 (forward-list))
115 (exchange-point-and-mark))))
116
117 ;; Comments
118
119 (defun er--point-is-in-comment-p ()
120 "t if point is in comment, otherwise nil"
121 (nth 4 (syntax-ppss)))
122
123 (defun er--move-point-forward-out-of-comment ()
124 "Move point forward until it exits the current quoted comment."
125 (while (er--point-is-in-comment-p) (forward-char)))
126
127 (defun er--move-point-backward-out-of-comment ()
128 "Move point backward until it exits the current quoted comment."
129 (while (er--point-is-in-comment-p) (backward-char)))
130
131 (defun er/mark-comment ()
132 "Mark the current comment."
133 (interactive)
134 (when (or (er--point-is-in-comment-p)
135 (looking-at "\\s<"))
136 (er--move-point-backward-out-of-comment)
137 (set-mark (point))
138 (forward-char)
139 (er--move-point-forward-out-of-comment)
140 (backward-char)
141 (exchange-point-and-mark)))
142
143 (defun er/mark-comment-block ()
144 "Mark the current block of comments."
145 (interactive)
146 (when (or (er--point-is-in-comment-p)
147 (looking-at "\\s<"))
148 (er--move-point-backward-out-of-comment)
149 (while (save-excursion
150 (skip-syntax-backward " ")
151 (backward-char)
152 (er--point-is-in-comment-p))
153 (skip-syntax-backward " ")
154 (backward-char)
155 (er--move-point-backward-out-of-comment))
156 (set-mark (point))
157 (forward-char)
158 (er--move-point-forward-out-of-comment)
159 (while (looking-at "\\s *\\s<")
160 (back-to-indentation)
161 (forward-char)
162 (er--move-point-forward-out-of-comment))
163 (exchange-point-and-mark)))
164
165 ;; Quotes
166
167 (defun er--current-quotes-char ()
168 "The char that is the current quote delimiter"
169 (nth 3 (syntax-ppss)))
170
171 (defalias 'er--point-inside-string-p 'er--current-quotes-char)
172
173 (defun er--move-point-forward-out-of-string ()
174 "Move point forward until it exits the current quoted string."
175 (while (er--point-inside-string-p) (forward-char)))
176
177 (defun er--move-point-backward-out-of-string ()
178 "Move point backward until it exits the current quoted string."
179 (while (er--point-inside-string-p) (backward-char)))
180
181 (defun er/mark-inside-quotes ()
182 "Mark the inside of the current string, not including the quotation marks."
183 (interactive)
184 (when (er--point-inside-string-p)
185 (er--move-point-backward-out-of-string)
186 (forward-char)
187 (set-mark (point))
188 (er--move-point-forward-out-of-string)
189 (backward-char)
190 (exchange-point-and-mark)))
191
192 (defun er/mark-outside-quotes ()
193 "Mark the current string, including the quotation marks."
194 (interactive)
195 (if (er--point-inside-string-p)
196 (er--move-point-backward-out-of-string)
197 (when (and (not (use-region-p))
198 (looking-back "\\s\""))
199 (backward-char)
200 (er--move-point-backward-out-of-string)))
201 (when (looking-at "\\s\"")
202 (set-mark (point))
203 (forward-char)
204 (er--move-point-forward-out-of-string)
205 (exchange-point-and-mark)))
206
207 ;; Pairs - ie [] () {} etc
208
209 (defun er--point-inside-pairs-p ()
210 "Is point inside any pairs?"
211 (> (car (syntax-ppss)) 0))
212
213 (defun er/mark-inside-pairs ()
214 "Mark inside pairs (as defined by the mode), not including the pairs."
215 (interactive)
216 (when (er--point-inside-pairs-p)
217 (goto-char (nth 1 (syntax-ppss)))
218 (set-mark (save-excursion
219 (forward-char 1)
220 (skip-chars-forward er--space-str)
221 (point)))
222 (forward-list)
223 (backward-char)
224 (skip-chars-backward er--space-str)
225 (exchange-point-and-mark)))
226
227 (defun er--looking-at-pair ()
228 "Is point looking at an opening pair char?"
229 (looking-at "\\s("))
230
231 (defun er--looking-at-marked-pair ()
232 "Is point looking at a pair that is entirely marked?"
233 (and (er--looking-at-pair)
234 (use-region-p)
235 (>= (mark)
236 (save-excursion
237 (forward-list)
238 (point)))))
239
240 (defun er/mark-outside-pairs ()
241 "Mark pairs (as defined by the mode), including the pair chars."
242 (interactive)
4ef90c67 » magnars
2012-02-27 Feature tests for html-mode + minor improvements
243 (if (looking-back "\\s)+\\=")
1be37698 » magnars
2012-02-27 Loosen dependency between core and mode expansions.
244 (ignore-errors (backward-list 1))
4ef90c67 » magnars
2012-02-27 Feature tests for html-mode + minor improvements
245 (skip-chars-forward er--space-str))
1be37698 » magnars
2012-02-27 Loosen dependency between core and mode expansions.
246 (when (and (er--point-inside-pairs-p)
247 (or (not (er--looking-at-pair))
248 (er--looking-at-marked-pair)))
249 (goto-char (nth 1 (syntax-ppss))))
250 (when (er--looking-at-pair)
251 (set-mark (point))
252 (forward-list)
253 (exchange-point-and-mark)))
254
255 ;; Methods to try expanding to
256
257 (setq er/try-expand-list '(er/mark-word
258 er/mark-symbol
259 er/mark-symbol-with-prefix
260 er/mark-next-accessor
261 er/mark-method-call
262 er/mark-comment
263 er/mark-comment-block
264 er/mark-inside-quotes
265 er/mark-outside-quotes
266 er/mark-inside-pairs
267 er/mark-outside-pairs))
268
269 ;; The magic expand-region method
270
271 ;;;###autoload
272 (defun er/expand-region (arg)
273 "Increase selected region by semantic units.
274 Basically it runs all the mark-functions in `er/try-expand-list'
275 and chooses the one that increases the size of the region while
276 moving point or mark as little as possible.
277
278 With prefix argument expands the region that many times.
279 If prefix argument is negative calls `er/contract-region'.
280 If prefix argument is 0 it resets point and mark to their state
281 before calling `er/expand-region' for the first time."
282 (interactive "p")
283 (if (< arg 1)
284 ;; `er/contract-region' will take care of negative and 0 arguments
285 (er/contract-region (- arg))
286 ;; We handle everything else
287
288 (when (and (er--first-invocation)
289 (not (use-region-p)))
290 (push-mark nil t) ;; one for keeping starting position
291 (push-mark nil t)) ;; one for replace by set-mark in expansions
292
293 (when (not (eq t transient-mark-mode))
294 (setq transient-mark-mode (cons 'only transient-mark-mode)))
295
296 (while (>= arg 1)
297 (setq arg (- arg 1))
298 (let* ((p1 (point))
299 (p2 (if (use-region-p) (mark) (point)))
300 (start (min p1 p2))
301 (end (max p1 p2))
302 (try-list er/try-expand-list)
303 (best-start 1)
69d73ce7 » magnars
2012-03-21 Add support for set-mark-default-inactive
304 (best-end (buffer-end 1))
305 (set-mark-default-inactive nil))
1be37698 » magnars
2012-02-27 Loosen dependency between core and mode expansions.
306
307 ;; add hook to clear history on buffer changes
308 (unless er/history
309 (add-hook 'after-change-functions 'er/clear-history t t))
310
311 ;; remember the start and end points so we can contract later
312 ;; unless we're already at maximum size
313 (unless (and (= start best-start)
314 (= end best-end))
315 (push (cons start end) er/history))
316
317 (when (and (er--point-is-surrounded-by-white-space)
318 (= start end))
319 (skip-chars-forward er--space-str)
320 (setq start (point)))
321
322 (while try-list
323 (save-excursion
324 (ignore-errors
325 (funcall (car try-list))
326 (when (and (region-active-p)
327 (<= (point) start)
328 (>= (mark) end)
329 (> (- (mark) (point)) (- end start))
330 (or (> (point) best-start)
331 (and (= (point) best-start)
332 (< (mark) best-end))))
333 (setq best-start (point))
334 (setq best-end (mark))
335 (unless (minibufferp)
336 (message "%S" (car try-list))))))
337 (setq try-list (cdr try-list)))
338
339 (goto-char best-start)
340 (set-mark best-end)
341
342 (when (and (= best-start 0)
343 (= best-end (buffer-end 1))) ;; We didn't find anything new, so exit early
344 (setq arg 0))))))
345
346 (defun er/contract-region (arg)
347 "Contract the selected region to its previous size.
348 With prefix argument contracts that many times.
349 If prefix argument is negative calls `er/expand-region'.
350 If prefix argument is 0 it resets point and mark to their state
351 before calling `er/expand-region' for the first time."
352 (interactive "p")
353 (if (< arg 0)
354 (er/expand-region (- arg))
355 (when er/history
356 ;; Be sure to reset them all if called with 0
357 (when (= arg 0)
358 (setq arg (length er/history)))
359
360 (when (not transient-mark-mode)
361 (setq transient-mark-mode (cons 'only transient-mark-mode)))
362
363 ;; Advance through the list the desired distance
364 (while (and (cdr er/history)
365 (> arg 1))
366 (setq arg (- arg 1))
367 (setq er/history (cdr er/history)))
368 ;; Reset point and mark
369 (let* ((last (pop er/history))
370 (start (car last))
371 (end (cdr last)))
372 (goto-char start)
373 (set-mark end)
374 (when (eq start end)
375 (deactivate-mark)
376 (er/clear-history))))))
377
fe04a867 » magnars
2012-04-12 C-g cancels and moves point to original location
378 (defadvice keyboard-quit (before collapse-region activate)
379 (when (memq last-command '(er/expand-region er/contract-region))
380 (er/contract-region 0)))
381
61be6ea4 » magnars
2012-04-14 C-g moves back to start of expansions also in cua-mode.
382 (defadvice cua-cancel (before collapse-region activate)
383 (when (memq last-command '(er/expand-region er/contract-region))
384 (er/contract-region 0)))
385
1be37698 » magnars
2012-02-27 Loosen dependency between core and mode expansions.
386 (defun er/clear-history (&rest args)
387 "Clear the history."
388 (setq er/history '())
389 (remove-hook 'after-change-functions 'er/clear-history t))
390
391 (defsubst er--first-invocation ()
392 "t if this is the first invocation of er/expand-region or er/contract-region"
393 (not (memq last-command '(er/expand-region er/contract-region))))
394
395 (defun er--point-is-surrounded-by-white-space ()
396 (and (or (memq (char-before) er--blank-list)
397 (eq (point) (point-min)))
398 (memq (char-after) er--blank-list)))
399
400 (provide 'expand-region-core)
401
402 ;;; expand-region-core.el ends here
Something went wrong with that request. Please try again.