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