38436
|
1 ;;; mouse-sel.el --- multi-click selection support for Emacs 19
|
4934
|
2
|
64762
|
3 ;; Copyright (C) 1993, 1994, 1995, 2001, 2002, 2003, 2004,
|
75347
|
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
|
4934
|
5
|
46194
|
6 ;; Author: Mike Williams <mdub@bigfoot.com>
|
4934
|
7 ;; Keywords: mouse
|
|
8
|
|
9 ;; This file is part of GNU Emacs.
|
|
10
|
|
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
12 ;; it under the terms of the GNU General Public License as published by
|
78236
|
13 ;; the Free Software Foundation; either version 3, or (at your option)
|
4934
|
14 ;; any later version.
|
|
15
|
|
16 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
19 ;; GNU General Public License for more details.
|
|
20
|
14169
|
21 ;; You should have received a copy of the GNU General Public License
|
|
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
64091
|
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
24 ;; Boston, MA 02110-1301, USA.
|
14169
|
25
|
7942
|
26 ;;; Commentary:
|
14169
|
27
|
4934
|
28 ;; This module provides multi-click mouse support for GNU Emacs versions
|
|
29 ;; 19.18 and later. I've tried to make it behave more like standard X
|
|
30 ;; clients (eg. xterm) than the default Emacs 19 mouse selection handlers.
|
|
31 ;; Basically:
|
|
32 ;;
|
|
33 ;; * Clicking mouse-1 starts (cancels) selection, dragging extends it.
|
|
34 ;;
|
|
35 ;; * Clicking or dragging mouse-3 extends the selection as well.
|
|
36 ;;
|
|
37 ;; * Double-clicking on word constituents selects words.
|
|
38 ;; Double-clicking on symbol constituents selects symbols.
|
|
39 ;; Double-clicking on quotes or parentheses selects sexps.
|
|
40 ;; Double-clicking on whitespace selects whitespace.
|
|
41 ;; Triple-clicking selects lines.
|
11490
|
42 ;; Quad-clicking selects paragraphs.
|
4934
|
43 ;;
|
|
44 ;; * Selecting sets the region & X primary selection, but does NOT affect
|
|
45 ;; the kill-ring. Because the mouse handlers set the primary selection
|
|
46 ;; directly, mouse-sel sets the variables interprogram-cut-function
|
|
47 ;; and interprogram-paste-function to nil.
|
|
48 ;;
|
11490
|
49 ;; * Clicking mouse-2 inserts the contents of the primary selection at
|
|
50 ;; the mouse position (or point, if mouse-yank-at-point is non-nil).
|
4934
|
51 ;;
|
5750
|
52 ;; * Pressing mouse-2 while selecting or extending copies selection
|
4934
|
53 ;; to the kill ring. Pressing mouse-1 or mouse-3 kills it.
|
41608
|
54 ;;
|
5750
|
55 ;; * Double-clicking mouse-3 also kills selection.
|
41608
|
56 ;;
|
11490
|
57 ;; * M-mouse-1, M-mouse-2 & M-mouse-3 work similarly to mouse-1, mouse-2
|
|
58 ;; & mouse-3, but operate on the X secondary selection rather than the
|
|
59 ;; primary selection and region.
|
4934
|
60 ;;
|
5750
|
61 ;; This module requires my thingatpt.el module, which it uses to find the
|
|
62 ;; bounds of words, lines, sexps, etc.
|
4934
|
63 ;;
|
|
64 ;; Thanks to KevinB@bartley.demon.co.uk for his useful input.
|
|
65 ;;
|
5750
|
66 ;;--- Customisation -------------------------------------------------------
|
|
67 ;;
|
|
68 ;; * You may want to use none or more of following:
|
4934
|
69 ;;
|
|
70 ;; ;; Enable region highlight
|
|
71 ;; (transient-mark-mode 1)
|
|
72 ;;
|
|
73 ;; ;; But only in the selected window
|
|
74 ;; (setq highlight-nonselected-windows nil)
|
41608
|
75 ;;
|
4934
|
76 ;; ;; Enable pending-delete
|
|
77 ;; (delete-selection-mode 1)
|
|
78 ;;
|
8766
|
79 ;; * You can control the way mouse-sel binds its keys by setting the value
|
4934
|
80 ;; of mouse-sel-default-bindings before loading mouse-sel.
|
|
81 ;;
|
|
82 ;; (a) If mouse-sel-default-bindings = t (the default)
|
41608
|
83 ;;
|
11490
|
84 ;; Mouse sets and insert selection
|
4934
|
85 ;; mouse-1 mouse-select
|
|
86 ;; mouse-2 mouse-insert-selection
|
11490
|
87 ;; mouse-3 mouse-extend
|
4934
|
88 ;;
|
|
89 ;; Selection/kill-ring interaction is disabled
|
|
90 ;; interprogram-cut-function = nil
|
|
91 ;; interprogram-paste-function = nil
|
|
92 ;;
|
|
93 ;; (b) If mouse-sel-default-bindings = 'interprogram-cut-paste
|
41608
|
94 ;;
|
4934
|
95 ;; Mouse sets selection, and pastes from kill-ring
|
11490
|
96 ;; mouse-1 mouse-select
|
46403
|
97 ;; mouse-2 mouse-insert-selection
|
11490
|
98 ;; mouse-3 mouse-extend
|
46403
|
99 ;; In this mode, mouse-insert-selection just calls mouse-yank-at-click.
|
41608
|
100 ;;
|
4934
|
101 ;; Selection/kill-ring interaction is retained
|
|
102 ;; interprogram-cut-function = x-select-text
|
|
103 ;; interprogram-paste-function = x-cut-buffer-or-selection-value
|
41608
|
104 ;;
|
4934
|
105 ;; What you lose is the ability to select some text in
|
|
106 ;; delete-selection-mode and yank over the top of it.
|
41608
|
107 ;;
|
4934
|
108 ;; (c) If mouse-sel-default-bindings = nil, no bindings are made.
|
|
109 ;;
|
6228
|
110 ;; * By default, mouse-insert-selection (mouse-2) inserts the selection at
|
|
111 ;; the mouse position. You can tell it to insert at point instead with:
|
|
112 ;;
|
7644
|
113 ;; (setq mouse-yank-at-point t)
|
6228
|
114 ;;
|
4934
|
115 ;; * I like to leave point at the end of the region nearest to where the
|
|
116 ;; mouse was, even though this makes region highlighting mis-leading (the
|
|
117 ;; cursor makes it look like one extra character is selected). You can
|
|
118 ;; disable this behaviour with:
|
|
119 ;;
|
|
120 ;; (setq mouse-sel-leave-point-near-mouse nil)
|
|
121 ;;
|
11490
|
122 ;; * By default, mouse-select cycles the click count after 4 clicks. That
|
|
123 ;; is, clicking mouse-1 five times has the same effect as clicking it
|
|
124 ;; once, clicking six times has the same effect as clicking twice, etc.
|
4934
|
125 ;; Disable this behaviour with:
|
|
126 ;;
|
|
127 ;; (setq mouse-sel-cycle-clicks nil)
|
|
128 ;;
|
11490
|
129 ;; * The variables mouse-sel-{set,get}-selection-function control how the
|
|
130 ;; selection is handled. Under X Windows, these variables default so
|
4934
|
131 ;; that the X primary selection is used. Under other windowing systems,
|
|
132 ;; alternate functions are used, which simply store the selection value
|
|
133 ;; in a variable.
|
|
134 ;;
|
|
135 ;; * You can change the selection highlight face by altering the properties
|
|
136 ;; of mouse-drag-overlay, eg.
|
|
137 ;;
|
|
138 ;; (overlay-put mouse-drag-overlay 'face 'bold)
|
|
139
|
14169
|
140 ;;; Code:
|
4934
|
141
|
|
142 (require 'mouse)
|
|
143 (require 'thingatpt)
|
|
144
|
18784
|
145 (eval-when-compile
|
|
146 (require 'cl))
|
|
147
|
4934
|
148 ;;=== User Variables ======================================================
|
|
149
|
18784
|
150 (defgroup mouse-sel nil
|
|
151 "Mouse selection enhancement."
|
|
152 :group 'mouse)
|
|
153
|
|
154 (defcustom mouse-sel-leave-point-near-mouse t
|
4934
|
155 "*Leave point near last mouse position.
|
11490
|
156 If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end
|
4934
|
157 of the region nearest to where the mouse last was.
|
18784
|
158 If nil, point will always be placed at the beginning of the region."
|
|
159 :type 'boolean
|
|
160 :group 'mouse-sel)
|
|
161
|
|
162 (defcustom mouse-sel-cycle-clicks t
|
|
163 "*If non-nil, \\[mouse-select] cycles the click-counts after 4 clicks."
|
|
164 :type 'boolean
|
|
165 :group 'mouse-sel)
|
|
166
|
|
167 (defcustom mouse-sel-default-bindings t
|
|
168 "*Control mouse bindings."
|
|
169 :type '(choice (const :tag "none" nil)
|
22593
|
170 (const :tag "cut and paste" interprogram-cut-paste)
|
|
171 (other :tag "default bindings" t))
|
18784
|
172 :group 'mouse-sel)
|
|
173
|
46403
|
174 ;;=== Key bindings ========================================================
|
|
175
|
|
176 (defconst mouse-sel-bound-events
|
|
177 '(;; Primary selection bindings.
|
|
178 ;;
|
|
179 ;; Bind keys to `ignore' instead of unsetting them because modes may
|
|
180 ;; bind `down-mouse-1', for instance, without binding `mouse-1'.
|
|
181 ;; If we unset `mouse-1', this leads to a bitch_at_user when the
|
|
182 ;; mouse goes up because no matching binding is found for that.
|
|
183 ([mouse-1] . ignore)
|
|
184 ([drag-mouse-1] . ignore)
|
|
185 ([mouse-3] . ignore)
|
|
186 ([down-mouse-1] . mouse-select)
|
|
187 ([down-mouse-3] . mouse-extend)
|
|
188 ([mouse-2] . mouse-insert-selection)
|
|
189 ;; Secondary selection bindings.
|
|
190 ([M-mouse-1] . ignore)
|
|
191 ([M-drag-mouse-1] . ignore)
|
|
192 ([M-mouse-3] . ignore)
|
|
193 ([M-down-mouse-1] . mouse-select-secondary)
|
|
194 ([M-mouse-2] . mouse-insert-secondary)
|
|
195 ([M-down-mouse-3] . mouse-extend-secondary))
|
|
196 "An alist of events that `mouse-sel-mode' binds.")
|
|
197
|
18784
|
198 ;;=== User Command ========================================================
|
|
199
|
54257
|
200 (defvar mouse-sel-has-been-enabled nil
|
|
201 "Non-nil if Mouse Sel mode has been enabled at least once.")
|
|
202
|
46403
|
203 (defvar mouse-sel-original-bindings nil)
|
|
204 (defvar mouse-sel-original-interprogram-cut-function nil)
|
46406
72f4c4b10835
(mouse-sel-original-interprogram-paste-function): Defvar it.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
205 (defvar mouse-sel-original-interprogram-paste-function nil)
|
46403
|
206
|
18784
|
207 ;;;###autoload
|
46403
|
208 (define-minor-mode mouse-sel-mode
|
18784
|
209 "Toggle Mouse Sel mode.
|
|
210 With prefix ARG, turn Mouse Sel mode on if and only if ARG is positive.
|
|
211 Returns the new status of Mouse Sel mode (non-nil means on).
|
|
212
|
|
213 When Mouse Sel mode is enabled, mouse selection is enhanced in various ways:
|
|
214
|
|
215 - Clicking mouse-1 starts (cancels) selection, dragging extends it.
|
|
216
|
|
217 - Clicking or dragging mouse-3 extends the selection as well.
|
|
218
|
|
219 - Double-clicking on word constituents selects words.
|
|
220 Double-clicking on symbol constituents selects symbols.
|
|
221 Double-clicking on quotes or parentheses selects sexps.
|
|
222 Double-clicking on whitespace selects whitespace.
|
|
223 Triple-clicking selects lines.
|
|
224 Quad-clicking selects paragraphs.
|
|
225
|
|
226 - Selecting sets the region & X primary selection, but does NOT affect
|
46403
|
227 the `kill-ring', nor do the kill-ring functions change the X selection.
|
30691
|
228 Because the mouse handlers set the primary selection directly,
|
46403
|
229 mouse-sel sets the variables `interprogram-cut-function' and
|
|
230 `interprogram-paste-function' to nil.
|
18784
|
231
|
|
232 - Clicking mouse-2 inserts the contents of the primary selection at
|
38897
|
233 the mouse position (or point, if `mouse-yank-at-point' is non-nil).
|
18784
|
234
|
|
235 - Pressing mouse-2 while selecting or extending copies selection
|
|
236 to the kill ring. Pressing mouse-1 or mouse-3 kills it.
|
|
237
|
|
238 - Double-clicking mouse-3 also kills selection.
|
4934
|
239
|
18784
|
240 - M-mouse-1, M-mouse-2 & M-mouse-3 work similarly to mouse-1, mouse-2
|
|
241 & mouse-3, but operate on the X secondary selection rather than the
|
|
242 primary selection and region."
|
46403
|
243 :global t
|
57687
|
244 :group 'mouse-sel
|
46403
|
245 (if mouse-sel-mode
|
|
246 (progn
|
74530
|
247 ;; If mouse-2 has never been done by the user, initialize the
|
|
248 ;; `event-kind' property to ensure that `follow-link' clicks
|
|
249 ;; are interpreted correctly.
|
|
250 (put 'mouse-2 'event-kind 'mouse-click)
|
57781
1d855c5b0242
(mouse-sel-mode): Adjust to new names for x-lost-selection-functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
251 (add-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook)
|
46403
|
252 (when mouse-sel-default-bindings
|
|
253 ;; Save original bindings and replace them with new ones.
|
|
254 (setq mouse-sel-original-bindings
|
|
255 (mapcar (lambda (binding)
|
|
256 (let ((event (car binding)))
|
|
257 (prog1 (cons event (lookup-key global-map event))
|
|
258 (global-set-key event (cdr binding)))))
|
|
259 mouse-sel-bound-events))
|
|
260 ;; Update interprogram functions.
|
|
261 (setq mouse-sel-original-interprogram-cut-function
|
|
262 interprogram-cut-function
|
|
263 mouse-sel-original-interprogram-paste-function
|
54257
|
264 interprogram-paste-function
|
|
265 mouse-sel-has-been-enabled t)
|
46403
|
266 (unless (eq mouse-sel-default-bindings 'interprogram-cut-paste)
|
|
267 (setq interprogram-cut-function nil
|
|
268 interprogram-paste-function nil))))
|
38443
|
269
|
46359
|
270 ;; Restore original bindings
|
57781
1d855c5b0242
(mouse-sel-mode): Adjust to new names for x-lost-selection-functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
271 (remove-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook)
|
46403
|
272 (dolist (binding mouse-sel-original-bindings)
|
|
273 (global-set-key (car binding) (cdr binding)))
|
54258
|
274 ;; Restore the old values of these variables,
|
|
275 ;; only if they were actually saved previously.
|
54257
|
276 (if mouse-sel-has-been-enabled
|
|
277 (setq interprogram-cut-function
|
|
278 mouse-sel-original-interprogram-cut-function
|
|
279 interprogram-paste-function
|
|
280 mouse-sel-original-interprogram-paste-function))))
|
4934
|
281
|
11490
|
282 ;;=== Internal Variables/Constants ========================================
|
|
283
|
41608
|
284 (defvar mouse-sel-primary-thing nil
|
11490
|
285 "Type of PRIMARY selection in current buffer.")
|
|
286 (make-variable-buffer-local 'mouse-sel-primary-thing)
|
|
287
|
41608
|
288 (defvar mouse-sel-secondary-thing nil
|
11490
|
289 "Type of SECONDARY selection in current buffer.")
|
|
290 (make-variable-buffer-local 'mouse-sel-secondary-thing)
|
4934
|
291
|
11490
|
292 ;; Ensure that secondary overlay is defined
|
18784
|
293 (unless (overlayp mouse-secondary-overlay)
|
11490
|
294 (setq mouse-secondary-overlay (make-overlay 1 1))
|
|
295 (overlay-put mouse-secondary-overlay 'face 'secondary-selection))
|
4934
|
296
|
11490
|
297 (defconst mouse-sel-selection-alist
|
|
298 '((PRIMARY mouse-drag-overlay mouse-sel-primary-thing)
|
|
299 (SECONDARY mouse-secondary-overlay mouse-sel-secondary-thing))
|
38897
|
300 "Alist associating selections with variables.
|
|
301 Each element is of the form:
|
4934
|
302
|
11490
|
303 (SELECTION-NAME OVERLAY-SYMBOL SELECTION-THING-SYMBOL)
|
|
304
|
|
305 where SELECTION-NAME = name of selection
|
|
306 OVERLAY-SYMBOL = name of variable containing overlay to use
|
|
307 SELECTION-THING-SYMBOL = name of variable where the current selection
|
|
308 type for this selection should be stored.")
|
41608
|
309
|
18784
|
310 (defvar mouse-sel-set-selection-function
|
|
311 (if (eq mouse-sel-default-bindings 'interprogram-cut-paste)
|
|
312 'x-set-selection
|
|
313 (lambda (selection value)
|
|
314 (if (eq selection 'PRIMARY)
|
|
315 (x-select-text value)
|
|
316 (x-set-selection selection value))))
|
4934
|
317 "Function to call to set selection.
|
11490
|
318 Called with two arguments:
|
|
319
|
|
320 SELECTION, the name of the selection concerned, and
|
16471
|
321 VALUE, the text to store.
|
18784
|
322
|
|
323 This sets the selection as well as the cut buffer for the older applications,
|
|
324 unless `mouse-sel-default-bindings' is `interprogram-cut-paste'.")
|
4934
|
325
|
|
326 (defvar mouse-sel-get-selection-function
|
18784
|
327 (lambda (selection)
|
|
328 (if (eq selection 'PRIMARY)
|
52047
|
329 (or (x-cut-buffer-or-selection-value)
|
|
330 (bound-and-true-p x-last-selected-text)
|
|
331 (bound-and-true-p x-last-selected-text-primary))
|
18784
|
332 (x-get-selection selection)))
|
4934
|
333 "Function to call to get the selection.
|
11490
|
334 Called with one argument:
|
4934
|
335
|
11490
|
336 SELECTION: the name of the selection concerned.")
|
4934
|
337
|
11490
|
338 ;;=== Support/access functions ============================================
|
4934
|
339
|
11490
|
340 (defun mouse-sel-determine-selection-thing (nclicks)
|
|
341 "Determine what `thing' `mouse-sel' should operate on.
|
|
342 The first argument is NCLICKS, is the number of consecutive
|
|
343 mouse clicks at the same position.
|
4934
|
344
|
|
345 Double-clicking on word constituents selects words.
|
|
346 Double-clicking on symbol constituents selects symbols.
|
|
347 Double-clicking on quotes or parentheses selects sexps.
|
|
348 Double-clicking on whitespace selects whitespace.
|
|
349 Triple-clicking selects lines.
|
11490
|
350 Quad-clicking selects paragraphs.
|
4934
|
351
|
11490
|
352 Feel free to re-define this function to support your own desired
|
|
353 multi-click semantics."
|
|
354 (let* ((next-char (char-after (point)))
|
|
355 (char-syntax (if next-char (char-syntax next-char))))
|
41608
|
356 (if mouse-sel-cycle-clicks
|
11490
|
357 (setq nclicks (1+ (% (1- nclicks) 4))))
|
|
358 (cond
|
|
359 ((= nclicks 1) nil)
|
|
360 ((= nclicks 3) 'line)
|
|
361 ((>= nclicks 4) 'paragraph)
|
|
362 ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp)
|
49839
4398c7a41151
(mouse-sel-determine-selection-thing): Fix character constant.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
363 ((memq next-char '(?\s ?\t ?\n)) 'whitespace)
|
11490
|
364 ((eq char-syntax ?_) 'symbol)
|
|
365 ((eq char-syntax ?w) 'word))))
|
|
366
|
|
367 (defun mouse-sel-set-selection (selection value)
|
|
368 "Set the specified SELECTION to VALUE."
|
|
369 (if mouse-sel-set-selection-function
|
|
370 (funcall mouse-sel-set-selection-function selection value)
|
|
371 (put 'mouse-sel-internal-selection selection value)))
|
|
372
|
|
373 (defun mouse-sel-get-selection (selection)
|
|
374 "Get the value of the specified SELECTION."
|
|
375 (if mouse-sel-get-selection-function
|
|
376 (funcall mouse-sel-get-selection-function selection)
|
|
377 (get 'mouse-sel-internal-selection selection)))
|
|
378
|
|
379 (defun mouse-sel-selection-overlay (selection)
|
|
380 "Return overlay corresponding to SELECTION."
|
|
381 (let ((symbol (nth 1 (assoc selection mouse-sel-selection-alist))))
|
|
382 (or symbol (error "No overlay corresponding to %s selection" selection))
|
|
383 (symbol-value symbol)))
|
|
384
|
|
385 (defun mouse-sel-selection-thing (selection)
|
|
386 "Return overlay corresponding to SELECTION."
|
|
387 (let ((symbol (nth 2 (assoc selection mouse-sel-selection-alist))))
|
|
388 (or symbol (error "No symbol corresponding to %s selection" selection))
|
|
389 symbol))
|
|
390
|
|
391 (defun mouse-sel-region-to-primary (orig-window)
|
|
392 "Convert region to PRIMARY overlay and deactivate region.
|
41608
|
393 Argument ORIG-WINDOW specifies the window the cursor was in when the
|
|
394 originating command was issued, and is used to determine whether the
|
11490
|
395 region was visible or not."
|
|
396 (if transient-mark-mode
|
|
397 (let ((overlay (mouse-sel-selection-overlay 'PRIMARY)))
|
|
398 (cond
|
41608
|
399 ((and mark-active
|
|
400 (or highlight-nonselected-windows
|
11490
|
401 (eq orig-window (selected-window))))
|
|
402 ;; Region was visible, so convert region to overlay
|
41608
|
403 (move-overlay overlay (region-beginning) (region-end)
|
11490
|
404 (current-buffer)))
|
|
405 ((eq orig-window (selected-window))
|
|
406 ;; Point was visible, so set overlay at point
|
|
407 (move-overlay overlay (point) (point) (current-buffer)))
|
|
408 (t
|
|
409 ;; Nothing was visible, so remove overlay
|
|
410 (delete-overlay overlay)))
|
|
411 (setq mark-active nil))))
|
|
412
|
|
413 (defun mouse-sel-primary-to-region (&optional direction)
|
|
414 "Convert PRIMARY overlay to region.
|
|
415 Optional argument DIRECTION specifies the mouse drag direction: a value of
|
|
416 1 indicates that the mouse was dragged left-to-right, otherwise it was
|
|
417 dragged right-to-left."
|
|
418 (let* ((overlay (mouse-sel-selection-overlay 'PRIMARY))
|
|
419 (start (overlay-start overlay))
|
|
420 (end (overlay-end overlay)))
|
|
421 (if (eq start end)
|
|
422 (progn
|
|
423 (if start (goto-char start))
|
|
424 (deactivate-mark))
|
|
425 (if (and mouse-sel-leave-point-near-mouse (eq direction 1))
|
|
426 (progn
|
|
427 (goto-char end)
|
|
428 (push-mark start 'nomsg 'active))
|
|
429 (goto-char start)
|
|
430 (push-mark end 'nomsg 'active)))
|
|
431 (if transient-mark-mode (delete-overlay overlay))))
|
|
432
|
|
433 (defmacro mouse-sel-eval-at-event-end (event &rest forms)
|
|
434 "Evaluate forms at mouse position.
|
|
435 Move to the end position of EVENT, execute FORMS, and restore original
|
|
436 point and window."
|
41608
|
437 `(let ((posn (event-end ,event)))
|
|
438 (if posn (mouse-minibuffer-check ,event))
|
|
439 (if (and posn (not (windowp (posn-window posn))))
|
|
440 (error "Cursor not in text area of window"))
|
|
441 (let (orig-window orig-point-marker)
|
|
442 (setq orig-window (selected-window))
|
|
443 (if posn (select-window (posn-window posn)))
|
|
444 (setq orig-point-marker (point-marker))
|
|
445 (if (and posn (numberp (posn-point posn)))
|
|
446 (goto-char (posn-point posn)))
|
|
447 (unwind-protect
|
|
448 (progn
|
|
449 ,@forms)
|
|
450 (goto-char (marker-position orig-point-marker))
|
|
451 (move-marker orig-point-marker nil)
|
|
452 (select-window orig-window)))))
|
11490
|
453
|
|
454 (put 'mouse-sel-eval-at-event-end 'lisp-indent-hook 1)
|
|
455
|
|
456 ;;=== Select ==============================================================
|
|
457
|
|
458 (defun mouse-select (event)
|
|
459 "Set region/selection using the mouse.
|
|
460
|
|
461 Click sets point & mark to click position.
|
|
462 Dragging extends region/selection.
|
|
463
|
41608
|
464 Multi-clicking selects word/lines/paragraphs, as determined by
|
11490
|
465 'mouse-sel-determine-selection-thing.
|
|
466
|
|
467 Clicking mouse-2 while selecting copies selected text to the kill-ring.
|
|
468 Clicking mouse-1 or mouse-3 kills the selected text.
|
4934
|
469
|
|
470 This should be bound to a down-mouse event."
|
11490
|
471 (interactive "@e")
|
62228
|
472 (let (select)
|
11490
|
473 (unwind-protect
|
62228
|
474 (setq select (mouse-select-internal 'PRIMARY event))
|
|
475 (if (and select (listp select))
|
|
476 (push (cons 'mouse-2 (cdr event)) unread-command-events)
|
|
477 (mouse-sel-primary-to-region select)))))
|
11490
|
478
|
|
479 (defun mouse-select-secondary (event)
|
18784
|
480 "Set secondary selection using the mouse.
|
4934
|
481
|
11490
|
482 Click sets the start of the secondary selection to click position.
|
|
483 Dragging extends the secondary selection.
|
4934
|
484
|
41608
|
485 Multi-clicking selects word/lines/paragraphs, as determined by
|
11490
|
486 'mouse-sel-determine-selection-thing.
|
|
487
|
|
488 Clicking mouse-2 while selecting copies selected text to the kill-ring.
|
|
489 Clicking mouse-1 or mouse-3 kills the selected text.
|
4934
|
490
|
|
491 This should be bound to a down-mouse event."
|
18784
|
492 (interactive "e")
|
11490
|
493 (mouse-select-internal 'SECONDARY event))
|
|
494
|
|
495 (defun mouse-select-internal (selection event)
|
62228
|
496 "Set SELECTION using the mouse, with EVENT as the initial down-event.
|
|
497 Normally, this returns the direction in which the selection was
|
|
498 made: a value of 1 indicates that the mouse was dragged
|
|
499 left-to-right, otherwise it was dragged right-to-left.
|
|
500
|
|
501 However, if `mouse-1-click-follows-link' is non-nil and the
|
|
502 subsequent mouse events specify following a link, this returns
|
|
503 the final mouse-event. In that case, the selection is not set."
|
11490
|
504 (mouse-sel-eval-at-event-end event
|
|
505 (let ((thing-symbol (mouse-sel-selection-thing selection))
|
|
506 (overlay (mouse-sel-selection-overlay selection)))
|
|
507 (set thing-symbol
|
|
508 (mouse-sel-determine-selection-thing (event-click-count event)))
|
|
509 (let ((object-bounds (bounds-of-thing-at-point
|
|
510 (symbol-value thing-symbol))))
|
|
511 (if object-bounds
|
|
512 (progn
|
|
513 (move-overlay overlay
|
|
514 (car object-bounds) (cdr object-bounds)
|
|
515 (current-buffer)))
|
|
516 (move-overlay overlay (point) (point) (current-buffer)))))
|
62228
|
517 (catch 'follow-link
|
|
518 (mouse-extend-internal selection event t))))
|
11490
|
519
|
|
520 ;;=== Extend ==============================================================
|
|
521
|
|
522 (defun mouse-extend (event)
|
|
523 "Extend region/selection using the mouse."
|
4934
|
524 (interactive "e")
|
11490
|
525 (let ((orig-window (selected-window))
|
|
526 direction)
|
|
527 (select-window (posn-window (event-end event)))
|
|
528 (unwind-protect
|
|
529 (progn
|
|
530 (mouse-sel-region-to-primary orig-window)
|
|
531 (setq direction (mouse-extend-internal 'PRIMARY event)))
|
|
532 (mouse-sel-primary-to-region direction))))
|
|
533
|
|
534 (defun mouse-extend-secondary (event)
|
|
535 "Extend secondary selection using the mouse."
|
|
536 (interactive "e")
|
|
537 (save-window-excursion
|
|
538 (mouse-extend-internal 'SECONDARY event)))
|
4934
|
539
|
62228
|
540 (defun mouse-extend-internal (selection &optional initial-event no-process)
|
11490
|
541 "Extend specified SELECTION using the mouse.
|
|
542 Track mouse-motion events, adjusting the SELECTION appropriately.
|
62228
|
543 Optional argument INITIAL-EVENT specifies an initial down-mouse event.
|
|
544 Optional argument NO-PROCESS means not to process the initial
|
|
545 event.
|
4934
|
546
|
11490
|
547 See documentation for mouse-select-internal for more details."
|
|
548 (mouse-sel-eval-at-event-end initial-event
|
41608
|
549 (let ((orig-cursor-type
|
11490
|
550 (cdr (assoc 'cursor-type (frame-parameters (selected-frame))))))
|
|
551 (unwind-protect
|
4934
|
552
|
11490
|
553 (let* ((thing-symbol (mouse-sel-selection-thing selection))
|
|
554 (overlay (mouse-sel-selection-overlay selection))
|
|
555 (orig-window (selected-window))
|
|
556 (orig-window-frame (window-frame orig-window))
|
|
557 (top (nth 1 (window-edges orig-window)))
|
|
558 (bottom (nth 3 (window-edges orig-window)))
|
|
559 (mark-active nil) ; inhibit normal region highlight
|
|
560 (echo-keystrokes 0) ; don't echo mouse events
|
|
561 min max
|
|
562 direction
|
|
563 event)
|
4934
|
564
|
11490
|
565 ;; Get current bounds of overlay
|
|
566 (if (eq (overlay-buffer overlay) (current-buffer))
|
|
567 (setq min (overlay-start overlay)
|
|
568 max (overlay-end overlay))
|
|
569 (setq min (point)
|
|
570 max min)
|
|
571 (set thing-symbol nil))
|
41608
|
572
|
11490
|
573
|
|
574 ;; Bar cursor
|
|
575 (if (fboundp 'modify-frame-parameters)
|
|
576 (modify-frame-parameters (selected-frame)
|
|
577 '((cursor-type . bar))))
|
41608
|
578
|
11490
|
579 ;; Handle dragging
|
|
580 (track-mouse
|
41608
|
581
|
62228
|
582 (while (if (and initial-event (not no-process))
|
|
583 ;; Use initial event
|
11490
|
584 (prog1
|
|
585 (setq event initial-event)
|
|
586 (setq initial-event nil))
|
|
587 (setq event (read-event))
|
|
588 (and (consp event)
|
|
589 (memq (car event) '(mouse-movement switch-frame))))
|
41608
|
590
|
11490
|
591 (let ((selection-thing (symbol-value thing-symbol))
|
|
592 (end (event-end event)))
|
41608
|
593
|
11490
|
594 (cond
|
41608
|
595
|
11490
|
596 ;; Ignore any movement outside the frame
|
|
597 ((eq (car-safe event) 'switch-frame) nil)
|
|
598 ((and (posn-window end)
|
|
599 (not (eq (let ((posn-w (posn-window end)))
|
|
600 (if (windowp posn-w)
|
|
601 (window-frame posn-w)
|
|
602 posn-w))
|
|
603 (window-frame orig-window)))) nil)
|
41608
|
604
|
11490
|
605 ;; Different window, same frame
|
|
606 ((not (eq (posn-window end) orig-window))
|
|
607 (let ((end-row (cdr (cdr (mouse-position)))))
|
|
608 (cond
|
|
609 ((and end-row (not (bobp)) (< end-row top))
|
|
610 (mouse-scroll-subr orig-window (- end-row top)
|
|
611 overlay max))
|
|
612 ((and end-row (not (eobp)) (>= end-row bottom))
|
|
613 (mouse-scroll-subr orig-window (1+ (- end-row bottom))
|
|
614 overlay min))
|
|
615 )))
|
41608
|
616
|
11490
|
617 ;; On the mode line
|
|
618 ((eq (posn-point end) 'mode-line)
|
|
619 (mouse-scroll-subr orig-window 1 overlay min))
|
41608
|
620
|
11490
|
621 ;; In original window
|
|
622 (t (goto-char (posn-point end)))
|
41608
|
623
|
11490
|
624 )
|
41608
|
625
|
11490
|
626 ;; Determine direction of drag
|
|
627 (cond
|
|
628 ((and (not direction) (not (eq min max)))
|
|
629 (setq direction (if (< (point) (/ (+ min max) 2)) -1 1)))
|
|
630 ((and (not (eq direction -1)) (<= (point) min))
|
|
631 (setq direction -1))
|
|
632 ((and (not (eq direction 1)) (>= (point) max))
|
|
633 (setq direction 1)))
|
41608
|
634
|
11490
|
635 (if (not selection-thing) nil
|
41608
|
636
|
11490
|
637 ;; If dragging forward, goal is next character
|
|
638 (if (and (eq direction 1) (not (eobp))) (forward-char 1))
|
41608
|
639
|
11490
|
640 ;; Move to start/end of selected thing
|
12592
|
641 (let ((goal (point)))
|
11490
|
642 (goto-char (if (eq 1 direction) min max))
|
|
643 (condition-case nil
|
|
644 (progn
|
|
645 (while (> (* direction (- goal (point))) 0)
|
|
646 (forward-thing selection-thing direction))
|
|
647 (let ((end (point)))
|
|
648 (forward-thing selection-thing (- direction))
|
|
649 (goto-char
|
|
650 (if (> (* direction (- goal (point))) 0)
|
12592
|
651 end (point)))))
|
11490
|
652 (error))))
|
41608
|
653
|
11490
|
654 ;; Move overlay
|
|
655 (move-overlay overlay
|
|
656 (if (eq 1 direction) min (point))
|
|
657 (if (eq -1 direction) max (point))
|
|
658 (current-buffer))
|
41608
|
659
|
11490
|
660 ))) ; end track-mouse
|
4934
|
661
|
62228
|
662 ;; Detect follow-link events
|
|
663 (when (mouse-sel-follow-link-p initial-event event)
|
|
664 (throw 'follow-link event))
|
|
665
|
11490
|
666 ;; Finish up after dragging
|
|
667 (let ((overlay-start (overlay-start overlay))
|
|
668 (overlay-end (overlay-end overlay)))
|
41608
|
669
|
11490
|
670 ;; Set selection
|
|
671 (if (not (eq overlay-start overlay-end))
|
|
672 (mouse-sel-set-selection
|
|
673 selection
|
|
674 (buffer-substring overlay-start overlay-end)))
|
41608
|
675
|
11490
|
676 ;; Handle copy/kill
|
|
677 (let (this-command)
|
4934
|
678 (cond
|
11490
|
679 ((eq (event-basic-type last-input-event) 'mouse-2)
|
|
680 (copy-region-as-kill overlay-start overlay-end)
|
|
681 (read-event) (read-event))
|
|
682 ((and (memq (event-basic-type last-input-event)
|
|
683 '(mouse-1 mouse-3))
|
|
684 (memq 'down (event-modifiers last-input-event)))
|
|
685 (kill-region overlay-start overlay-end)
|
|
686 (move-overlay overlay overlay-start overlay-start)
|
|
687 (read-event) (read-event))
|
|
688 ((and (eq (event-basic-type last-input-event) 'mouse-3)
|
|
689 (memq 'double (event-modifiers last-input-event)))
|
|
690 (kill-region overlay-start overlay-end)
|
|
691 (move-overlay overlay overlay-start overlay-start)))))
|
4934
|
692
|
11490
|
693 direction)
|
4934
|
694
|
11490
|
695 ;; Restore cursor
|
|
696 (if (fboundp 'modify-frame-parameters)
|
41608
|
697 (modify-frame-parameters
|
11490
|
698 (selected-frame) (list (cons 'cursor-type orig-cursor-type))))
|
41608
|
699
|
11490
|
700 ))))
|
4934
|
701
|
62228
|
702 (defun mouse-sel-follow-link-p (initial final)
|
|
703 "Return t if we should follow a link, given INITIAL and FINAL mouse events.
|
|
704 See `mouse-1-click-follows-link' for details. Currently, Mouse
|
|
705 Sel mode does not support using a `double' value to follow links
|
|
706 using double-clicks."
|
|
707 (and initial final mouse-1-click-follows-link
|
|
708 (eq (car initial) 'down-mouse-1)
|
72890
|
709 (mouse-on-link-p (event-start initial))
|
62228
|
710 (= (posn-point (event-start initial))
|
|
711 (posn-point (event-end final)))
|
|
712 (= (event-click-count initial) 1)
|
|
713 (or (not (integerp mouse-1-click-follows-link))
|
|
714 (let ((t0 (posn-timestamp (event-start initial)))
|
|
715 (t1 (posn-timestamp (event-end final))))
|
|
716 (and (integerp t0) (integerp t1)
|
|
717 (if (> mouse-1-click-follows-link 0)
|
|
718 (<= (- t1 t0) mouse-1-click-follows-link)
|
|
719 (< (- t0 t1) mouse-1-click-follows-link)))))))
|
|
720
|
11490
|
721 ;;=== Paste ===============================================================
|
4934
|
722
|
46403
|
723 (defun mouse-insert-selection (event arg)
|
11490
|
724 "Insert the contents of the PRIMARY selection at mouse click.
|
7644
|
725 If `mouse-yank-at-point' is non-nil, insert at point instead."
|
46403
|
726 (interactive "e\nP")
|
|
727 (if (eq mouse-sel-default-bindings 'interprogram-cut-paste)
|
|
728 (mouse-yank-at-click event arg)
|
|
729 (mouse-insert-selection-internal 'PRIMARY event)))
|
11490
|
730
|
|
731 (defun mouse-insert-secondary (event)
|
|
732 "Insert the contents of the SECONDARY selection at mouse click.
|
|
733 If `mouse-yank-at-point' is non-nil, insert at point instead."
|
|
734 (interactive "e")
|
|
735 (mouse-insert-selection-internal 'SECONDARY event))
|
|
736
|
|
737 (defun mouse-insert-selection-internal (selection event)
|
|
738 "Insert the contents of the named SELECTION at mouse click.
|
|
739 If `mouse-yank-at-point' is non-nil, insert at point instead."
|
41608
|
740 (unless mouse-yank-at-point
|
18784
|
741 (mouse-set-point event))
|
|
742 (when mouse-sel-get-selection-function
|
|
743 (push-mark (point) 'nomsg)
|
73272
a5ea274e14ac
(mouse-insert-selection-internal): Use insert-for-yank, so that yank handlers
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
744 (insert-for-yank
|
a5ea274e14ac
(mouse-insert-selection-internal): Use insert-for-yank, so that yank handlers
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
745 (or (funcall mouse-sel-get-selection-function selection) ""))))
|
11490
|
746
|
12592
|
747 ;;=== Handle loss of selections ===========================================
|
4934
|
748
|
12592
|
749 (defun mouse-sel-lost-selection-hook (selection)
|
|
750 "Remove the overlay for a lost selection."
|
13556
|
751 (let ((overlay (mouse-sel-selection-overlay selection)))
|
12592
|
752 (delete-overlay overlay)))
|
4934
|
753
|
18784
|
754 (provide 'mouse-sel)
|
11490
|
755
|
57781
1d855c5b0242
(mouse-sel-mode): Adjust to new names for x-lost-selection-functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
756 ;; arch-tag: 86e6c73f-deaa-48d3-a24e-c565fda1f7d7
|
38436
|
757 ;;; mouse-sel.el ends here
|