Commit | Line | Data |
---|---|---|
1a2b6c52 RS |
1 | ;;; mouse-sel.el --- Multi-click selection support for Emacs 19 |
2 | ||
d733c5ec | 3 | ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. |
1a2b6c52 RS |
4 | |
5 | ;; Author: Mike Williams <mikew@gopher.dosli.govt.nz> | |
6 | ;; Keywords: mouse | |
cd1f32a6 | 7 | ;; Version: 2.1 |
1a2b6c52 RS |
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 | |
13 | ;; the Free Software Foundation; either version 2, or (at your option) | |
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 | ||
07b3798c | 21 | ;;; Commentary: |
1a2b6c52 RS |
22 | ;; |
23 | ;; This module provides multi-click mouse support for GNU Emacs versions | |
24 | ;; 19.18 and later. I've tried to make it behave more like standard X | |
25 | ;; clients (eg. xterm) than the default Emacs 19 mouse selection handlers. | |
26 | ;; Basically: | |
27 | ;; | |
28 | ;; * Clicking mouse-1 starts (cancels) selection, dragging extends it. | |
29 | ;; | |
30 | ;; * Clicking or dragging mouse-3 extends the selection as well. | |
31 | ;; | |
32 | ;; * Double-clicking on word constituents selects words. | |
33 | ;; Double-clicking on symbol constituents selects symbols. | |
34 | ;; Double-clicking on quotes or parentheses selects sexps. | |
35 | ;; Double-clicking on whitespace selects whitespace. | |
36 | ;; Triple-clicking selects lines. | |
37 | ;; | |
38 | ;; * Selecting sets the region & X primary selection, but does NOT affect | |
39 | ;; the kill-ring. Because the mouse handlers set the primary selection | |
40 | ;; directly, mouse-sel sets the variables interprogram-cut-function | |
41 | ;; and interprogram-paste-function to nil. | |
42 | ;; | |
cd1f32a6 RS |
43 | ;; * Clicking mouse-2 pastes contents of primary selection at the mouse |
44 | ;; position. | |
1a2b6c52 | 45 | ;; |
6a2e3631 | 46 | ;; * Pressing mouse-2 while selecting or extending copies selection |
1a2b6c52 | 47 | ;; to the kill ring. Pressing mouse-1 or mouse-3 kills it. |
6a2e3631 RS |
48 | ;; |
49 | ;; * Double-clicking mouse-3 also kills selection. | |
1a2b6c52 | 50 | ;; |
6a2e3631 RS |
51 | ;; This module requires my thingatpt.el module, which it uses to find the |
52 | ;; bounds of words, lines, sexps, etc. | |
1a2b6c52 RS |
53 | ;; |
54 | ;; Thanks to KevinB@bartley.demon.co.uk for his useful input. | |
55 | ;; | |
6a2e3631 RS |
56 | ;;--- Customisation ------------------------------------------------------- |
57 | ;; | |
58 | ;; * You may want to use none or more of following: | |
1a2b6c52 RS |
59 | ;; |
60 | ;; ;; Enable region highlight | |
61 | ;; (transient-mark-mode 1) | |
62 | ;; | |
63 | ;; ;; But only in the selected window | |
64 | ;; (setq highlight-nonselected-windows nil) | |
65 | ;; | |
66 | ;; ;; Enable pending-delete | |
67 | ;; (delete-selection-mode 1) | |
68 | ;; | |
f77e1e4b | 69 | ;; * You can control the way mouse-sel binds its keys by setting the value |
1a2b6c52 RS |
70 | ;; of mouse-sel-default-bindings before loading mouse-sel. |
71 | ;; | |
72 | ;; (a) If mouse-sel-default-bindings = t (the default) | |
73 | ;; | |
74 | ;; Mouse sets and pastes selection | |
75 | ;; mouse-1 mouse-select | |
76 | ;; mouse-2 mouse-insert-selection | |
77 | ;; mouse-3 mouse-extend | |
78 | ;; | |
79 | ;; Selection/kill-ring interaction is disabled | |
80 | ;; interprogram-cut-function = nil | |
81 | ;; interprogram-paste-function = nil | |
82 | ;; | |
83 | ;; (b) If mouse-sel-default-bindings = 'interprogram-cut-paste | |
84 | ;; | |
85 | ;; Mouse sets selection, and pastes from kill-ring | |
86 | ;; mouse-1 mouse-select | |
87 | ;; mouse-2 mouse-yank-at-click | |
88 | ;; mouse-3 mouse-extend | |
89 | ;; | |
90 | ;; Selection/kill-ring interaction is retained | |
91 | ;; interprogram-cut-function = x-select-text | |
92 | ;; interprogram-paste-function = x-cut-buffer-or-selection-value | |
93 | ;; | |
94 | ;; What you lose is the ability to select some text in | |
95 | ;; delete-selection-mode and yank over the top of it. | |
96 | ;; | |
97 | ;; (c) If mouse-sel-default-bindings = nil, no bindings are made. | |
98 | ;; | |
cd1f32a6 RS |
99 | ;; * By default, mouse-insert-selection (mouse-2) inserts the selection at |
100 | ;; the mouse position. You can tell it to insert at point instead with: | |
101 | ;; | |
6b4dd332 | 102 | ;; (setq mouse-yank-at-point t) |
cd1f32a6 | 103 | ;; |
1a2b6c52 RS |
104 | ;; * I like to leave point at the end of the region nearest to where the |
105 | ;; mouse was, even though this makes region highlighting mis-leading (the | |
106 | ;; cursor makes it look like one extra character is selected). You can | |
107 | ;; disable this behaviour with: | |
108 | ;; | |
109 | ;; (setq mouse-sel-leave-point-near-mouse nil) | |
110 | ;; | |
111 | ;; * Normally, the selection highlight will be removed when the mouse is | |
112 | ;; lifted. You can tell mouse-sel to retain the selection highlight | |
113 | ;; (useful if you don't use transient-mark-mode) with: | |
114 | ;; | |
115 | ;; (setq mouse-sel-retain-highlight t) | |
116 | ;; | |
117 | ;; * By default, mouse-select cycles the click count after 3 clicks. That | |
118 | ;; is, clicking mouse-1 four times has the same effect as clicking it | |
119 | ;; once, clicking five times has the same effect as clicking twice, etc. | |
120 | ;; Disable this behaviour with: | |
121 | ;; | |
122 | ;; (setq mouse-sel-cycle-clicks nil) | |
123 | ;; | |
124 | ;; * The variables mouse-sel-{set,get,check}-selection-function control how | |
125 | ;; the selection is handled. Under X Windows, these variables default so | |
126 | ;; that the X primary selection is used. Under other windowing systems, | |
127 | ;; alternate functions are used, which simply store the selection value | |
128 | ;; in a variable. | |
129 | ;; | |
130 | ;;--- Hints --------------------------------------------------------------- | |
131 | ;; | |
132 | ;; * You can change the selection highlight face by altering the properties | |
133 | ;; of mouse-drag-overlay, eg. | |
134 | ;; | |
135 | ;; (overlay-put mouse-drag-overlay 'face 'bold) | |
136 | ;; | |
137 | ;; * Pasting from the primary selection under emacs 19.19 is SLOW (there's | |
138 | ;; a two second delay). The following code will cause mouse-sel to use | |
139 | ;; the cut buffer rather than the primary selection. However, be aware | |
140 | ;; that cut buffers are OBSOLETE, and some X applications may not support | |
141 | ;; them. | |
142 | ;; | |
143 | ;; (setq mouse-sel-set-selection-function 'x-select-text | |
144 | ;; mouse-sel-get-selection-function 'x-get-cut-buffer) | |
145 | ;; | |
146 | ;;--- Warnings ------------------------------------------------------------ | |
147 | ;; | |
148 | ;; * When selecting sexps, the selection extends by sexps at the same | |
149 | ;; nesting level. This also means the selection cannot be extended out | |
150 | ;; of the enclosing nesting level. This is INTENTIONAL. | |
151 | ||
6a2e3631 | 152 | ;;; Code: ================================================================= |
1a2b6c52 RS |
153 | |
154 | (provide 'mouse-sel) | |
155 | ||
156 | (require 'mouse) | |
157 | (require 'thingatpt) | |
158 | ||
159 | ;;=== Version ============================================================= | |
160 | ||
cd1f32a6 | 161 | (defconst mouse-sel-version "2.1" |
6a2e3631 | 162 | "The version number of mouse-sel (as string).") |
1a2b6c52 RS |
163 | |
164 | ;;=== User Variables ====================================================== | |
165 | ||
166 | (defvar mouse-sel-leave-point-near-mouse t | |
167 | "*Leave point near last mouse position. | |
72e2e0c3 | 168 | If non-nil, \\[mouse-select] and \\[mouse-extend] leave point at the end |
1a2b6c52 | 169 | of the region nearest to where the mouse last was. |
72e2e0c3 | 170 | If nil, point is always placed at the beginning of the region.") |
1a2b6c52 RS |
171 | |
172 | (defvar mouse-sel-retain-highlight nil | |
72e2e0c3 | 173 | "*Retain highlight after dragging is finished. |
1a2b6c52 RS |
174 | If non-nil, regions selected using \\[mouse-select] and \\[mouse-extend] will |
175 | remain highlighted. | |
72e2e0c3 | 176 | If nil, highlighting turns off when you release the mouse button.") |
1a2b6c52 RS |
177 | |
178 | (defvar mouse-sel-cycle-clicks t | |
179 | "*If non-nil, \\[mouse-select] cycles the click-counts after 3 clicks. | |
180 | Ie. 4 clicks = 1 click, 5 clicks = 2 clicks, etc.") | |
181 | ||
182 | (defvar mouse-sel-default-bindings t | |
cd1f32a6 | 183 | "Set to nil before loading `mouse-sel' to prevent default mouse bindings.") |
1a2b6c52 RS |
184 | |
185 | ;;=== Selection =========================================================== | |
186 | ||
187 | (defvar mouse-sel-selection-type nil "Type of current selection") | |
188 | (make-variable-buffer-local 'mouse-sel-selection-type) | |
189 | ||
190 | (defvar mouse-sel-selection "" | |
cd1f32a6 | 191 | "Store the selection value when using a window systems other than X.") |
1a2b6c52 RS |
192 | |
193 | (defvar mouse-sel-set-selection-function | |
6a2e3631 | 194 | (if (fboundp 'x-set-selection) |
1a2b6c52 RS |
195 | (function (lambda (s) (x-set-selection 'PRIMARY s))) |
196 | (function (lambda (s) (setq mouse-sel-selection s)))) | |
197 | "Function to call to set selection. | |
198 | Called with one argument, the text to select.") | |
199 | ||
200 | (defvar mouse-sel-get-selection-function | |
6a2e3631 | 201 | (if (fboundp 'x-get-selection) |
1a2b6c52 RS |
202 | 'x-get-selection |
203 | (function (lambda () mouse-sel-selection))) | |
204 | "Function to call to get the selection. | |
6a2e3631 | 205 | Called with no argument.") |
1a2b6c52 RS |
206 | |
207 | (defvar mouse-sel-check-selection-function | |
6a2e3631 | 208 | (if (fboundp 'x-selection-owner-p) |
1a2b6c52 RS |
209 | 'x-selection-owner-p |
210 | nil) | |
72e2e0c3 | 211 | "Function to check whether Emacs still owns the selection. |
1a2b6c52 RS |
212 | Called with no arguments.") |
213 | ||
214 | (defun mouse-sel-determine-selection-type (NCLICKS) | |
72e2e0c3 RS |
215 | "Determine what \"thing\" `mouse-sel' should operate on. |
216 | The first argument, NCLICKS, is the number of consecutive | |
1a2b6c52 RS |
217 | mouse clicks at the same position." |
218 | (let* ((next-char (char-after (point))) | |
219 | (char-syntax (if next-char (char-syntax next-char))) | |
220 | (nclicks (if mouse-sel-cycle-clicks (1+ (% (1- NCLICKS) 3)) NCLICKS))) | |
221 | (cond | |
222 | ((= nclicks 1) nil) | |
223 | ((>= nclicks 3) 'line) | |
224 | ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp) | |
225 | ((memq next-char '(? ?\t ?\n)) 'whitespace) | |
226 | ((eq char-syntax ?_) 'symbol) | |
227 | ((eq char-syntax ?w) 'word)))) | |
228 | ||
229 | (defun mouse-select (EVENT) | |
230 | "Set region/selection using the mouse. | |
231 | ||
72e2e0c3 RS |
232 | Clicking sets point to click position, and deactivates the mark |
233 | if you are in Transient Mark mode. | |
1a2b6c52 RS |
234 | Dragging extends region/selection. |
235 | ||
236 | Double-clicking on word constituents selects words. | |
237 | Double-clicking on symbol constituents selects symbols. | |
238 | Double-clicking on quotes or parentheses selects sexps. | |
239 | Double-clicking on whitespace selects whitespace. | |
240 | Triple-clicking selects lines. | |
241 | ||
242 | Clicking mouse-2 while selecting copies the region to the kill-ring. | |
243 | Clicking mouse-1 or mouse-3 kills the region. | |
244 | ||
245 | This should be bound to a down-mouse event." | |
246 | (interactive "e") | |
247 | (mouse-set-point EVENT) | |
248 | (setq mouse-sel-selection-type | |
249 | (mouse-sel-determine-selection-type (event-click-count EVENT))) | |
250 | (let ((object-bounds (bounds-of-thing-at-point mouse-sel-selection-type))) | |
251 | (if object-bounds | |
252 | (progn | |
253 | (setq mark-active t) | |
254 | (goto-char (car object-bounds)) | |
255 | (set-mark (cdr object-bounds))) | |
256 | (deactivate-mark))) | |
b7691853 | 257 | (mouse-extend (if mouse-sel-selection-type EVENT))) |
1a2b6c52 RS |
258 | |
259 | (defun mouse-extend (&optional EVENT) | |
260 | "Extend region/selection using the mouse. | |
261 | ||
262 | See documentation for mouse-select for more details. | |
263 | ||
264 | This should be bound to a down-mouse event." | |
265 | (interactive "e") | |
266 | (if EVENT (select-window (posn-window (event-end EVENT)))) | |
c89c189e RS |
267 | (let* ((use-region (and (or EVENT transient-mark-mode) mark-active)) |
268 | (min (if use-region (region-beginning) (point))) | |
269 | (max (if use-region (region-end) (point))) | |
1a2b6c52 RS |
270 | (orig-window (selected-window)) |
271 | (orig-window-frame (window-frame orig-window)) | |
272 | (top (nth 1 (window-edges orig-window))) | |
273 | (bottom (nth 3 (window-edges orig-window))) | |
274 | (orig-cursor-type | |
275 | (cdr (assoc 'cursor-type (frame-parameters (selected-frame))))) | |
276 | direction | |
277 | event) | |
278 | ||
279 | ;; Inhibit normal region highlight | |
280 | (setq mark-active nil) | |
281 | ||
282 | ;; Highlight region (forcing re-highlight) | |
283 | (move-overlay mouse-drag-overlay min max (current-buffer)) | |
284 | (overlay-put mouse-drag-overlay 'face | |
285 | (overlay-get mouse-drag-overlay 'face)) | |
286 | ||
287 | ;; Bar cursor | |
6a2e3631 RS |
288 | (if (fboundp 'modify-frame-parameters) |
289 | (modify-frame-parameters (selected-frame) '((cursor-type . bar)))) | |
1a2b6c52 RS |
290 | |
291 | ;; Handle dragging | |
292 | (unwind-protect | |
293 | (progn | |
294 | (track-mouse | |
295 | ||
296 | (while (if EVENT ; Use initial event | |
297 | (prog1 | |
298 | (setq event EVENT) | |
299 | (setq EVENT nil)) | |
300 | (setq event (read-event)) | |
301 | (and (consp event) | |
302 | (memq (car event) '(mouse-movement switch-frame)))) | |
303 | ||
304 | (let ((end (event-end event))) | |
305 | ||
306 | (cond | |
307 | ||
308 | ;; Ignore any movement outside the frame | |
309 | ((eq (car-safe event) 'switch-frame) nil) | |
310 | ((and (posn-window end) | |
aa718a1f RS |
311 | (not (eq (let ((posn-w (posn-window end))) |
312 | (if (windowp posn-w) | |
313 | (window-frame posn-w) | |
314 | posn-w)) | |
1a2b6c52 RS |
315 | (window-frame orig-window)))) nil) |
316 | ||
317 | ;; Different window, same frame | |
318 | ((not (eq (posn-window end) orig-window)) | |
319 | (let ((end-row (cdr (cdr (mouse-position))))) | |
320 | (cond | |
321 | ((and end-row (not (bobp)) (< end-row top)) | |
d43fe049 | 322 | (mouse-scroll-subr orig-window (- end-row top) |
1a2b6c52 RS |
323 | mouse-drag-overlay max)) |
324 | ((and end-row (not (eobp)) (>= end-row bottom)) | |
d43fe049 | 325 | (mouse-scroll-subr orig-window (1+ (- end-row bottom)) |
1a2b6c52 RS |
326 | mouse-drag-overlay min)) |
327 | ))) | |
328 | ||
329 | ;; On the mode line | |
330 | ((eq (posn-point end) 'mode-line) | |
d43fe049 | 331 | (mouse-scroll-subr orig-window 1 mouse-drag-overlay min)) |
1a2b6c52 RS |
332 | |
333 | ;; In original window | |
334 | (t (goto-char (posn-point end))) | |
335 | ||
336 | ) | |
1a2b6c52 RS |
337 | ;; Determine direction of drag |
338 | (cond | |
339 | ((and (not direction) (not (eq min max))) | |
340 | (setq direction (if (< (point) (/ (+ min max) 2)) -1 1))) | |
341 | ((and (not (eq direction -1)) (<= (point) min)) | |
342 | (setq direction -1)) | |
343 | ((and (not (eq direction 1)) (>= (point) max)) | |
344 | (setq direction 1))) | |
345 | ||
346 | (if (not mouse-sel-selection-type) nil | |
347 | ||
348 | ;; If dragging forward, goal is next character | |
349 | (if (and (eq direction 1) (not (eobp))) (forward-char 1)) | |
350 | ||
351 | ;; Move to start/end of selected thing | |
352 | (let ((goal (point)) | |
353 | last) | |
354 | (goto-char (if (eq 1 direction) min max)) | |
355 | (condition-case nil | |
356 | (progn | |
357 | (while (> (* direction (- goal (point))) 0) | |
358 | (setq last (point)) | |
359 | (forward-thing mouse-sel-selection-type | |
360 | direction)) | |
361 | (let ((end (point))) | |
362 | (forward-thing mouse-sel-selection-type | |
363 | (- direction)) | |
364 | (goto-char | |
365 | (if (> (* direction (- goal (point))) 0) | |
366 | end last)))) | |
367 | (error)))) | |
368 | ||
369 | ;; Move overlay | |
370 | (move-overlay mouse-drag-overlay | |
371 | (if (eq 1 direction) min (point)) | |
372 | (if (eq -1 direction) max (point)) | |
373 | (current-buffer)) | |
374 | ||
375 | ))) ; end track-mouse | |
376 | ||
377 | (let ((overlay-start (overlay-start mouse-drag-overlay)) | |
378 | (overlay-end (overlay-end mouse-drag-overlay))) | |
379 | ||
380 | ;; Set region | |
381 | (if (eq overlay-start overlay-end) | |
382 | (deactivate-mark) | |
383 | (if (and mouse-sel-leave-point-near-mouse (eq direction 1)) | |
384 | (progn | |
385 | (set-mark overlay-start) | |
386 | (goto-char overlay-end)) | |
387 | (set-mark overlay-end) | |
388 | (goto-char overlay-start))) | |
389 | ||
390 | ;; Set selection | |
391 | (if (and mark-active mouse-sel-set-selection-function) | |
392 | (funcall mouse-sel-set-selection-function | |
393 | (buffer-substring overlay-start overlay-end))) | |
394 | ||
395 | ;; Handle copy/kill | |
396 | (cond | |
397 | ((eq (car-safe last-input-event) 'down-mouse-2) | |
398 | (copy-region-as-kill overlay-start overlay-end) | |
399 | (read-event) (read-event)) | |
400 | ((memq (car-safe last-input-event) '(down-mouse-1 down-mouse-3)) | |
401 | (kill-region overlay-start overlay-end) | |
402 | (deactivate-mark) | |
6a2e3631 RS |
403 | (read-event) (read-event)) |
404 | ((eq (car-safe last-input-event) 'double-mouse-3) | |
405 | (kill-region overlay-start overlay-end) | |
406 | (deactivate-mark))))) | |
1a2b6c52 RS |
407 | |
408 | ;; Restore cursor | |
6a2e3631 RS |
409 | (if (fboundp 'modify-frame-parameters) |
410 | (modify-frame-parameters | |
411 | (selected-frame) (list (cons 'cursor-type orig-cursor-type)))) | |
412 | ||
1a2b6c52 RS |
413 | ;; Remove overlay |
414 | (or mouse-sel-retain-highlight | |
415 | (delete-overlay mouse-drag-overlay))))) | |
416 | ||
417 | (defun mouse-insert-selection (click) | |
cd1f32a6 | 418 | "Insert the contents of the selection at mouse click. |
6b4dd332 | 419 | If `mouse-yank-at-point' is non-nil, insert at point instead." |
1a2b6c52 | 420 | (interactive "e") |
6b4dd332 | 421 | (or mouse-yank-at-point |
cd1f32a6 | 422 | (mouse-set-point click)) |
1a2b6c52 RS |
423 | (deactivate-mark) |
424 | (if mouse-sel-get-selection-function | |
425 | (insert (or (funcall mouse-sel-get-selection-function) "")))) | |
426 | ||
427 | (defun mouse-sel-validate-selection () | |
428 | "Remove selection highlight if emacs no longer owns the primary selection." | |
429 | (or (not mouse-sel-check-selection-function) | |
430 | (funcall mouse-sel-check-selection-function) | |
431 | (delete-overlay mouse-drag-overlay))) | |
432 | ||
433 | (add-hook 'pre-command-hook 'mouse-sel-validate-selection) | |
434 | ||
435 | ;;=== Key bindings ======================================================== | |
436 | ||
437 | (if (not mouse-sel-default-bindings) nil | |
438 | ||
439 | (global-unset-key [mouse-1]) | |
440 | (global-unset-key [drag-mouse-1]) | |
441 | (global-unset-key [mouse-3]) | |
442 | ||
443 | (global-set-key [down-mouse-1] 'mouse-select) | |
444 | (global-set-key [down-mouse-3] 'mouse-extend) | |
445 | ||
446 | (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) nil | |
447 | ||
448 | (global-set-key [mouse-2] 'mouse-insert-selection) | |
449 | (setq interprogram-cut-function nil | |
450 | interprogram-paste-function nil)) | |
451 | ||
452 | ) | |
453 | ||
454 | ;; mouse-sel.el ends here. |