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