*** empty log message ***
[bpt/emacs.git] / lisp / mouse-sel.el
CommitLineData
e8af40ee 1;;; mouse-sel.el --- multi-click selection support for Emacs 19
1a2b6c52 2
4bc65152 3;; Copyright (C) 1993,1994,1995,2001,2002 Free Software Foundation, Inc.
1a2b6c52 4
9ae4c925 5;; Author: Mike Williams <mdub@bigfoot.com>
1a2b6c52 6;; Keywords: mouse
1a2b6c52
RS
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
b578f267
EN
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
07b3798c 25;;; Commentary:
b578f267 26
1a2b6c52
RS
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.
f2506826 41;; Quad-clicking selects paragraphs.
1a2b6c52
RS
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;;
f2506826
RS
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).
1a2b6c52 50;;
6a2e3631 51;; * Pressing mouse-2 while selecting or extending copies selection
1a2b6c52 52;; to the kill ring. Pressing mouse-1 or mouse-3 kills it.
8a946354 53;;
6a2e3631 54;; * Double-clicking mouse-3 also kills selection.
8a946354 55;;
f2506826
RS
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.
1a2b6c52 59;;
6a2e3631
RS
60;; This module requires my thingatpt.el module, which it uses to find the
61;; bounds of words, lines, sexps, etc.
1a2b6c52
RS
62;;
63;; Thanks to KevinB@bartley.demon.co.uk for his useful input.
64;;
6a2e3631
RS
65;;--- Customisation -------------------------------------------------------
66;;
67;; * You may want to use none or more of following:
1a2b6c52
RS
68;;
69;; ;; Enable region highlight
70;; (transient-mark-mode 1)
71;;
72;; ;; But only in the selected window
73;; (setq highlight-nonselected-windows nil)
8a946354 74;;
1a2b6c52
RS
75;; ;; Enable pending-delete
76;; (delete-selection-mode 1)
77;;
f77e1e4b 78;; * You can control the way mouse-sel binds its keys by setting the value
1a2b6c52
RS
79;; of mouse-sel-default-bindings before loading mouse-sel.
80;;
81;; (a) If mouse-sel-default-bindings = t (the default)
8a946354 82;;
f2506826 83;; Mouse sets and insert selection
1a2b6c52
RS
84;; mouse-1 mouse-select
85;; mouse-2 mouse-insert-selection
f2506826 86;; mouse-3 mouse-extend
1a2b6c52
RS
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
8a946354 93;;
1a2b6c52 94;; Mouse sets selection, and pastes from kill-ring
f2506826
RS
95;; mouse-1 mouse-select
96;; mouse-2 mouse-yank-at-click
97;; mouse-3 mouse-extend
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
116;; disable this behaviour with:
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.
1a2b6c52
RS
123;; Disable this behaviour with:
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
152(defcustom mouse-sel-mode nil
153 "Toggle Mouse Sel mode.
154When Mouse Sel mode is enabled, mouse selection is enhanced in various ways.
8213ac4b
DL
155Setting this variable directly does not take effect;
156use either \\[customize] or the function `mouse-sel-mode'."
ad3f1e65
SM
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
1a2b6c52 165 "*Leave point near last mouse position.
f2506826 166If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end
1a2b6c52 167of the region nearest to where the mouse last was.
ad3f1e65
SM
168If 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)
21cabb0f
AS
180 (const :tag "cut and paste" interprogram-cut-paste)
181 (other :tag "default bindings" t))
ad3f1e65
SM
182 :group 'mouse-sel)
183
184;;=== User Command ========================================================
185
186;;;###autoload
187(defun mouse-sel-mode (&optional arg)
188 "Toggle Mouse Sel mode.
189With prefix ARG, turn Mouse Sel mode on if and only if ARG is positive.
190Returns the new status of Mouse Sel mode (non-nil means on).
191
192When 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.
199Double-clicking on symbol constituents selects symbols.
200Double-clicking on quotes or parentheses selects sexps.
201Double-clicking on whitespace selects whitespace.
202Triple-clicking selects lines.
203Quad-clicking selects paragraphs.
204
205- Selecting sets the region & X primary selection, but does NOT affect
9eebe311
GM
206the kill-ring, nor do the kill-ring function change the X selection.
207Because the mouse handlers set the primary selection directly,
208mouse-sel sets the variables interprogram-cut-function and
209interprogram-paste-function to nil.
1a2b6c52 210
ad3f1e65 211- Clicking mouse-2 inserts the contents of the primary selection at
f7542b92 212the mouse position (or point, if `mouse-yank-at-point' is non-nil).
1a2b6c52 213
ad3f1e65
SM
214- Pressing mouse-2 while selecting or extending copies selection
215to the kill ring. Pressing mouse-1 or mouse-3 kills it.
216
217- Double-clicking mouse-3 also kills selection.
218
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
221primary 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 ========================================================
233
4bc65152
MW
234(defconst mouse-sel-bound-events
235 '([down-mouse-1] [mouse-1] [drag-mouse-1]
236 [mouse-2]
237 [down-mouse-3] [mouse-3]
238 [M-mouse-2]
239 [M-down-mouse-1] [M-mouse-1] [M-drag-mouse-1]
240 [M-down-mouse-3] [M-mouse-3])
241 "A list of events that mouse-sel binds.")
242
ad3f1e65 243(defun mouse-sel-bindings (bind)
4bc65152
MW
244 (cond
245
246 ;; Default mouse-sel bindings
247 ((and bind mouse-sel-default-bindings)
248
249 ;; Save original bindings
5a95c143
MW
250 (setq mouse-sel-original-bindings nil)
251 (mapc (function
252 (lambda (event)
253 (setq mouse-sel-original-bindings
254 (cons (cons event (lookup-key global-map event))
255 mouse-sel-original-bindings))))
256 mouse-sel-bound-events)
257 (setq mouse-sel-original-interprogram-cut-function
258 interprogram-cut-function
259 mouse-sel-original-interprogram-paste-function
260 interprogram-paste-function)
261
4bc65152
MW
262 ;; Primary selection bindings.
263 ;;
264 ;; Bind keys to `ignore' instead of unsetting them because
265 ;; modes may bind `down-mouse-1', for instance, without
266 ;; binding other `up-mouse-1' or `mouse-1'. If we unset
267 ;; `mouse-1', this leads to a bitch_at_user when the mouse
268 ;; goes up because no matching binding is found for that.
269 (global-set-key [mouse-1] 'ignore)
270 (global-set-key [drag-mouse-1] 'ignore)
271 (global-set-key [mouse-3] 'ignore)
272 (global-set-key [down-mouse-1] 'mouse-select)
273 (unless (eq mouse-sel-default-bindings 'interprogram-cut-paste)
274 (global-set-key [mouse-2] 'mouse-insert-selection)
275 (setq interprogram-cut-function nil
276 interprogram-paste-function nil))
277 (global-set-key [down-mouse-3] 'mouse-extend)
278
279 ;; Secondary selection bindings.
280 (global-set-key [M-mouse-1] 'ignore)
281 (global-set-key [M-drag-mouse-1] 'ignore)
282 (global-set-key [M-mouse-3] 'ignore)
283 (global-set-key [M-down-mouse-1] 'mouse-select-secondary)
284 (global-set-key [M-mouse-2] 'mouse-insert-secondary)
285 (global-set-key [M-down-mouse-3] 'mouse-extend-secondary))
286
287 ((not bind)
288 ;; Restore original bindings
5a95c143
MW
289 (mapc (function
290 (lambda (binding)
291 (if (cdr binding)
292 (global-set-key (car binding) (cdr binding))
293 (global-unset-key (car binding)))))
294 mouse-sel-original-bindings)
295 (setq interprogram-cut-function
296 mouse-sel-original-interprogram-cut-function
297 interprogram-paste-function
298 mouse-sel-original-interprogram-paste-function))
299
4bc65152 300 ))
ad3f1e65
SM
301
302;;=== Command Variable ====================================================
303
304;; This has to come after the function `mouse-sel-mode' and its callee.
305;; An alternative is to put the option `mouse-sel-mode' here and remove its
306;; `:initialize' keyword.
307(when mouse-sel-mode
308 (mouse-sel-mode t))
1a2b6c52 309
f2506826
RS
310;;=== Internal Variables/Constants ========================================
311
8a946354 312(defvar mouse-sel-primary-thing nil
f2506826
RS
313 "Type of PRIMARY selection in current buffer.")
314(make-variable-buffer-local 'mouse-sel-primary-thing)
315
8a946354 316(defvar mouse-sel-secondary-thing nil
f2506826
RS
317 "Type of SECONDARY selection in current buffer.")
318(make-variable-buffer-local 'mouse-sel-secondary-thing)
319
320;; Ensure that secondary overlay is defined
ad3f1e65 321(unless (overlayp mouse-secondary-overlay)
f2506826
RS
322 (setq mouse-secondary-overlay (make-overlay 1 1))
323 (overlay-put mouse-secondary-overlay 'face 'secondary-selection))
1a2b6c52 324
f2506826
RS
325(defconst mouse-sel-selection-alist
326 '((PRIMARY mouse-drag-overlay mouse-sel-primary-thing)
327 (SECONDARY mouse-secondary-overlay mouse-sel-secondary-thing))
f7542b92
SM
328 "Alist associating selections with variables.
329Each element is of the form:
1a2b6c52 330
f2506826 331 (SELECTION-NAME OVERLAY-SYMBOL SELECTION-THING-SYMBOL)
1a2b6c52 332
f2506826
RS
333where SELECTION-NAME = name of selection
334 OVERLAY-SYMBOL = name of variable containing overlay to use
335 SELECTION-THING-SYMBOL = name of variable where the current selection
336 type for this selection should be stored.")
8a946354 337
ad3f1e65
SM
338(defvar mouse-sel-set-selection-function
339 (if (eq mouse-sel-default-bindings 'interprogram-cut-paste)
340 'x-set-selection
341 (lambda (selection value)
342 (if (eq selection 'PRIMARY)
343 (x-select-text value)
344 (x-set-selection selection value))))
1a2b6c52 345 "Function to call to set selection.
f2506826
RS
346Called with two arguments:
347
348 SELECTION, the name of the selection concerned, and
0a6231f5 349 VALUE, the text to store.
ad3f1e65
SM
350
351This sets the selection as well as the cut buffer for the older applications,
352unless `mouse-sel-default-bindings' is `interprogram-cut-paste'.")
1a2b6c52
RS
353
354(defvar mouse-sel-get-selection-function
ad3f1e65
SM
355 (lambda (selection)
356 (if (eq selection 'PRIMARY)
357 (or (x-cut-buffer-or-selection-value) x-last-selected-text)
358 (x-get-selection selection)))
1a2b6c52 359 "Function to call to get the selection.
f2506826 360Called with one argument:
1a2b6c52 361
f2506826
RS
362 SELECTION: the name of the selection concerned.")
363
f2506826
RS
364;;=== Support/access functions ============================================
365
366(defun mouse-sel-determine-selection-thing (nclicks)
367 "Determine what `thing' `mouse-sel' should operate on.
368The first argument is NCLICKS, is the number of consecutive
369mouse clicks at the same position.
370
371Double-clicking on word constituents selects words.
372Double-clicking on symbol constituents selects symbols.
373Double-clicking on quotes or parentheses selects sexps.
374Double-clicking on whitespace selects whitespace.
375Triple-clicking selects lines.
376Quad-clicking selects paragraphs.
377
378Feel free to re-define this function to support your own desired
379multi-click semantics."
1a2b6c52 380 (let* ((next-char (char-after (point)))
f2506826 381 (char-syntax (if next-char (char-syntax next-char))))
8a946354 382 (if mouse-sel-cycle-clicks
f2506826 383 (setq nclicks (1+ (% (1- nclicks) 4))))
1a2b6c52
RS
384 (cond
385 ((= nclicks 1) nil)
f2506826
RS
386 ((= nclicks 3) 'line)
387 ((>= nclicks 4) 'paragraph)
1a2b6c52
RS
388 ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp)
389 ((memq next-char '(? ?\t ?\n)) 'whitespace)
390 ((eq char-syntax ?_) 'symbol)
391 ((eq char-syntax ?w) 'word))))
392
f2506826
RS
393(defun mouse-sel-set-selection (selection value)
394 "Set the specified SELECTION to VALUE."
395 (if mouse-sel-set-selection-function
396 (funcall mouse-sel-set-selection-function selection value)
397 (put 'mouse-sel-internal-selection selection value)))
398
399(defun mouse-sel-get-selection (selection)
400 "Get the value of the specified SELECTION."
401 (if mouse-sel-get-selection-function
402 (funcall mouse-sel-get-selection-function selection)
403 (get 'mouse-sel-internal-selection selection)))
404
f2506826
RS
405(defun mouse-sel-selection-overlay (selection)
406 "Return overlay corresponding to SELECTION."
407 (let ((symbol (nth 1 (assoc selection mouse-sel-selection-alist))))
408 (or symbol (error "No overlay corresponding to %s selection" selection))
409 (symbol-value symbol)))
410
411(defun mouse-sel-selection-thing (selection)
412 "Return overlay corresponding to SELECTION."
413 (let ((symbol (nth 2 (assoc selection mouse-sel-selection-alist))))
414 (or symbol (error "No symbol corresponding to %s selection" selection))
415 symbol))
416
417(defun mouse-sel-region-to-primary (orig-window)
418 "Convert region to PRIMARY overlay and deactivate region.
8a946354
SS
419Argument ORIG-WINDOW specifies the window the cursor was in when the
420originating command was issued, and is used to determine whether the
f2506826
RS
421region was visible or not."
422 (if transient-mark-mode
423 (let ((overlay (mouse-sel-selection-overlay 'PRIMARY)))
424 (cond
8a946354
SS
425 ((and mark-active
426 (or highlight-nonselected-windows
f2506826
RS
427 (eq orig-window (selected-window))))
428 ;; Region was visible, so convert region to overlay
8a946354 429 (move-overlay overlay (region-beginning) (region-end)
f2506826
RS
430 (current-buffer)))
431 ((eq orig-window (selected-window))
432 ;; Point was visible, so set overlay at point
433 (move-overlay overlay (point) (point) (current-buffer)))
434 (t
435 ;; Nothing was visible, so remove overlay
436 (delete-overlay overlay)))
437 (setq mark-active nil))))
438
439(defun mouse-sel-primary-to-region (&optional direction)
440 "Convert PRIMARY overlay to region.
441Optional argument DIRECTION specifies the mouse drag direction: a value of
4421 indicates that the mouse was dragged left-to-right, otherwise it was
443dragged right-to-left."
444 (let* ((overlay (mouse-sel-selection-overlay 'PRIMARY))
445 (start (overlay-start overlay))
446 (end (overlay-end overlay)))
447 (if (eq start end)
448 (progn
449 (if start (goto-char start))
450 (deactivate-mark))
451 (if (and mouse-sel-leave-point-near-mouse (eq direction 1))
452 (progn
453 (goto-char end)
454 (push-mark start 'nomsg 'active))
455 (goto-char start)
456 (push-mark end 'nomsg 'active)))
457 (if transient-mark-mode (delete-overlay overlay))))
458
459(defmacro mouse-sel-eval-at-event-end (event &rest forms)
460 "Evaluate forms at mouse position.
461Move to the end position of EVENT, execute FORMS, and restore original
462point and window."
8a946354
SS
463 `(let ((posn (event-end ,event)))
464 (if posn (mouse-minibuffer-check ,event))
465 (if (and posn (not (windowp (posn-window posn))))
466 (error "Cursor not in text area of window"))
467 (let (orig-window orig-point-marker)
468 (setq orig-window (selected-window))
469 (if posn (select-window (posn-window posn)))
470 (setq orig-point-marker (point-marker))
471 (if (and posn (numberp (posn-point posn)))
472 (goto-char (posn-point posn)))
473 (unwind-protect
474 (progn
475 ,@forms)
476 (goto-char (marker-position orig-point-marker))
477 (move-marker orig-point-marker nil)
478 (select-window orig-window)))))
f2506826
RS
479
480(put 'mouse-sel-eval-at-event-end 'lisp-indent-hook 1)
481
482;;=== Select ==============================================================
483
484(defun mouse-select (event)
1a2b6c52
RS
485 "Set region/selection using the mouse.
486
f2506826 487Click sets point & mark to click position.
1a2b6c52
RS
488Dragging extends region/selection.
489
8a946354 490Multi-clicking selects word/lines/paragraphs, as determined by
f2506826 491'mouse-sel-determine-selection-thing.
1a2b6c52 492
f2506826
RS
493Clicking mouse-2 while selecting copies selected text to the kill-ring.
494Clicking mouse-1 or mouse-3 kills the selected text.
1a2b6c52
RS
495
496This should be bound to a down-mouse event."
f2506826
RS
497 (interactive "@e")
498 (let (direction)
499 (unwind-protect
500 (setq direction (mouse-select-internal 'PRIMARY event))
501 (mouse-sel-primary-to-region direction))))
502
503(defun mouse-select-secondary (event)
ad3f1e65 504 "Set secondary selection using the mouse.
f2506826
RS
505
506Click sets the start of the secondary selection to click position.
507Dragging extends the secondary selection.
1a2b6c52 508
8a946354 509Multi-clicking selects word/lines/paragraphs, as determined by
f2506826 510'mouse-sel-determine-selection-thing.
1a2b6c52 511
f2506826
RS
512Clicking mouse-2 while selecting copies selected text to the kill-ring.
513Clicking mouse-1 or mouse-3 kills the selected text.
1a2b6c52
RS
514
515This should be bound to a down-mouse event."
ad3f1e65 516 (interactive "e")
f2506826
RS
517 (mouse-select-internal 'SECONDARY event))
518
519(defun mouse-select-internal (selection event)
520 "Set SELECTION using the mouse."
521 (mouse-sel-eval-at-event-end event
522 (let ((thing-symbol (mouse-sel-selection-thing selection))
523 (overlay (mouse-sel-selection-overlay selection)))
524 (set thing-symbol
525 (mouse-sel-determine-selection-thing (event-click-count event)))
526 (let ((object-bounds (bounds-of-thing-at-point
527 (symbol-value thing-symbol))))
528 (if object-bounds
529 (progn
530 (move-overlay overlay
531 (car object-bounds) (cdr object-bounds)
532 (current-buffer)))
533 (move-overlay overlay (point) (point) (current-buffer)))))
534 (mouse-extend-internal selection)))
535
536;;=== Extend ==============================================================
537
538(defun mouse-extend (event)
539 "Extend region/selection using the mouse."
1a2b6c52 540 (interactive "e")
f2506826
RS
541 (let ((orig-window (selected-window))
542 direction)
543 (select-window (posn-window (event-end event)))
1a2b6c52 544 (unwind-protect
f2506826
RS
545 (progn
546 (mouse-sel-region-to-primary orig-window)
547 (setq direction (mouse-extend-internal 'PRIMARY event)))
548 (mouse-sel-primary-to-region direction))))
549
550(defun mouse-extend-secondary (event)
551 "Extend secondary selection using the mouse."
552 (interactive "e")
553 (save-window-excursion
554 (mouse-extend-internal 'SECONDARY event)))
555
556(defun mouse-extend-internal (selection &optional initial-event)
557 "Extend specified SELECTION using the mouse.
558Track mouse-motion events, adjusting the SELECTION appropriately.
8a946354
SS
559Optional argument INITIAL-EVENT specifies an initial down-mouse event to
560process.
f2506826
RS
561
562See documentation for mouse-select-internal for more details."
563 (mouse-sel-eval-at-event-end initial-event
8a946354 564 (let ((orig-cursor-type
f2506826
RS
565 (cdr (assoc 'cursor-type (frame-parameters (selected-frame))))))
566 (unwind-protect
567
568 (let* ((thing-symbol (mouse-sel-selection-thing selection))
569 (overlay (mouse-sel-selection-overlay selection))
570 (orig-window (selected-window))
571 (orig-window-frame (window-frame orig-window))
572 (top (nth 1 (window-edges orig-window)))
573 (bottom (nth 3 (window-edges orig-window)))
574 (mark-active nil) ; inhibit normal region highlight
575 (echo-keystrokes 0) ; don't echo mouse events
576 min max
577 direction
578 event)
579
580 ;; Get current bounds of overlay
581 (if (eq (overlay-buffer overlay) (current-buffer))
582 (setq min (overlay-start overlay)
583 max (overlay-end overlay))
584 (setq min (point)
585 max min)
586 (set thing-symbol nil))
8a946354 587
f2506826
RS
588
589 ;; Bar cursor
590 (if (fboundp 'modify-frame-parameters)
591 (modify-frame-parameters (selected-frame)
592 '((cursor-type . bar))))
8a946354 593
f2506826
RS
594 ;; Handle dragging
595 (track-mouse
8a946354 596
f2506826
RS
597 (while (if initial-event ; Use initial event
598 (prog1
599 (setq event initial-event)
600 (setq initial-event nil))
601 (setq event (read-event))
602 (and (consp event)
603 (memq (car event) '(mouse-movement switch-frame))))
8a946354 604
f2506826
RS
605 (let ((selection-thing (symbol-value thing-symbol))
606 (end (event-end event)))
8a946354 607
f2506826 608 (cond
8a946354 609
f2506826
RS
610 ;; Ignore any movement outside the frame
611 ((eq (car-safe event) 'switch-frame) nil)
612 ((and (posn-window end)
613 (not (eq (let ((posn-w (posn-window end)))
614 (if (windowp posn-w)
615 (window-frame posn-w)
616 posn-w))
617 (window-frame orig-window)))) nil)
8a946354 618
f2506826
RS
619 ;; Different window, same frame
620 ((not (eq (posn-window end) orig-window))
621 (let ((end-row (cdr (cdr (mouse-position)))))
622 (cond
623 ((and end-row (not (bobp)) (< end-row top))
624 (mouse-scroll-subr orig-window (- end-row top)
625 overlay max))
626 ((and end-row (not (eobp)) (>= end-row bottom))
627 (mouse-scroll-subr orig-window (1+ (- end-row bottom))
628 overlay min))
629 )))
8a946354 630
f2506826
RS
631 ;; On the mode line
632 ((eq (posn-point end) 'mode-line)
633 (mouse-scroll-subr orig-window 1 overlay min))
8a946354 634
f2506826
RS
635 ;; In original window
636 (t (goto-char (posn-point end)))
8a946354 637
f2506826 638 )
8a946354 639
f2506826
RS
640 ;; Determine direction of drag
641 (cond
642 ((and (not direction) (not (eq min max)))
643 (setq direction (if (< (point) (/ (+ min max) 2)) -1 1)))
644 ((and (not (eq direction -1)) (<= (point) min))
645 (setq direction -1))
646 ((and (not (eq direction 1)) (>= (point) max))
647 (setq direction 1)))
8a946354 648
f2506826 649 (if (not selection-thing) nil
8a946354 650
f2506826
RS
651 ;; If dragging forward, goal is next character
652 (if (and (eq direction 1) (not (eobp))) (forward-char 1))
8a946354 653
f2506826 654 ;; Move to start/end of selected thing
67384793 655 (let ((goal (point)))
f2506826
RS
656 (goto-char (if (eq 1 direction) min max))
657 (condition-case nil
658 (progn
659 (while (> (* direction (- goal (point))) 0)
f2506826
RS
660 (forward-thing selection-thing direction))
661 (let ((end (point)))
662 (forward-thing selection-thing (- direction))
663 (goto-char
664 (if (> (* direction (- goal (point))) 0)
67384793 665 end (point)))))
f2506826 666 (error))))
8a946354 667
f2506826
RS
668 ;; Move overlay
669 (move-overlay overlay
670 (if (eq 1 direction) min (point))
671 (if (eq -1 direction) max (point))
672 (current-buffer))
8a946354 673
f2506826
RS
674 ))) ; end track-mouse
675
676 ;; Finish up after dragging
677 (let ((overlay-start (overlay-start overlay))
678 (overlay-end (overlay-end overlay)))
8a946354 679
f2506826
RS
680 ;; Set selection
681 (if (not (eq overlay-start overlay-end))
682 (mouse-sel-set-selection
683 selection
684 (buffer-substring overlay-start overlay-end)))
8a946354 685
f2506826
RS
686 ;; Handle copy/kill
687 (let (this-command)
688 (cond
689 ((eq (event-basic-type last-input-event) 'mouse-2)
690 (copy-region-as-kill overlay-start overlay-end)
691 (read-event) (read-event))
692 ((and (memq (event-basic-type last-input-event)
693 '(mouse-1 mouse-3))
694 (memq 'down (event-modifiers last-input-event)))
695 (kill-region overlay-start overlay-end)
696 (move-overlay overlay overlay-start overlay-start)
697 (read-event) (read-event))
698 ((and (eq (event-basic-type last-input-event) 'mouse-3)
699 (memq 'double (event-modifiers last-input-event)))
700 (kill-region overlay-start overlay-end)
701 (move-overlay overlay overlay-start overlay-start)))))
702
703 direction)
704
705 ;; Restore cursor
706 (if (fboundp 'modify-frame-parameters)
8a946354 707 (modify-frame-parameters
f2506826 708 (selected-frame) (list (cons 'cursor-type orig-cursor-type))))
8a946354 709
f2506826
RS
710 ))))
711
712;;=== Paste ===============================================================
713
714(defun mouse-insert-selection (event)
715 "Insert the contents of the PRIMARY selection at mouse click.
716If `mouse-yank-at-point' is non-nil, insert at point instead."
717 (interactive "e")
718 (mouse-insert-selection-internal 'PRIMARY event))
719
720(defun mouse-insert-secondary (event)
721 "Insert the contents of the SECONDARY selection at mouse click.
6b4dd332 722If `mouse-yank-at-point' is non-nil, insert at point instead."
1a2b6c52 723 (interactive "e")
f2506826
RS
724 (mouse-insert-selection-internal 'SECONDARY event))
725
726(defun mouse-insert-selection-internal (selection event)
727 "Insert the contents of the named SELECTION at mouse click.
728If `mouse-yank-at-point' is non-nil, insert at point instead."
8a946354 729 (unless mouse-yank-at-point
ad3f1e65
SM
730 (mouse-set-point event))
731 (when mouse-sel-get-selection-function
732 (push-mark (point) 'nomsg)
733 (insert (or (funcall mouse-sel-get-selection-function selection) ""))))
f2506826 734
67384793
RS
735;;=== Handle loss of selections ===========================================
736
737(defun mouse-sel-lost-selection-hook (selection)
738 "Remove the overlay for a lost selection."
7b990caf 739 (let ((overlay (mouse-sel-selection-overlay selection)))
67384793
RS
740 (delete-overlay overlay)))
741
ad3f1e65 742(provide 'mouse-sel)
f2506826 743
e8af40ee 744;;; mouse-sel.el ends here