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