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