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