|
4
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; LCD-ENTRY: id-select.el|InfoDock Associates|elisp@infodock.com|Syntactical region selecting|12/02/96|1.4.3|
|
|
|
4 ;;
|
|
|
5 ;; FILE: id-select.el
|
|
|
6 ;; SUMMARY: Select larger and larger syntax-driven regions in a buffer.
|
|
|
7 ;; USAGE: XEmacs and Emacs Lisp Library
|
|
|
8 ;; KEYWORDS: matching, mouse
|
|
|
9 ;;
|
|
|
10 ;; AUTHOR: Bob Weiner
|
|
|
11 ;;
|
|
|
12 ;; ORG: InfoDock Associates. We sell corporate support and development
|
|
|
13 ;; contracts for InfoDock, Emacs and XEmacs.
|
|
|
14 ;; E-mail: <info@infodock.com> Web: http://www.infodock.com
|
|
|
15 ;; Tel: +1 408-243-3300
|
|
|
16 ;;
|
|
|
17 ;; ORIG-DATE: 19-Oct-96 at 02:25:27
|
|
|
18 ;; LAST-MOD: 2-Dec-96 at 19:45:28 by Bob Weiner
|
|
|
19 ;;
|
|
|
20 ;; Copyright (C) 1996 InfoDock Associates
|
|
|
21 ;;
|
|
|
22 ;; This file is part of InfoDock.
|
|
|
23 ;; It is available for use and distribution under the terms of the GNU Public
|
|
|
24 ;; License.
|
|
|
25 ;;
|
|
|
26 ;; DESCRIPTION:
|
|
|
27 ;;
|
|
|
28 ;; This is a radically cool, drop in mouse and keyboard-based library for
|
|
|
29 ;; selecting successively bigger syntactical regions within a buffer.
|
|
|
30 ;; Simply load this library and you are ready to try it out by
|
|
|
31 ;; double-clicking on various kinds of characters in different buffer major
|
|
|
32 ;; modes. You'll quickly get the hang of it. (It also provides a command
|
|
|
33 ;; to jump between beginning and end tags within HTML and SGML buffers.)
|
|
|
34 ;;
|
|
|
35 ;; A great deal of smarts are built-in so that it does the right thing
|
|
|
36 ;; almost all of the time; many other attempts at similar behavior such as
|
|
|
37 ;; thing.el fail to deal with many file format complexities.
|
|
|
38 ;;
|
|
|
39 ;; Double clicks of the Selection Key (left mouse key) at the same point
|
|
|
40 ;; will select bigger and bigger regions with each successive use. The
|
|
|
41 ;; first double click selects a region based upon the character at the
|
|
|
42 ;; point of the click. For example, with the point over an opening or
|
|
|
43 ;; closing grouping character, such as { or }, the whole grouping is
|
|
|
44 ;; selected, e.g. a C function. When on an _ or - within a programming
|
|
|
45 ;; language variable name, the whole name is selected. The type of
|
|
|
46 ;; selection is displayed in the minibuffer as feedback. When using a
|
|
|
47 ;; language based mainly on indenting, like Bourne shell, a double click on
|
|
|
48 ;; the first alpha character of a line, such as an if statement, selects
|
|
|
49 ;; the whole statement.
|
|
|
50 ;;
|
|
|
51 ;; ---------------
|
|
|
52 ;;
|
|
|
53 ;; This whole package is driven by a single function, available in mouse
|
|
|
54 ;; and keyboard forms, that first marks a region based on the syntax
|
|
|
55 ;; category of the character following point. Successive invocations mark
|
|
|
56 ;; larger and larger regions until the whole buffer is marked. See the
|
|
|
57 ;; documentation for the function, id-select-syntactical-region, for the
|
|
|
58 ;; kinds of syntax categories handled.
|
|
|
59 ;;
|
|
|
60 ;; Loading this package automatically installs its functionalty on
|
|
|
61 ;; double-clicks (or higher) of the left mouse key. (See the documentation
|
|
|
62 ;; for the variable, mouse-track-click-hook, for how this is done.) A
|
|
|
63 ;; single click of the left button will remove the region and reset point.
|
|
|
64 ;;
|
|
|
65 ;; The function, id-select-thing, may be bound to a key, {C-c s}, seems to
|
|
|
66 ;; be a reasonable choice, to provide the same syntax-driven region
|
|
|
67 ;; selection functionality. Use {C-g} to unmark the region when done.
|
|
|
68 ;; Use, id-select-thing-with-mouse, if you want to bind this to a mouse key
|
|
|
69 ;; and thereby use single clicks instead of double clicks.
|
|
|
70 ;;
|
|
|
71 ;; Three other commands are also provided:
|
|
|
72 ;; id-select-and-copy-thing - mark and copy the syntactical unit to the
|
|
|
73 ;; kill ring
|
|
|
74 ;; id-select-and-kill-thing - kill the syntactical unit at point
|
|
|
75 ;; id-select-goto-matching-tag - In HTML and SGML modes (actually any
|
|
|
76 ;; listed in the variable, `id-select-markup-modes'), moves point to the
|
|
|
77 ;; start of the tag paired with the closest tag that point is within or
|
|
|
78 ;; which it precedes, so you can quickly jump back and forth between
|
|
|
79 ;; open and close tags.
|
|
|
80 ;;
|
|
|
81 ;; ---------------
|
|
|
82 ;; SETUP:
|
|
|
83 ;;
|
|
|
84 ;; To autoload this package under XEmacs or InfoDock via mouse usage, add
|
|
|
85 ;; the following line to one of your initialization files. (Don't do this
|
|
|
86 ;; for GNU Emacs.)
|
|
|
87 ;;
|
|
|
88 ;; (add-hook 'mouse-track-click-hook 'id-select-double-click-hook)
|
|
|
89 ;;
|
|
|
90 ;; For any version of Emacs you should add the following autoload entries
|
|
|
91 ;; at your site:
|
|
|
92 ;;
|
|
|
93 ;; (autoload 'id-select-and-kill-thing
|
|
|
94 ;; "id-select" "Kill syntactical region selection" t)
|
|
|
95 ;; (autoload 'id-select-and-copy-thing
|
|
|
96 ;; "id-select" "Select and copy syntactical region" t)
|
|
|
97 ;; (autoload 'id-select-double-click-hook
|
|
|
98 ;; "id-select" "Double mouse click syntactical region selection" nil)
|
|
|
99 ;; (autoload 'id-select-thing
|
|
|
100 ;; "id-select" "Keyboard-driven syntactical region selection" t)
|
|
|
101 ;; (autoload 'id-select-thing-with-mouse
|
|
|
102 ;; "id-select" "Single mouse click syntactical region selection" t)
|
|
|
103 ;;
|
|
|
104 ;; If you want to be able to select C++ and Java methods and classes by
|
|
|
105 ;; double-clicking on the first character of a definition or on its opening
|
|
|
106 ;; or closing brace, you may need the following setting (all
|
|
|
107 ;; because Sun programmers can't put their opening braces in the first
|
|
|
108 ;; column):
|
|
|
109 ;;
|
|
|
110 ;; (add-hook 'java-mode-hook
|
|
|
111 ;; (function
|
|
|
112 ;; (lambda ()
|
|
|
113 ;; (setq defun-prompt-regexp
|
|
|
114 ;; "^[ \t]*\\(\\(\\(public\\|protected\\|private\\|const\\|abstract\\|synchronized\\|final\\|static\\|threadsafe\\|transient\\|native\\|volatile\\)\\s-+\\)*\\(\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*[][_$.a-zA-Z0-9]+\\|[[a-zA-Z]\\)\\s-*\\)\\s-+\\)\\)?\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*\\s-+\\)\\s-*\\)?\\([_a-zA-Z][^][ \t:;.,{}()=]*\\|\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)\\)\\s-*\\(([^);{}]*)\\)?\\([] \t]*\\)\\(\\s-*\\<throws\\>\\s-*\\(\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)[, \t\n\r\f]*\\)+\\)?\\s-*"))))
|
|
|
115 ;;
|
|
|
116 ;; (add-hook 'c++-mode-hook
|
|
|
117 ;; (function
|
|
|
118 ;; (lambda ()
|
|
|
119 ;; (setq defun-prompt-regexp
|
|
|
120 ;; "^[ \t]*\\(template[ \t\n\r]*<[^>;.{}]+>[ \t\n\r]*\\)?\\(\\(\\(auto\\|const\\|explicit\\|extern[ \t\n\r]+\"[^\"]+\"\\|extern\\|friend\\|inline\\|mutable\\|overload\\|register\\|static\\|typedef\\|virtual\\)[ \t\n\r]+\\)*\\(\\([[<a-zA-Z][]_a-zA-Z0-9]*\\(::[]_a-zA-Z0-9]+\\)?[ \t\n\r]*<[_<>a-zA-Z0-9 ,]+>[ \t\n\r]*[*&]*\\|[[<a-zA-Z][]_<>a-zA-Z0-9]*\\(::[[<a-zA-Z][]_<>a-zA-Z0-9]+\\)?[ \t\n\r]*[*&]*\\)[*& \t\n\r]+\\)\\)?\\(\\(::\\|[[<a-zA-Z][]_a-zA-Z0-9]*[ \t\n\r]*<[^>;{}]+>[ \t\n\r]*[*&]*::\\|[[<a-zA-Z][]_~<>a-zA-Z0-9]*[ \t\n\r]*[*&]*::\\)[ \t\n\r]*\\)?\\(operator[ \t\n\r]*[^ \t\n\r:;.,?~{}]+\\([ \t\n\r]*\\[\\]\\)?\\|[_~<a-zA-Z][^][ \t:;.,~{}()]*\\|[*&]?\\([_~<a-zA-Z][_a-zA-Z0-9]*[ \t\n\r]*<[^>;{}]+[ \t\n\r>]*>\\|[_~<a-zA-Z][_~<>a-zA-Z0-9]*\\)\\)[ \t\n\r]*\\(([^{;]*)\\(\\([ \t\n\r]+const\\|[ \t\n\r]+mutable\\)?\\([ \t\n\r]*[=:][^;{]+\\)?\\)?\\)\\s-*"))))
|
|
|
121 ;;
|
|
|
122 ;; If you want tags, comments, sentences and text blocks to be selectable
|
|
|
123 ;; in HTML mode, you need to add the following to your personal
|
|
|
124 ;; initializations (You would do something similar for SGML mode.):
|
|
|
125 ;;
|
|
|
126 ;; ;; Make tag begin and end delimiters act like grouping characters,
|
|
|
127 ;; ;; for easy syntactical selection of tags.
|
|
|
128 ;; (add-hook 'html-mode-hook
|
|
|
129 ;; (function
|
|
|
130 ;; (lambda ()
|
|
|
131 ;; (modify-syntax-entry ?< "(>" html-mode-syntax-table)
|
|
|
132 ;; (modify-syntax-entry ?> ")<" html-mode-syntax-table)
|
|
|
133 ;; (modify-syntax-entry ?\" "\"" html-mode-syntax-table)
|
|
|
134 ;; (modify-syntax-entry ?= "." html-mode-syntax-table)
|
|
|
135 ;; (make-local-variable 'comment-start)
|
|
|
136 ;; (make-local-variable 'comment-end)
|
|
|
137 ;; (setq comment-start "<!--" comment-end "-->")
|
|
|
138 ;; (make-local-variable 'sentence-end)
|
|
|
139 ;; (setq sentence-end "\\([^ \t\n\r>]<\\|>\\(<[^>]*>\\)*\\|[.?!][]\"')}]*\\($\\| $\\|\t\\| \\)\\)[ \t\n]*")
|
|
|
140 ;;
|
|
|
141 ;; (define-key html-mode-map "\C-c." 'id-select-goto-matching-tag)
|
|
|
142 ;; )))
|
|
|
143 ;;
|
|
|
144 ;; DESCRIP-END.
|
|
|
145
|
|
|
146 ;;; ************************************************************************
|
|
|
147 ;;; Public variables
|
|
|
148 ;;; ************************************************************************
|
|
|
149
|
|
|
150 (defvar id-select-brace-modes
|
|
|
151 '(c++-mode c-mode java-mode objc-mode perl-mode tcl-mode)
|
|
|
152 "*List of language major modes which define things with brace delimiters.")
|
|
|
153
|
|
|
154 (defvar id-select-markup-modes
|
|
|
155 '(html-mode sgml-mode)
|
|
|
156 "*List of markup language modes that use SGML-style <tag> </tag> pairs.")
|
|
|
157
|
|
|
158 (defvar id-select-text-modes
|
|
|
159 '(fundamental-mode kotl-mode indented-text-mode Info-mode outline-mode text-mode)
|
|
|
160 "*List of textual modes where paragraphs may be outdented or indented.")
|
|
|
161
|
|
|
162 (defvar id-select-indent-modes
|
|
|
163 (append '(asm-mode csh-mode eiffel-mode ksh-mode python-mode pascal-mode
|
|
|
164 sather-mode)
|
|
|
165 id-select-text-modes)
|
|
|
166 "*List of language major modes which use mostly indentation to define syntactic structure.")
|
|
|
167
|
|
|
168 (defvar id-select-indent-non-end-regexp-alist
|
|
|
169 '((csh-mode "\\(\\|then\\|elsif\\|else\\)[ \t]*$")
|
|
|
170 (eiffel-mode "\\(\\|then\\|else if\\|else\\)[ \t]*$")
|
|
|
171 (ksh-mode "\\(\\|then\\|elif\\|else\\)[ \t]*$")
|
|
|
172 (pascal-mode "\\(\\|then\\|else\\)[ \t]*$")
|
|
|
173 (python-mode "[ \t]*$")
|
|
|
174 (sather-mode "\\(\\|then\\|else if\\|else\\)[ \t]*$")
|
|
|
175 ;;
|
|
|
176 (fundamental-mode "[^ \t\n]")
|
|
|
177 (kotl-mode "[^ \t\n]")
|
|
|
178 (indented-text-mode "[^ \t\n]")
|
|
|
179 (Info-mode "[^ \t\n]")
|
|
|
180 (outline-mode "[^\\*]")
|
|
|
181 (text-mode "[^ \t\n]")
|
|
|
182 )
|
|
|
183 "List of (major-mode . non-terminator-line-regexp) elements used to avoid early dropoff when marking indented code.")
|
|
|
184
|
|
|
185 (defvar id-select-indent-end-regexp-alist
|
|
|
186 '((csh-mode "end\\|while")
|
|
|
187 (eiffel-mode "end")
|
|
|
188 (ksh-mode "\\(fi\\|esac\\|until\\|done\\)[ \t\n]")
|
|
|
189 (pascal-mode "end")
|
|
|
190 (sather-mode "end")
|
|
|
191 ;;
|
|
|
192 (fundamental-mode "[ \t]*$")
|
|
|
193 (indented-text-mode "[ \t]*$")
|
|
|
194 (Info-mode "[ \t]*$")
|
|
|
195 (text-mode "[ \t]*$")
|
|
|
196 )
|
|
|
197 "List of (major-mode . terminator-line-regexp) elements used to include a final line when marking indented code.")
|
|
|
198
|
|
|
199 (defvar id-select-char-p t
|
|
|
200 "*If t, return single character boundaries when all else fails.")
|
|
|
201
|
|
|
202 (defvar id-select-display-type t
|
|
|
203 "*If t, display the thing selected with each mouse click.")
|
|
|
204
|
|
|
205 (defvar id-select-whitespace t
|
|
|
206 "*If t, groups of whitespace are considered as things.")
|
|
|
207
|
|
|
208 (if (string-match "XEmacs" emacs-version)
|
|
|
209 (add-hook 'mouse-track-click-hook 'id-select-double-click-hook)
|
|
|
210 (if (string-match "^19\\." emacs-version)
|
|
|
211 (progn (transient-mark-mode 1)
|
|
|
212 (global-set-key [mouse-1] 'mouse-set-point)
|
|
|
213 (global-set-key [double-mouse-1] 'id-select-thing-with-mouse)
|
|
|
214 (global-set-key [triple-mouse-1] 'id-select-thing-with-mouse))))
|
|
|
215
|
|
|
216 ;;; ************************************************************************
|
|
|
217 ;;; Public functions
|
|
|
218 ;;; ************************************************************************
|
|
|
219
|
|
|
220 ;;
|
|
|
221 ;; Commands
|
|
|
222 ;;
|
|
|
223
|
|
|
224 ;;;###autoload
|
|
|
225 (defun id-select-thing ()
|
|
|
226 "Mark the region selected by the syntax of the thing at point.
|
|
|
227 If invoked repeatedly, selects bigger and bigger things.
|
|
|
228 If `id-select-display-type' is non-nil, the type of selection is displayed in
|
|
|
229 the minibuffer."
|
|
|
230 (interactive
|
|
|
231 (cond ((and (fboundp 'region-active-p) (region-active-p))
|
|
|
232 nil)
|
|
|
233 ((and (boundp 'transient-mark-mode) transient-mark-mode mark-active)
|
|
|
234 nil)
|
|
|
235 (t
|
|
|
236 ;; Reset selection based on the syntax of character at point.
|
|
|
237 (id-select-reset)
|
|
|
238 nil)))
|
|
|
239 (let ((region (id-select-boundaries (point))))
|
|
|
240 (if region
|
|
|
241 (progn (goto-char (car region))
|
|
|
242 (set-mark (cdr region))
|
|
|
243 (if (fboundp 'activate-region) (activate-region))
|
|
|
244 (if (and (boundp 'transient-mark-mode)
|
|
|
245 transient-mark-mode)
|
|
|
246 (setq mark-active t))
|
|
|
247 (and (interactive-p) id-select-display-type
|
|
|
248 (message "%s" id-select-previous))
|
|
|
249 (run-hooks 'id-select-thing-hook)
|
|
|
250 t))))
|
|
|
251
|
|
|
252 ;;;###autoload
|
|
|
253 (defun id-select-thing-with-mouse (event)
|
|
|
254 "Select a region based on the syntax of the character from a mouse click.
|
|
|
255 If the click occurs at the same point as the last click, select
|
|
|
256 the next larger syntactic structure. If `id-select-display-type' is non-nil,
|
|
|
257 the type of selection is displayed in the minibuffer."
|
|
|
258 (interactive "@e")
|
|
|
259 (cond ((and (eq id-select-prior-point (point))
|
|
|
260 (eq id-select-prior-buffer (current-buffer)))
|
|
|
261 ;; Prior click was at the same point as before, so enlarge
|
|
|
262 ;; selection to the next bigger item.
|
|
|
263 (if (and (id-select-bigger-thing) id-select-display-type)
|
|
|
264 (progn
|
|
|
265 ;; Conditionally, save selected region for pasting.
|
|
|
266 (cond
|
|
|
267 ;; XEmacs
|
|
|
268 ((fboundp 'x-store-cutbuffer)
|
|
|
269 (x-store-cutbuffer (buffer-substring (point) (mark))))
|
|
|
270 ;; Emacs 19
|
|
|
271 ((and (boundp 'interprogram-cut-function)
|
|
|
272 interprogram-cut-function)
|
|
|
273 (x-set-selection 'PRIMARY (buffer-substring (point) (mark)))))
|
|
|
274 (message "%s" id-select-previous)))
|
|
|
275 t)
|
|
|
276 (t (setq this-command 'mouse-start-selection)
|
|
|
277 (id-select-reset)
|
|
|
278 (id-select-thing-with-mouse event))))
|
|
|
279
|
|
|
280 ;;;###autoload
|
|
|
281 (defun id-select-goto-matching-tag ()
|
|
|
282 "If in a major mode listed in `id-select-markup-modes,' moves point to the start of the tag paired with the closest tag that point is within or precedes.
|
|
|
283 Returns t if point is moved, else nil.
|
|
|
284 Signals an error if no tag is found following point or if the closing tag
|
|
|
285 does not have a `>' terminator character."
|
|
|
286 (interactive)
|
|
|
287 (if (not (memq major-mode id-select-markup-modes))
|
|
|
288 nil
|
|
|
289 (let ((result)
|
|
|
290 ;; Assume case of tag names is irrelevant.
|
|
|
291 (case-fold-search t)
|
|
|
292 (opoint (point))
|
|
|
293 (tag)
|
|
|
294 end-point
|
|
|
295 start-regexp
|
|
|
296 end-regexp)
|
|
|
297
|
|
|
298 ;; Leave point at the start of the tag that point is within or that
|
|
|
299 ;; follows point.
|
|
|
300 (cond
|
|
|
301 ;; Point is at the start of a tag.
|
|
|
302 ((looking-at "<[^<> \t\n\r]"))
|
|
|
303 ;; Point was within a tag.
|
|
|
304 ((and (re-search-backward "[<>]" nil t)
|
|
|
305 (looking-at "<[^<> \t\n\r]")))
|
|
|
306 ;; Move to following tag.
|
|
|
307 ((and (re-search-forward "<" nil t)
|
|
|
308 (progn (backward-char 1)
|
|
|
309 (looking-at "<[^<> \t\n\r]"))))
|
|
|
310 ;; No tag follows point.
|
|
|
311 (t (error "(id-select-goto-matching-tag): No tag found after point.")))
|
|
|
312
|
|
|
313 (if (catch 'done
|
|
|
314 (cond
|
|
|
315 ;; Beginning of a tag pair
|
|
|
316 ((looking-at "<[^/][^<> \t\n\r]*")
|
|
|
317 (setq tag (buffer-substring (match-beginning 0) (match-end 0))
|
|
|
318 start-regexp (regexp-quote tag)
|
|
|
319 end-regexp (concat "</" (substring start-regexp 1)))
|
|
|
320 ;; Skip over nested tags.
|
|
|
321 (let ((count 0)
|
|
|
322 (regexp (concat start-regexp "\\|" end-regexp))
|
|
|
323 match-point)
|
|
|
324 (while (and (>= count 0)
|
|
|
325 (re-search-forward regexp nil t))
|
|
|
326 (setq match-point (match-beginning 0))
|
|
|
327 (if (/= (char-after (1+ (match-beginning 0))) ?/)
|
|
|
328 ;; Start tag
|
|
|
329 (setq count (1+ count))
|
|
|
330 ;; End tag
|
|
|
331 (setq end-point (point))
|
|
|
332 (if (or (not (re-search-forward "[<>]" nil t))
|
|
|
333 (= (preceding-char) ?<))
|
|
|
334 ;; No terminator character `>' for end tag
|
|
|
335 (progn (setq result end-point)
|
|
|
336 (throw 'done nil)))
|
|
|
337 (setq count (1- count))
|
|
|
338 (if (= count 0)
|
|
|
339 (progn
|
|
|
340 (goto-char match-point)
|
|
|
341 (setq result t)
|
|
|
342 (throw 'done result)))))))
|
|
|
343 ;;
|
|
|
344 ;; End of a tag pair
|
|
|
345 ((or (looking-at "</[^> \t\n\r]+")
|
|
|
346 (and (skip-chars-backward "<")
|
|
|
347 (looking-at "</[^> \t\n\r]+")))
|
|
|
348 (goto-char (match-end 0))
|
|
|
349 (setq tag (buffer-substring (match-beginning 0) (match-end 0))
|
|
|
350 end-regexp (regexp-quote tag)
|
|
|
351 start-regexp (concat "<" (substring end-regexp 2)))
|
|
|
352 (setq end-point (point))
|
|
|
353 (if (or (not (re-search-forward "[<>]" nil t))
|
|
|
354 (= (preceding-char) ?<))
|
|
|
355 ;; No terminator character `>' for end tag
|
|
|
356 (progn (setq result end-point)
|
|
|
357 (throw 'done nil)))
|
|
|
358 ;; Skip over nested tags.
|
|
|
359 (let ((count 0)
|
|
|
360 (regexp (concat start-regexp "\\|" end-regexp)))
|
|
|
361 (while (and (>= count 0)
|
|
|
362 (re-search-backward regexp nil t))
|
|
|
363 (if (= (char-after (1+ (point))) ?/)
|
|
|
364 ;; End tag
|
|
|
365 (setq count (1+ count))
|
|
|
366 ;; Start tag
|
|
|
367 (setq count (1- count))
|
|
|
368 (if (= count 0)
|
|
|
369 (progn
|
|
|
370 (setq result t)
|
|
|
371 (throw 'done t)))))))))
|
|
|
372 nil
|
|
|
373 ;; Didn't find matching tag.
|
|
|
374 (goto-char opoint))
|
|
|
375
|
|
|
376 (cond ((integerp result)
|
|
|
377 (goto-char result)
|
|
|
378 (error "(id-select-goto-matching-tag): Add a terminator character for this end <tag>"))
|
|
|
379 ((null tag)
|
|
|
380 (error "(id-select-goto-matching-tag): No <tag> following point"))
|
|
|
381 ((null result)
|
|
|
382 (if (interactive-p)
|
|
|
383 (progn
|
|
|
384 (beep)
|
|
|
385 (message "(id-select-goto-matching-tag): No matching tag for %s>"
|
|
|
386 tag)
|
|
|
387 result)))
|
|
|
388 (t result)))))
|
|
|
389
|
|
|
390 ;;;###autoload
|
|
|
391 (defun id-select-and-copy-thing ()
|
|
|
392 "Copy the region surrounding the syntactical unit at point."
|
|
|
393 (interactive)
|
|
|
394 (let ((bounds (id-select-boundaries (point))))
|
|
|
395 (if bounds (copy-region-as-kill (car bounds) (cdr bounds)))))
|
|
|
396
|
|
|
397 ;;;###autoload
|
|
|
398 (defun id-select-and-kill-thing ()
|
|
|
399 "Kill the region surrounding the syntactical unit at point."
|
|
|
400 (interactive "*")
|
|
|
401 (let ((bounds (id-select-boundaries (point))))
|
|
|
402 (if bounds (kill-region (car bounds) (cdr bounds)))))
|
|
|
403
|
|
|
404
|
|
|
405 ;;
|
|
|
406 ;; Functions
|
|
|
407 ;;
|
|
|
408
|
|
|
409 (defun id-select-boundaries (pos)
|
|
|
410 "Return the (start . end) of a syntactically defined region based upon the last region selected or on position POS.
|
|
|
411 The character at POS is selected if no other thing is matched."
|
|
|
412 (interactive)
|
|
|
413 (setq zmacs-region-stays t)
|
|
|
414 (setcar id-select-old-region (car id-select-region))
|
|
|
415 (setcdr id-select-old-region (cdr id-select-region))
|
|
|
416 (let ((prior-type id-select-previous))
|
|
|
417 (cond
|
|
|
418 ((eq id-select-previous 'char)
|
|
|
419 (id-select-syntactical-region pos))
|
|
|
420 ((and (car id-select-old-region)
|
|
|
421 (memq id-select-previous
|
|
|
422 '(sexp sexp-start sexp-end sexp-up))
|
|
|
423 (id-select-sexp-up pos)
|
|
|
424 (id-select-region-bigger-p id-select-old-region id-select-region))
|
|
|
425 id-select-region)
|
|
|
426 ;;
|
|
|
427 ;; In the general case, we can't know ahead of time what the next
|
|
|
428 ;; biggest type of thing to select is, so we test them all and choose
|
|
|
429 ;; the best fit. This means that dynamically, the order of type
|
|
|
430 ;; selection will change based on the buffer context.
|
|
|
431 (t (let ((min-region (1+ (- (point-max) (point-min))))
|
|
|
432 (result)
|
|
|
433 region region-size)
|
|
|
434 (mapcar
|
|
|
435 (function
|
|
|
436 (lambda (sym-func)
|
|
|
437 (setq region
|
|
|
438 (if (car (cdr sym-func))
|
|
|
439 (funcall (car (cdr sym-func)) pos)))
|
|
|
440 (if (and region (car region)
|
|
|
441 (id-select-region-bigger-p
|
|
|
442 id-select-old-region region)
|
|
|
443 (setq region-size
|
|
|
444 (- (cdr region) (car region)))
|
|
|
445 (< region-size min-region))
|
|
|
446 (setq min-region region-size
|
|
|
447 result
|
|
|
448 (list;; The actual selection type is
|
|
|
449 ;; sometimes different than the one we
|
|
|
450 ;; originally tried, so recompute it here.
|
|
|
451 (car (assq id-select-previous
|
|
|
452 id-select-bigger-alist))
|
|
|
453 (car region) (cdr region))))))
|
|
|
454 id-select-bigger-alist)
|
|
|
455 (if result
|
|
|
456 ;; Returns id-select-region
|
|
|
457 (progn (setq id-select-previous (car result))
|
|
|
458 (id-select-set-region (nth 1 result) (nth 2 result)))
|
|
|
459 ;;
|
|
|
460 ;; Restore prior selection type since we failed to find a
|
|
|
461 ;; new one.
|
|
|
462 (setq id-select-previous prior-type)
|
|
|
463 (beep)
|
|
|
464 (message
|
|
|
465 "(id-select-boundaries): `%s' is the largest selectable region"
|
|
|
466 id-select-previous)
|
|
|
467 nil))))))
|
|
|
468
|
|
|
469 ;;;###autoload
|
|
|
470 (defun id-select-double-click-hook (event click-count)
|
|
|
471 "Select a region based on the syntax of the character wherever the mouse is double-clicked.
|
|
|
472 If the double-click occurs at the same point as the last double-click, select
|
|
|
473 the next larger syntactic structure. If `id-select-display-type' is non-nil,
|
|
|
474 the type of selection is displayed in the minibuffer."
|
|
|
475 (cond ((/= click-count 2)
|
|
|
476 ;; Return nil so any other hooks are performed.
|
|
|
477 nil)
|
|
|
478 (t (id-select-thing-with-mouse event))))
|
|
|
479
|
|
|
480 (defun id-select-syntactical-region (pos)
|
|
|
481 "Return the (start . end) of a syntactically defined region based upon the buffer position POS.
|
|
|
482 Uses `id-select-syntax-alist' and the current buffer's syntax table to
|
|
|
483 determine syntax groups.
|
|
|
484
|
|
|
485 Typically:
|
|
|
486 Open or close grouping character syntax marks an s-expression.
|
|
|
487 Double quotes mark strings.
|
|
|
488 The end of a line marks the line, including its trailing newline.
|
|
|
489 Word syntax marks the current word.
|
|
|
490 Symbol syntax (such as _) marks a symbol.
|
|
|
491 Whitespace marks a span of whitespace.
|
|
|
492 Comment start or end syntax marks the comment.
|
|
|
493 Punctuation syntax marks the words on both sides of the punctuation.
|
|
|
494 The fallback default is to mark the character at POS.
|
|
|
495
|
|
|
496 If an error occurs during syntax scanning, it returns nil."
|
|
|
497 (interactive "d")
|
|
|
498 (setq id-select-previous 'char)
|
|
|
499 (if (save-excursion (goto-char pos) (eolp))
|
|
|
500 (id-select-line pos)
|
|
|
501 (let* ((syntax (char-syntax (if (eobp) (preceding-char) (char-after pos))))
|
|
|
502 (pair (assq syntax id-select-syntax-alist)))
|
|
|
503 (cond ((and pair
|
|
|
504 (or id-select-whitespace
|
|
|
505 (not (eq (car (cdr pair)) 'thing-whitespace))))
|
|
|
506 (funcall (car (cdr pair)) pos))
|
|
|
507 (id-select-char-p
|
|
|
508 (setq id-select-previous 'char)
|
|
|
509 (id-select-set-region pos (1+ pos)))
|
|
|
510 (t
|
|
|
511 nil)))))
|
|
|
512
|
|
|
513 ;;; ************************************************************************
|
|
|
514 ;;; Private functions
|
|
|
515 ;;; ************************************************************************
|
|
|
516
|
|
|
517 (defun id-select-at-blank-line-or-comment ()
|
|
|
518 "Return non-nil if on a blank line or a comment start or end line.
|
|
|
519 Assumes point is befor any non-whitespace character on the line."
|
|
|
520 (let ((comment-end-p (and (stringp comment-end)
|
|
|
521 (not (string-equal comment-end "")))))
|
|
|
522 (if (looking-at
|
|
|
523 (concat "\\s-*$\\|\\s-*\\(//\\|/\\*\\|.*\\*/"
|
|
|
524 (if comment-start
|
|
|
525 (concat
|
|
|
526 "\\|" (regexp-quote comment-start)))
|
|
|
527 (if comment-end-p
|
|
|
528 (concat
|
|
|
529 "\\|.*" (regexp-quote comment-end)))
|
|
|
530 "\\)"))
|
|
|
531 (or (not (and comment-start comment-end-p))
|
|
|
532 ;; Ignore start and end of comments that
|
|
|
533 ;; follow non-commented text.
|
|
|
534 (not (looking-at
|
|
|
535 (format ".*\\S-.*%s.*%s"
|
|
|
536 (regexp-quote comment-start)
|
|
|
537 (regexp-quote comment-end))))))))
|
|
|
538
|
|
|
539 (defun id-select-region-bigger-p (old-region new-region)
|
|
|
540 "Return t if OLD-REGION is smaller than NEW-REGION and NEW-REGION partially overlaps OLD-REGION, or if OLD-REGION is uninitialized."
|
|
|
541 (if (null (car old-region))
|
|
|
542 t
|
|
|
543 (and (> (abs (- (cdr new-region) (car new-region)))
|
|
|
544 (abs (- (cdr old-region) (car old-region))))
|
|
|
545 ;; Ensure the two regions intersect.
|
|
|
546 (or (and (<= (min (cdr new-region) (car new-region))
|
|
|
547 (min (cdr old-region) (car old-region)))
|
|
|
548 (> (max (cdr new-region) (car new-region))
|
|
|
549 (min (cdr old-region) (car old-region))))
|
|
|
550 (and (> (min (cdr new-region) (car new-region))
|
|
|
551 (min (cdr old-region) (car old-region)))
|
|
|
552 (<= (min (cdr new-region) (car new-region))
|
|
|
553 (max (cdr old-region) (car old-region))))))))
|
|
|
554
|
|
|
555 (defun id-select-bigger-thing ()
|
|
|
556 "Select a bigger object where point is."
|
|
|
557 (prog1
|
|
|
558 (id-select-thing)
|
|
|
559 (setq this-command 'select-thing)))
|
|
|
560
|
|
|
561 (defun id-select-reset ()
|
|
|
562 ;; Reset syntactic selection.
|
|
|
563 (setq id-select-prior-point (point)
|
|
|
564 id-select-prior-buffer (current-buffer)
|
|
|
565 id-select-previous 'char)
|
|
|
566 (id-select-set-region nil nil))
|
|
|
567
|
|
|
568 (defun id-select-set-region (beginning end)
|
|
|
569 "Set the cons cell held by the variable `id-select-region' to (BEGINNING . END).
|
|
|
570 Return the updated cons cell."
|
|
|
571 (setcar id-select-region beginning)
|
|
|
572 (setcdr id-select-region end)
|
|
|
573 (if (and (null beginning) (null end))
|
|
|
574 (progn (setcar id-select-old-region nil)
|
|
|
575 (setcdr id-select-old-region nil)))
|
|
|
576 (if (and (not (eq id-select-previous 'buffer))
|
|
|
577 (integerp beginning) (integerp end)
|
|
|
578 (= beginning (point-min)) (= end (point-max)))
|
|
|
579 ;; If we selected the whole buffer, make sure that 'thing' type is 'buffer'.
|
|
|
580 nil
|
|
|
581 id-select-region))
|
|
|
582
|
|
|
583 (defun id-select-string-p (&optional start-delim end-delim)
|
|
|
584 "Returns (start . end) of string whose first line point is within or immediately before.
|
|
|
585 Positions include delimiters. String is delimited by double quotes unless
|
|
|
586 optional START-DELIM and END-DELIM (strings) are given.
|
|
|
587 Returns nil if not within a string."
|
|
|
588 (let ((opoint (point))
|
|
|
589 (count 0)
|
|
|
590 bol start delim-regexp start-regexp end-regexp)
|
|
|
591 (or start-delim (setq start-delim "\""))
|
|
|
592 (or end-delim (setq end-delim "\""))
|
|
|
593 ;; Special case for the empty string.
|
|
|
594 (if (looking-at (concat (regexp-quote start-delim)
|
|
|
595 (regexp-quote end-delim)))
|
|
|
596 (id-select-set-region (point) (match-end 0))
|
|
|
597 (setq start-regexp (concat "\\(^\\|[^\\]\\)\\("
|
|
|
598 (regexp-quote start-delim) "\\)")
|
|
|
599 end-regexp (concat "[^\\]\\(" (regexp-quote end-delim) "\\)")
|
|
|
600 delim-regexp (concat start-regexp "\\|" end-regexp))
|
|
|
601 (save-excursion
|
|
|
602 (beginning-of-line)
|
|
|
603 (setq bol (point))
|
|
|
604 (while (re-search-forward delim-regexp opoint t)
|
|
|
605 (setq count (1+ count))
|
|
|
606 ;; This is so we don't miss the closing delimiter of an empty
|
|
|
607 ;; string.
|
|
|
608 (if (and (= (point) (1+ bol))
|
|
|
609 (looking-at (regexp-quote end-delim)))
|
|
|
610 (setq count (1+ count))
|
|
|
611 (if (bobp) nil (backward-char 1))))
|
|
|
612 (goto-char opoint)
|
|
|
613 ;; If found an even # of starting and ending delimiters before
|
|
|
614 ;; opoint, then opoint is at the start of a string, where we want it.
|
|
|
615 (if (zerop (mod count 2))
|
|
|
616 (if (bobp) nil (backward-char 1))
|
|
|
617 (re-search-backward start-regexp nil t))
|
|
|
618 ;; Point is now before the start of the string.
|
|
|
619 (if (re-search-forward start-regexp nil t)
|
|
|
620 (progn
|
|
|
621 (setq start (match-beginning 2))
|
|
|
622 (if (re-search-forward end-regexp nil t)
|
|
|
623 (id-select-set-region start (point)))))))))
|
|
|
624
|
|
|
625 ;;;
|
|
|
626 ;;; Code selections
|
|
|
627 ;;;
|
|
|
628
|
|
|
629 (defun id-select-brace-def-or-declaration (pos)
|
|
|
630 "If POS is at the first character, opening brace or closing brace of a brace delimited language definition, return (start . end) region, else nil.
|
|
|
631 The major mode for each supported brace language must be included in the
|
|
|
632 list, id-select-brace-modes."
|
|
|
633 (interactive)
|
|
|
634 (if (not (and (featurep 'cc-mode) (memq major-mode id-select-brace-modes)))
|
|
|
635 nil
|
|
|
636 (save-excursion
|
|
|
637 (goto-char pos)
|
|
|
638 (let ((at-def-brace
|
|
|
639 (or (looking-at "^{") (looking-at "^}")
|
|
|
640 ;; Handle stupid old C-style and new Java
|
|
|
641 ;; style of putting braces at the end of
|
|
|
642 ;; lines.
|
|
|
643 (and (= (following-char) ?{)
|
|
|
644 (stringp defun-prompt-regexp)
|
|
|
645 (save-excursion
|
|
|
646 (beginning-of-line)
|
|
|
647 (looking-at defun-prompt-regexp)))
|
|
|
648 (and (= (following-char) ?})
|
|
|
649 (stringp defun-prompt-regexp)
|
|
|
650 (condition-case ()
|
|
|
651 (progn
|
|
|
652 ;; Leave point at opening brace.
|
|
|
653 (goto-char
|
|
|
654 (scan-sexps (1+ (point)) -1))
|
|
|
655 ;; Test if these are defun braces.
|
|
|
656 (save-excursion
|
|
|
657 (beginning-of-line)
|
|
|
658 (looking-at defun-prompt-regexp)))
|
|
|
659 (error nil)))))
|
|
|
660 eod)
|
|
|
661 (if (or at-def-brace
|
|
|
662 ;; At the start of a definition:
|
|
|
663 ;; Must be at the first non-whitespace character in the line.
|
|
|
664 (and (= (point) (save-excursion (back-to-indentation) (point)))
|
|
|
665 ;; Must be on an alpha or symbol-constituent character.
|
|
|
666 ;; Also allow ~ for C++ destructors.
|
|
|
667 (looking-at "[a-zA-z~]\\|\\s_")
|
|
|
668 ;; Previous line, if any, must be blank or a comment
|
|
|
669 ;; start or end or `defun-prompt-regexp' must be defined
|
|
|
670 ;; for this mode.
|
|
|
671 (or (stringp defun-prompt-regexp)
|
|
|
672 (save-excursion
|
|
|
673 (if (/= (forward-line -1) 0)
|
|
|
674 t
|
|
|
675 (id-select-at-blank-line-or-comment))))))
|
|
|
676 (progn
|
|
|
677 (setq id-select-previous 'brace-def-or-declaration)
|
|
|
678 ;; Handle declarations and definitions embedded within classes.
|
|
|
679 (if (and (= (following-char) ?{)
|
|
|
680 (/= (point) (save-excursion (back-to-indentation) (point))))
|
|
|
681 (setq at-def-brace nil))
|
|
|
682 ;;
|
|
|
683 (if at-def-brace nil (beginning-of-line))
|
|
|
684 (if (and (not at-def-brace)
|
|
|
685 (stringp defun-prompt-regexp)
|
|
|
686 (looking-at defun-prompt-regexp))
|
|
|
687 ;; Mark the declaration or definition
|
|
|
688 (id-select-set-region
|
|
|
689 (point)
|
|
|
690 (progn (goto-char (match-end 0))
|
|
|
691 (if (= (following-char) ?{)
|
|
|
692 (forward-list 1)
|
|
|
693 (search-forward ";" nil t))
|
|
|
694 (skip-chars-forward " \t")
|
|
|
695 (skip-chars-forward "\n")
|
|
|
696 (if (looking-at "^\\s-*$")
|
|
|
697 (forward-line 1))
|
|
|
698 (point)))
|
|
|
699 ;; Mark function definitions only
|
|
|
700 (setq eod (save-excursion
|
|
|
701 (condition-case ()
|
|
|
702 (progn
|
|
|
703 (end-of-defun)
|
|
|
704 (if (looking-at "^\\s-*$")
|
|
|
705 (forward-line 1))
|
|
|
706 (point))
|
|
|
707 (error (point-max)))))
|
|
|
708 (if (= (following-char) ?})
|
|
|
709 ;; Leave point at opening brace.
|
|
|
710 (goto-char (scan-sexps (1+ (point)) -1)))
|
|
|
711 (if (= (following-char) ?{)
|
|
|
712 (progn
|
|
|
713 (while (and (zerop (forward-line -1))
|
|
|
714 (not (id-select-at-blank-line-or-comment))))
|
|
|
715 (if (id-select-at-blank-line-or-comment)
|
|
|
716 (forward-line 1))))
|
|
|
717 ;; Mark the whole definition
|
|
|
718 (setq id-select-previous 'brace-def-or-declaration)
|
|
|
719 (id-select-set-region (point) eod))))))))
|
|
|
720
|
|
|
721 (defun id-select-indent-def (pos)
|
|
|
722 "If POS is at the first alpha character on a line, return (start . end) region,
|
|
|
723
|
|
|
724 The major mode for each supported indented language must be included in the
|
|
|
725 list, id-select-indent-modes."
|
|
|
726 (interactive)
|
|
|
727 (if (not (memq major-mode id-select-indent-modes))
|
|
|
728 nil
|
|
|
729 (save-excursion
|
|
|
730 (goto-char pos)
|
|
|
731 (if (and
|
|
|
732 ;; Use this function only if point is on the first non-blank
|
|
|
733 ;; character of a block, whatever a block is for the current
|
|
|
734 ;; mode.
|
|
|
735 (cond ((eq major-mode 'kotl-mode)
|
|
|
736 (and (looking-at "[1-9*]") (not (kview:valid-position-p))))
|
|
|
737 ((or (eq major-mode 'outline-mode) selective-display)
|
|
|
738 (save-excursion (beginning-of-line)
|
|
|
739 (looking-at outline-regexp)))
|
|
|
740 ;; After indent in any other mode, must be on an alpha
|
|
|
741 ;; or symbol-constituent character.
|
|
|
742 (t (looking-at "[a-zA-z]\\|\\s_")))
|
|
|
743 ;; Must be at the first non-whitespace character in the line.
|
|
|
744 (= (point) (save-excursion (back-to-indentation) (point))))
|
|
|
745 (let* ((start-col (current-column))
|
|
|
746 (opoint (if (eq major-mode 'kotl-mode)
|
|
|
747 (progn (kotl-mode:to-valid-position) (point))
|
|
|
748 (beginning-of-line) (point))))
|
|
|
749 (while
|
|
|
750 (and (zerop (forward-line 1))
|
|
|
751 (bolp)
|
|
|
752 (or (progn (back-to-indentation)
|
|
|
753 (> (current-column) start-col))
|
|
|
754 ;; If in a text mode, allow outdenting, otherwise
|
|
|
755 ;; only include special lines here indented to the
|
|
|
756 ;; same point as the original line.
|
|
|
757 (and (or (memq major-mode id-select-text-modes)
|
|
|
758 (= (current-column) start-col))
|
|
|
759 (looking-at
|
|
|
760 (or (car (cdr
|
|
|
761 (assq
|
|
|
762 major-mode
|
|
|
763 id-select-indent-non-end-regexp-alist)))
|
|
|
764 "\\'"))))))
|
|
|
765 (if (and (looking-at
|
|
|
766 (or (car (cdr (assq major-mode
|
|
|
767 id-select-indent-end-regexp-alist)))
|
|
|
768 "\\'"))
|
|
|
769 (or (memq major-mode id-select-text-modes)
|
|
|
770 (= (current-column) start-col)))
|
|
|
771 (forward-line 1))
|
|
|
772 (beginning-of-line)
|
|
|
773 ;; Mark the whole definition
|
|
|
774 (setq id-select-previous 'indent-def)
|
|
|
775 (id-select-set-region opoint (point)))))))
|
|
|
776
|
|
|
777 (defun id-select-symbol (pos)
|
|
|
778 "Return (start . end) of a symbol at POS."
|
|
|
779 (or (id-select-markup-pair pos)
|
|
|
780 ;; Test for indented def here since might be on an '*' representing
|
|
|
781 ;; an outline entry, in which case we mark entries as indented blocks.
|
|
|
782 (id-select-indent-def pos)
|
|
|
783 (save-excursion
|
|
|
784 (if (memq (char-syntax (if (eobp) (preceding-char) (char-after pos)))
|
|
|
785 '(?w ?_))
|
|
|
786 (progn (setq id-select-previous 'symbol)
|
|
|
787 (condition-case ()
|
|
|
788 (let ((end (scan-sexps pos 1)))
|
|
|
789 (id-select-set-region
|
|
|
790 (min pos (scan-sexps end -1)) end))
|
|
|
791 (error nil)))))))
|
|
|
792
|
|
|
793 (defun id-select-sexp-start (pos)
|
|
|
794 "Return (start . end) of sexp starting at POS."
|
|
|
795 (or (id-select-markup-pair pos)
|
|
|
796 (id-select-brace-def-or-declaration pos)
|
|
|
797 (save-excursion
|
|
|
798 (setq id-select-previous 'sexp-start)
|
|
|
799 (condition-case ()
|
|
|
800 (id-select-set-region pos (scan-sexps pos 1))
|
|
|
801 (error nil)))))
|
|
|
802
|
|
|
803 (defun id-select-sexp-end (pos)
|
|
|
804 "Return (start . end) of sexp ending at POS."
|
|
|
805 (or (id-select-brace-def-or-declaration pos)
|
|
|
806 (save-excursion
|
|
|
807 (setq id-select-previous 'sexp-end)
|
|
|
808 (condition-case ()
|
|
|
809 (id-select-set-region (scan-sexps (1+ pos) -1) (1+ pos))
|
|
|
810 (error nil)))))
|
|
|
811
|
|
|
812 (defun id-select-sexp (pos)
|
|
|
813 "Return (start . end) of the sexp that POS is within."
|
|
|
814 (setq id-select-previous 'sexp)
|
|
|
815 (save-excursion
|
|
|
816 (goto-char pos)
|
|
|
817 (condition-case ()
|
|
|
818 (id-select-set-region (progn (backward-up-list 1) (point))
|
|
|
819 (progn (forward-list 1) (point)))
|
|
|
820 (error nil))))
|
|
|
821
|
|
|
822 (defun id-select-sexp-up (pos)
|
|
|
823 "Return (start . end) of the sexp enclosing the selected area or nil."
|
|
|
824 (setq id-select-previous 'sexp-up)
|
|
|
825 ;; Keep going up and backward in sexps. This means that id-select-sexp-up
|
|
|
826 ;; can only be called after id-select-sexp or after itself.
|
|
|
827 (setq pos (or (car id-select-region) pos))
|
|
|
828 (save-excursion
|
|
|
829 (goto-char pos)
|
|
|
830 (condition-case ()
|
|
|
831 (id-select-set-region (progn (backward-up-list 1) (point))
|
|
|
832 (progn (forward-list 1) (point)))
|
|
|
833 (error nil))))
|
|
|
834
|
|
|
835 (defun id-select-preprocessor-def (pos)
|
|
|
836 "Return (start . end) of a preprocessor #definition starting at POS, if any.
|
|
|
837 The major mode for each language that uses # preprocessor notation must be
|
|
|
838 included in the list, id-select-brace-modes."
|
|
|
839 ;; Only applies in brace modes (strictly, this should apply in a subset
|
|
|
840 ;; of brace modes, but doing it this way permits for configurability. In
|
|
|
841 ;; other modes, one doesn't have to use the function on a # symbol.
|
|
|
842 (if (not (memq major-mode id-select-brace-modes))
|
|
|
843 nil
|
|
|
844 (setq id-select-previous 'preprocessor-def)
|
|
|
845 (save-excursion
|
|
|
846 (goto-char pos)
|
|
|
847 (if (and (= (following-char) ?#)
|
|
|
848 ;; Must be at the first non-whitespace character in the line.
|
|
|
849 (= (point) (save-excursion (back-to-indentation) (point))))
|
|
|
850 (progn
|
|
|
851 ;; Skip past continuation lines that end with a backslash.
|
|
|
852 (while (and (looking-at ".*\\\\\\s-*$")
|
|
|
853 (zerop (forward-line 1))))
|
|
|
854 (forward-line 1)
|
|
|
855 ;; Include one trailing blank line, if any.
|
|
|
856 (if (looking-at "^[ \t\n\r]*$") (forward-line 1))
|
|
|
857 (id-select-set-region pos (point)))))))
|
|
|
858
|
|
|
859 ;; Allow punctuation marks not followed by white-space to include
|
|
|
860 ;; the previous and subsequent sexpression. Useful in contexts such as
|
|
|
861 ;; 'foo.bar'.
|
|
|
862 (defun id-select-punctuation (pos)
|
|
|
863 "Return (start . end) region including sexpressions before and after POS, when at a punctuation character."
|
|
|
864 (or (id-select-comment pos)
|
|
|
865 (id-select-preprocessor-def pos)
|
|
|
866 (id-select-brace-def-or-declaration pos) ;; Might be on a C++ ;; destructor ~.
|
|
|
867 (save-excursion
|
|
|
868 (setq id-select-previous 'punctuation)
|
|
|
869 (goto-char (min (1+ pos) (point-max)))
|
|
|
870 (if (= (char-syntax (if (eobp) (preceding-char) (char-after (point))))
|
|
|
871 ?\ )
|
|
|
872 (id-select-set-region pos (1+ pos))
|
|
|
873 (goto-char pos)
|
|
|
874 (id-select-set-region
|
|
|
875 (save-excursion (backward-sexp) (point))
|
|
|
876 (progn (forward-sexp) (point)))))))
|
|
|
877
|
|
|
878 (defun id-select-comment (pos)
|
|
|
879 "Return rest of line from POS to newline."
|
|
|
880 (setq id-select-previous 'comment)
|
|
|
881 (save-excursion
|
|
|
882 (goto-char pos)
|
|
|
883 (let ((start-regexp (if (stringp comment-start)
|
|
|
884 (regexp-quote comment-start)))
|
|
|
885 (end-regexp (if (stringp comment-end)
|
|
|
886 (regexp-quote comment-end)))
|
|
|
887 bolp)
|
|
|
888 (cond
|
|
|
889 ;; Beginning of a comment
|
|
|
890 ((and (stringp comment-start)
|
|
|
891 (or (looking-at start-regexp)
|
|
|
892 (and (skip-chars-backward comment-start)
|
|
|
893 (looking-at start-regexp))))
|
|
|
894 (skip-chars-backward " \t")
|
|
|
895 (setq bolp (bolp)
|
|
|
896 pos (point))
|
|
|
897 (if (equal comment-end "")
|
|
|
898 (progn (end-of-line)
|
|
|
899 (id-select-set-region pos (point)))
|
|
|
900 (if (stringp comment-end)
|
|
|
901 ;; Skip over nested comments.
|
|
|
902 (let ((count 0)
|
|
|
903 (regexp (concat start-regexp "\\|" end-regexp)))
|
|
|
904 (catch 'done
|
|
|
905 (while (re-search-forward regexp nil t)
|
|
|
906 (if (string-equal
|
|
|
907 (buffer-substring (match-beginning 0) (match-end 0))
|
|
|
908 comment-start)
|
|
|
909 (setq count (1+ count))
|
|
|
910 ;; End comment
|
|
|
911 (setq count (1- count))
|
|
|
912 (if (= count 0)
|
|
|
913 (progn
|
|
|
914 (if (looking-at "[ \t]*[\n\r]")
|
|
|
915 ;; Don't include final newline unless the
|
|
|
916 ;; comment is first thing on its line.
|
|
|
917 (goto-char (if bolp (match-end 0)
|
|
|
918 (1- (match-end 0)))))
|
|
|
919 (throw 'done (id-select-set-region
|
|
|
920 pos (point))))))))))))
|
|
|
921 ;; End of a comment
|
|
|
922 ((and (stringp comment-end)
|
|
|
923 (not (string-equal comment-end ""))
|
|
|
924 (or (looking-at end-regexp)
|
|
|
925 (and (skip-chars-backward comment-end)
|
|
|
926 (looking-at end-regexp))))
|
|
|
927 (goto-char (match-end 0))
|
|
|
928 (if (looking-at "[ \t]*[\n\r]")
|
|
|
929 (goto-char (match-end 0)))
|
|
|
930 (setq pos (point))
|
|
|
931 (skip-chars-forward " \t")
|
|
|
932 ;; Skip over nested comments.
|
|
|
933 (let ((count 0)
|
|
|
934 (regexp (concat start-regexp "\\|" end-regexp)))
|
|
|
935 (catch 'done
|
|
|
936 (while (re-search-backward regexp nil t)
|
|
|
937 (if (string-equal
|
|
|
938 (buffer-substring (match-beginning 0) (match-end 0))
|
|
|
939 comment-end)
|
|
|
940 (setq count (1+ count))
|
|
|
941 ;; Begin comment
|
|
|
942 (setq count (1- count))
|
|
|
943 (if (= count 0)
|
|
|
944 (progn
|
|
|
945 (skip-chars-backward " \t")
|
|
|
946 ;; Don't include final newline unless the comment is
|
|
|
947 ;; first thing on its line.
|
|
|
948 (if (bolp) nil (setq pos (1- pos)))
|
|
|
949 (throw 'done (id-select-set-region
|
|
|
950 (point) pos)))))))))))))
|
|
|
951
|
|
|
952 ;;;
|
|
|
953 ;;; Textual selections
|
|
|
954 ;;;
|
|
|
955
|
|
|
956 (defun id-select-word (pos)
|
|
|
957 "Return (start . end) of word at POS."
|
|
|
958 (or (id-select-brace-def-or-declaration pos)
|
|
|
959 (id-select-indent-def pos)
|
|
|
960 (progn (setq id-select-previous 'word)
|
|
|
961 (save-excursion
|
|
|
962 (goto-char pos)
|
|
|
963 (forward-word 1)
|
|
|
964 (let ((end (point)))
|
|
|
965 (forward-word -1)
|
|
|
966 (id-select-set-region (point) end))))))
|
|
|
967
|
|
|
968 (defun id-select-string (pos)
|
|
|
969 "Returns (start . end) of string at POS or nil. Pos include delimiters.
|
|
|
970 Delimiters may be single, double or open and close quotes."
|
|
|
971 (setq id-select-previous 'string)
|
|
|
972 (save-excursion
|
|
|
973 (goto-char pos)
|
|
|
974 (if (and (memq major-mode id-select-markup-modes)
|
|
|
975 (/= (following-char) ?\")
|
|
|
976 (save-excursion
|
|
|
977 (and (re-search-backward "[<>]" nil t)
|
|
|
978 (= (following-char) ?>))))
|
|
|
979 (progn (setq id-select-previous 'text)
|
|
|
980 (search-backward ">" nil t)
|
|
|
981 (id-select-set-region
|
|
|
982 (1+ (point))
|
|
|
983 (progn (if (search-forward "<" nil 'end)
|
|
|
984 (1- (point))
|
|
|
985 (point)))))
|
|
|
986 (or (id-select-string-p) (id-select-string-p "'" "'")
|
|
|
987 (id-select-string-p "`" "'")))))
|
|
|
988
|
|
|
989 (defun id-select-sentence (pos)
|
|
|
990 "Return (start . end) of the sentence at POS."
|
|
|
991 (setq id-select-previous 'sentence)
|
|
|
992 (save-excursion
|
|
|
993 (goto-char pos)
|
|
|
994 (condition-case ()
|
|
|
995 (id-select-set-region (progn (backward-sentence) (point))
|
|
|
996 (progn (forward-sentence) (point)))
|
|
|
997 (error nil))))
|
|
|
998
|
|
|
999 (defun id-select-whitespace (pos)
|
|
|
1000 "Return (start . end) of all but one char of whitespace POS, unless
|
|
|
1001 there is only one character of whitespace or this is leading whitespace on
|
|
|
1002 the line. Then return all of it."
|
|
|
1003 (setq id-select-previous 'whitespace)
|
|
|
1004 (save-excursion
|
|
|
1005 (goto-char pos)
|
|
|
1006 (if (= (following-char) ?\^L)
|
|
|
1007 (id-select-page pos)
|
|
|
1008 (let ((end (progn (skip-chars-forward " \t") (point)))
|
|
|
1009 (start (progn (skip-chars-backward " \t") (point))))
|
|
|
1010 (if (looking-at "[ \t]")
|
|
|
1011 (if (or (bolp) (= (1+ start) end))
|
|
|
1012 (id-select-set-region start end)
|
|
|
1013 (id-select-set-region (1+ start) end)))))))
|
|
|
1014
|
|
|
1015 (defun id-select-markup-pair (pos)
|
|
|
1016 "Return (start . end) of region between the opening and closing of an HTML or SGML tag pair, one of which is at POS.
|
|
|
1017 The major mode for each language that uses such tags must be included in the
|
|
|
1018 list, id-select-markup-modes."
|
|
|
1019 (if (not (memq major-mode id-select-markup-modes))
|
|
|
1020 nil
|
|
|
1021 (setq id-select-previous 'markup-pair)
|
|
|
1022 (let ((pos-with-space)
|
|
|
1023 ;; Assume case of tag names is irrelevant.
|
|
|
1024 (case-fold-search t)
|
|
|
1025 (result)
|
|
|
1026 start-regexp
|
|
|
1027 end-regexp
|
|
|
1028 bolp
|
|
|
1029 opoint)
|
|
|
1030 (save-excursion
|
|
|
1031 (catch 'done
|
|
|
1032 (goto-char pos)
|
|
|
1033 (cond
|
|
|
1034 ;; Beginning of a tag pair
|
|
|
1035 ((looking-at "<[^/][^<> \t\n\r]*")
|
|
|
1036 (setq start-regexp (regexp-quote (buffer-substring
|
|
|
1037 (match-beginning 0) (match-end 0)))
|
|
|
1038 end-regexp (concat "</" (substring start-regexp 1)))
|
|
|
1039 (setq pos (point))
|
|
|
1040 (skip-chars-backward " \t")
|
|
|
1041 (setq bolp (bolp)
|
|
|
1042 pos-with-space (point))
|
|
|
1043 ;; Skip over nested tags.
|
|
|
1044 (let ((count 0)
|
|
|
1045 (regexp (concat start-regexp "\\|" end-regexp)))
|
|
|
1046 (while (and (>= count 0)
|
|
|
1047 (re-search-forward regexp nil t))
|
|
|
1048 (if (/= (char-after (1+ (match-beginning 0))) ?/)
|
|
|
1049 ;; Start tag
|
|
|
1050 (setq count (1+ count))
|
|
|
1051 ;; Move past end tag terminator
|
|
|
1052 (setq opoint (point))
|
|
|
1053 (if (or (not (re-search-forward "[<>]" nil t))
|
|
|
1054 (= (preceding-char) ?<))
|
|
|
1055 (progn (setq result opoint)
|
|
|
1056 (throw 'done nil)))
|
|
|
1057 (setq count (1- count))
|
|
|
1058 (if (= count 0)
|
|
|
1059 (progn
|
|
|
1060 (if (looking-at "[ \t]*[\n\r]")
|
|
|
1061 ;; Don't include final newline unless the
|
|
|
1062 ;; start tag was the first thing on its line.
|
|
|
1063 (if bolp
|
|
|
1064 (progn (goto-char (match-end 0))
|
|
|
1065 ;; Include leading space since the
|
|
|
1066 ;; start and end tags begin and end
|
|
|
1067 ;; lines.
|
|
|
1068 (setq pos pos-with-space))
|
|
|
1069 (goto-char (1- (match-end 0)))))
|
|
|
1070 (setq result (id-select-set-region pos (point)))
|
|
|
1071 (throw 'done nil)))))))
|
|
|
1072 ;;
|
|
|
1073 ;; End of a tag pair
|
|
|
1074 ((or (looking-at "</[^> \t\n\r]+")
|
|
|
1075 (and (skip-chars-backward "<")
|
|
|
1076 (looking-at "</[^> \t\n\r]+")))
|
|
|
1077 (goto-char (match-end 0))
|
|
|
1078 (setq end-regexp (regexp-quote (buffer-substring
|
|
|
1079 (match-beginning 0) (match-end 0)))
|
|
|
1080 start-regexp (concat "<" (substring end-regexp 2)))
|
|
|
1081 (setq opoint (point))
|
|
|
1082 (if (or (not (re-search-forward "[<>]" nil t))
|
|
|
1083 (= (preceding-char) ?<))
|
|
|
1084 (progn (setq result opoint)
|
|
|
1085 (throw 'done nil)))
|
|
|
1086 (setq pos (point))
|
|
|
1087 (if (looking-at "[ \t]*[\n\r]")
|
|
|
1088 (setq pos-with-space (match-end 0)))
|
|
|
1089 ;; Skip over nested tags.
|
|
|
1090 (let ((count 0)
|
|
|
1091 (regexp (concat start-regexp "\\|" end-regexp)))
|
|
|
1092 (while (and (>= count 0)
|
|
|
1093 (re-search-backward regexp nil t))
|
|
|
1094 (if (= (char-after (1+ (point))) ?/)
|
|
|
1095 ;; End tag
|
|
|
1096 (setq count (1+ count))
|
|
|
1097 ;; Start tag
|
|
|
1098 (setq count (1- count))
|
|
|
1099 (if (= count 0)
|
|
|
1100 (progn
|
|
|
1101 (if pos-with-space
|
|
|
1102 ;; Newline found after original end tag.
|
|
|
1103 (progn
|
|
|
1104 (skip-chars-backward " \t")
|
|
|
1105 (if (bolp)
|
|
|
1106 ;; Don't include final newline unless the
|
|
|
1107 ;; start tag is the first thing on its line.
|
|
|
1108 (setq pos pos-with-space)
|
|
|
1109 (setq pos (1- pos-with-space))
|
|
|
1110 ;; Don't include non-leading space.
|
|
|
1111 (skip-chars-forward " \t"))))
|
|
|
1112 (setq result (id-select-set-region (point) pos))
|
|
|
1113 (throw 'done nil))))))))))
|
|
|
1114 (if (integerp result)
|
|
|
1115 (progn (goto-char result)
|
|
|
1116 (error "(id-select-markup-pair): Add a terminator character for this end tag"))
|
|
|
1117 result))))
|
|
|
1118
|
|
|
1119 ;;;
|
|
|
1120 ;;; Document selections
|
|
|
1121 ;;;
|
|
|
1122
|
|
|
1123 (defun id-select-line (pos)
|
|
|
1124 "Return (start . end) of the whole line POS is in, with newline unless at end of buffer."
|
|
|
1125 (setq id-select-previous 'line)
|
|
|
1126 (save-excursion
|
|
|
1127 (goto-char pos)
|
|
|
1128 (let* ((start (progn (beginning-of-line 1) (point)))
|
|
|
1129 (end (progn (forward-line 1) (point))))
|
|
|
1130 (id-select-set-region start end))))
|
|
|
1131
|
|
|
1132 (defun id-select-paragraph (pos)
|
|
|
1133 "Return (start . end) of the paragraph at POS."
|
|
|
1134 (setq id-select-previous 'paragraph)
|
|
|
1135 (save-excursion
|
|
|
1136 (goto-char pos)
|
|
|
1137 (id-select-set-region (progn (backward-paragraph) (point))
|
|
|
1138 (progn (forward-paragraph) (point)))))
|
|
|
1139
|
|
|
1140 (defun id-select-page (pos)
|
|
|
1141 "Return (start . end) of the page preceding POS."
|
|
|
1142 (setq id-select-previous 'page)
|
|
|
1143 (save-excursion
|
|
|
1144 (goto-char pos)
|
|
|
1145 (id-select-set-region (progn (backward-page) (point))
|
|
|
1146 (progn (forward-page) (point)))))
|
|
|
1147
|
|
|
1148 (defun id-select-buffer (pos)
|
|
|
1149 "Return (start . end) of the buffer at POS."
|
|
|
1150 (setq id-select-previous 'buffer)
|
|
|
1151 (id-select-set-region (point-min) (point-max)))
|
|
|
1152
|
|
|
1153 ;;; ************************************************************************
|
|
|
1154 ;;; Private variables
|
|
|
1155 ;;; ************************************************************************
|
|
|
1156
|
|
|
1157 (defvar id-select-bigger-alist
|
|
|
1158 '((char nil)
|
|
|
1159 (whitespace id-select-whitespace)
|
|
|
1160 (word id-select-word)
|
|
|
1161 (symbol id-select-symbol)
|
|
|
1162 (punctuation nil)
|
|
|
1163 (string id-select-string)
|
|
|
1164 (text nil)
|
|
|
1165 (comment id-select-comment)
|
|
|
1166 (markup-pair nil)
|
|
|
1167 (preprocessor-def nil)
|
|
|
1168 (sexp id-select-sexp)
|
|
|
1169 (sexp-start nil)
|
|
|
1170 (sexp-end nil)
|
|
|
1171 (sexp-up id-select-sexp-up)
|
|
|
1172 (line id-select-line)
|
|
|
1173 (sentence id-select-sentence)
|
|
|
1174 (brace-def-or-declaration id-select-brace-def-or-declaration)
|
|
|
1175 (indent-def id-select-indent-def)
|
|
|
1176 (paragraph id-select-paragraph)
|
|
|
1177 (page id-select-page)
|
|
|
1178 (buffer id-select-buffer)
|
|
|
1179 )
|
|
|
1180 "List of (REGION-TYPE-SYMBOL REGION-SELECTION-FUNCTION) pairs.
|
|
|
1181 Used to go from one thing to a bigger thing. See id-select-bigger-thing.
|
|
|
1182 Nil value for REGION-SELECTION-FUNCTION means that region type is skipped
|
|
|
1183 over when trying to grow the region and is only used when a selection is made
|
|
|
1184 with point on a character that triggers that type of selection. Ordering of
|
|
|
1185 entries is largely irrelevant to any code that uses this list.")
|
|
|
1186
|
|
|
1187
|
|
|
1188 (defvar id-select-prior-buffer nil)
|
|
|
1189 (defvar id-select-prior-point nil)
|
|
|
1190
|
|
|
1191 (defvar id-select-previous 'char
|
|
|
1192 "Most recent type of selection. Must be set by all id-select functions.")
|
|
|
1193
|
|
|
1194 (defvar id-select-region (cons 'nil 'nil)
|
|
|
1195 "Cons cell that contains a region (<beginning> . <end>).
|
|
|
1196 The function `id-select-set-region' updates and returns it.")
|
|
|
1197
|
|
|
1198 (defvar id-select-old-region (cons 'nil 'nil)
|
|
|
1199 "Cons cell that contains a region (<beginning> . <end>).")
|
|
|
1200
|
|
|
1201 (defvar id-select-syntax-alist
|
|
|
1202 '((?w id-select-word)
|
|
|
1203 (?_ id-select-symbol)
|
|
|
1204 (?\" id-select-string)
|
|
|
1205 (?\( id-select-sexp-start)
|
|
|
1206 (?\$ id-select-sexp-start)
|
|
|
1207 (?' id-select-sexp-start)
|
|
|
1208 (?\) id-select-sexp-end)
|
|
|
1209 (? id-select-whitespace)
|
|
|
1210 (?< id-select-comment)
|
|
|
1211 (?. id-select-punctuation))
|
|
|
1212 "*List of pairs of the form (SYNTAX-CHAR FUNCTION) used by the function `id-select-syntactical-region'.
|
|
|
1213 Each FUNCTION takes a single position argument and returns a region
|
|
|
1214 (start . end) delineating the boundaries of the thing at that position.
|
|
|
1215 Ordering of entries is largely irrelevant to any code that uses this list.")
|
|
|
1216
|
|
|
1217
|
|
|
1218 (provide 'id-select)
|
