1 ;;; mouse-sel.el --- Multi-click selection support for Emacs 19
3 ;; Copyright (C) 1993 Free Software Foundation, Inc.
5 ;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
7 ;; Version: $Revision: 1.20 $
9 ;; This file is part of GNU Emacs.
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)
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.
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.
28 ;; * Clicking mouse-1 starts (cancels) selection, dragging extends it.
30 ;; * Clicking or dragging mouse-3 extends the selection as well.
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.
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.
43 ;; * Clicking mouse-2 pastes contents of primary selection.
45 ;; * Pressing mouse-2 while selecting or extending copies selected text
46 ;; to the kill ring. Pressing mouse-1 or mouse-3 kills it.
48 ;; This module requires my thingatpt.el module, version 1.14 or later, which
49 ;; it uses to find the bounds of words, lines, sexps, etc.
51 ;; Thanks to KevinB@bartley.demon.co.uk for his useful input.
53 ;; You may also want to use one or more of following:
55 ;; ;; Enable region highlight
56 ;; (transient-mark-mode 1)
58 ;; ;; But only in the selected window
59 ;; (setq highlight-nonselected-windows nil)
61 ;; ;; Enable pending-delete
62 ;; (delete-selection-mode 1)
64 ;;--- Customisation -------------------------------------------------------
66 ;; * You can control the way mouse-sel binds it's keys by setting the value
67 ;; of mouse-sel-default-bindings before loading mouse-sel.
69 ;; (a) If mouse-sel-default-bindings = t (the default)
71 ;; Mouse sets and pastes selection
72 ;; mouse-1 mouse-select
73 ;; mouse-2 mouse-insert-selection
74 ;; mouse-3 mouse-extend
76 ;; Selection/kill-ring interaction is disabled
77 ;; interprogram-cut-function = nil
78 ;; interprogram-paste-function = nil
80 ;; (b) If mouse-sel-default-bindings = 'interprogram-cut-paste
82 ;; Mouse sets selection, and pastes from kill-ring
83 ;; mouse-1 mouse-select
84 ;; mouse-2 mouse-yank-at-click
85 ;; mouse-3 mouse-extend
87 ;; Selection/kill-ring interaction is retained
88 ;; interprogram-cut-function = x-select-text
89 ;; interprogram-paste-function = x-cut-buffer-or-selection-value
91 ;; What you lose is the ability to select some text in
92 ;; delete-selection-mode and yank over the top of it.
94 ;; (c) If mouse-sel-default-bindings = nil, no bindings are made.
96 ;; * I like to leave point at the end of the region nearest to where the
97 ;; mouse was, even though this makes region highlighting mis-leading (the
98 ;; cursor makes it look like one extra character is selected). You can
99 ;; disable this behaviour with:
101 ;; (setq mouse-sel-leave-point-near-mouse nil)
103 ;; * Normally, the selection highlight will be removed when the mouse is
104 ;; lifted. You can tell mouse-sel to retain the selection highlight
105 ;; (useful if you don't use transient-mark-mode) with:
107 ;; (setq mouse-sel-retain-highlight t)
109 ;; * By default, mouse-select cycles the click count after 3 clicks. That
110 ;; is, clicking mouse-1 four times has the same effect as clicking it
111 ;; once, clicking five times has the same effect as clicking twice, etc.
112 ;; Disable this behaviour with:
114 ;; (setq mouse-sel-cycle-clicks nil)
116 ;; * The variables mouse-sel-{set,get,check}-selection-function control how
117 ;; the selection is handled. Under X Windows, these variables default so
118 ;; that the X primary selection is used. Under other windowing systems,
119 ;; alternate functions are used, which simply store the selection value
122 ;;--- Hints ---------------------------------------------------------------
124 ;; * You can change the selection highlight face by altering the properties
125 ;; of mouse-drag-overlay, eg.
127 ;; (overlay-put mouse-drag-overlay 'face 'bold)
129 ;; * Pasting from the primary selection under emacs 19.19 is SLOW (there's
130 ;; a two second delay). The following code will cause mouse-sel to use
131 ;; the cut buffer rather than the primary selection. However, be aware
132 ;; that cut buffers are OBSOLETE, and some X applications may not support
135 ;; (setq mouse-sel-set-selection-function 'x-select-text
136 ;; mouse-sel-get-selection-function 'x-get-cut-buffer)
138 ;;--- Warnings ------------------------------------------------------------
140 ;; * When selecting sexps, the selection extends by sexps at the same
141 ;; nesting level. This also means the selection cannot be extended out
142 ;; of the enclosing nesting level. This is INTENTIONAL.
151 ;;=== Version =============================================================
153 (defconst mouse-sel-version (substring "$Revision: 1.20 $" 11 -2)
154 "The revision number of mouse-sel (as string). The complete RCS id is:
156 $Id: mouse-sel.el,v 1.20 1993/09/30 23:57:32 mike Exp $")
158 ;;=== User Variables ======================================================
160 (defvar mouse-sel-leave-point-near-mouse t
161 "*Leave point near last mouse position.
162 If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end
163 of the region nearest to where the mouse last was.
164 If nil, point will always be placed at the beginning of the region.")
166 (defvar mouse-sel-retain-highlight nil
167 "*Retain highlight on mouse-drag-overlay.
168 If non-nil, regions selected using \\[mouse-select] and \\[mouse-extend] will
170 If nil, highlighting will be turned off when the mouse is lifted.")
172 (defvar mouse-sel-cycle-clicks t
173 "*If non-nil, \\[mouse-select] cycles the click-counts after 3 clicks.
174 Ie. 4 clicks = 1 click, 5 clicks = 2 clicks, etc.")
176 (defvar mouse-sel-default-bindings t
177 "Set to nil before loading mouse-sel to prevent default mouse bindings.")
179 ;;=== Selection ===========================================================
181 (defvar mouse-sel-selection-type nil "Type of current selection")
182 (make-variable-buffer-local 'mouse-sel-selection-type)
184 (defvar mouse-sel-selection ""
185 "This variable is used to store the selection value when mouse-sel is
186 used on windowing systems other than X Windows.")
188 (defvar mouse-sel-set-selection-function
189 (if (eq window-system 'x)
190 (function (lambda (s) (x-set-selection 'PRIMARY s)))
191 (function (lambda (s) (setq mouse-sel-selection s))))
192 "Function to call to set selection.
193 Called with one argument, the text to select.")
195 (defvar mouse-sel-get-selection-function
196 (if (eq window-system 'x)
198 (function (lambda () mouse-sel-selection)))
199 "Function to call to get the selection.
200 Called with no argument, it should return the selected text.")
202 (defvar mouse-sel-check-selection-function
203 (if (eq window-system 'x)
206 "Function to check whether emacs still owns the selection.
207 Called with no arguments.")
209 (defun mouse-sel-determine-selection-type (NCLICKS)
210 "Determine what `thing' \\[mouse-select] and \\[mouse-extend] should
211 select by. The first argument is NCLICKS, is the number of consecutive
212 mouse clicks at the same position."
213 (let* ((next-char (char-after (point)))
214 (char-syntax (if next-char (char-syntax next-char)))
215 (nclicks (if mouse-sel-cycle-clicks (1+ (% (1- NCLICKS) 3)) NCLICKS)))
218 ((>= nclicks 3) 'line)
219 ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp)
220 ((memq next-char '(? ?\t ?\n)) 'whitespace)
221 ((eq char-syntax ?_) 'symbol)
222 ((eq char-syntax ?w) 'word))))
224 (defun mouse-select (EVENT)
225 "Set region/selection using the mouse.
227 On click, point & mark are set to click position, and mark is disabled.
228 Dragging extends region/selection.
230 Double-clicking on word constituents selects words.
231 Double-clicking on symbol constituents selects symbols.
232 Double-clicking on quotes or parentheses selects sexps.
233 Double-clicking on whitespace selects whitespace.
234 Triple-clicking selects lines.
236 Clicking mouse-2 while selecting copies the region to the kill-ring.
237 Clicking mouse-1 or mouse-3 kills the region.
239 This should be bound to a down-mouse event."
241 (mouse-set-point EVENT)
242 (setq mouse-sel-selection-type
243 (mouse-sel-determine-selection-type (event-click-count EVENT)))
244 (let ((object-bounds (bounds-of-thing-at-point mouse-sel-selection-type)))
248 (goto-char (car object-bounds))
249 (set-mark (cdr object-bounds)))
253 (defun mouse-extend (&optional EVENT)
254 "Extend region/selection using the mouse.
256 See documentation for mouse-select for more details.
258 This should be bound to a down-mouse event."
260 (if EVENT (select-window (posn-window (event-end EVENT))))
261 (let* ((min (if mark-active (region-beginning) (point)))
262 (max (if mark-active (region-end) (point)))
263 (orig-window (selected-window))
264 (orig-window-frame (window-frame orig-window))
265 (top (nth 1 (window-edges orig-window)))
266 (bottom (nth 3 (window-edges orig-window)))
268 (cdr (assoc 'cursor-type (frame-parameters (selected-frame)))))
272 ;; Inhibit normal region highlight
273 (setq mark-active nil)
275 ;; Highlight region (forcing re-highlight)
276 (move-overlay mouse-drag-overlay min max (current-buffer))
277 (overlay-put mouse-drag-overlay 'face
278 (overlay-get mouse-drag-overlay 'face))
281 (modify-frame-parameters (selected-frame) '((cursor-type . bar)))
288 (while (if EVENT ; Use initial event
292 (setq event (read-event))
294 (memq (car event) '(mouse-movement switch-frame))))
296 (let ((end (event-end event)))
300 ;; Ignore any movement outside the frame
301 ((eq (car-safe event) 'switch-frame) nil)
302 ((and (posn-window end)
303 (not (eq (window-frame (posn-window end))
304 (window-frame orig-window)))) nil)
306 ;; Different window, same frame
307 ((not (eq (posn-window end) orig-window))
308 (let ((end-row (cdr (cdr (mouse-position)))))
310 ((and end-row (not (bobp)) (< end-row top))
311 (mouse-scroll-subr (- end-row top)
312 mouse-drag-overlay max))
313 ((and end-row (not (eobp)) (>= end-row bottom))
314 (mouse-scroll-subr (1+ (- end-row bottom))
315 mouse-drag-overlay min))
319 ((eq (posn-point end) 'mode-line)
320 (mouse-scroll-subr 1 mouse-drag-overlay min))
322 ;; In original window
323 (t (goto-char (posn-point end)))
327 ;; Determine direction of drag
329 ((and (not direction) (not (eq min max)))
330 (setq direction (if (< (point) (/ (+ min max) 2)) -1 1)))
331 ((and (not (eq direction -1)) (<= (point) min))
333 ((and (not (eq direction 1)) (>= (point) max))
336 (if (not mouse-sel-selection-type) nil
338 ;; If dragging forward, goal is next character
339 (if (and (eq direction 1) (not (eobp))) (forward-char 1))
341 ;; Move to start/end of selected thing
344 (goto-char (if (eq 1 direction) min max))
347 (while (> (* direction (- goal (point))) 0)
349 (forward-thing mouse-sel-selection-type
352 (forward-thing mouse-sel-selection-type
355 (if (> (* direction (- goal (point))) 0)
360 (move-overlay mouse-drag-overlay
361 (if (eq 1 direction) min (point))
362 (if (eq -1 direction) max (point))
365 ))) ; end track-mouse
367 (let ((overlay-start (overlay-start mouse-drag-overlay))
368 (overlay-end (overlay-end mouse-drag-overlay)))
371 (if (eq overlay-start overlay-end)
373 (if (and mouse-sel-leave-point-near-mouse (eq direction 1))
375 (set-mark overlay-start)
376 (goto-char overlay-end))
377 (set-mark overlay-end)
378 (goto-char overlay-start)))
381 (if (and mark-active mouse-sel-set-selection-function)
382 (funcall mouse-sel-set-selection-function
383 (buffer-substring overlay-start overlay-end)))
387 ((eq (car-safe last-input-event) 'down-mouse-2)
388 (copy-region-as-kill overlay-start overlay-end)
389 (read-event) (read-event))
390 ((memq (car-safe last-input-event) '(down-mouse-1 down-mouse-3))
391 (kill-region overlay-start overlay-end)
393 (read-event) (read-event)))))
396 (modify-frame-parameters (selected-frame)
397 (list (cons 'cursor-type orig-cursor-type)))
399 (or mouse-sel-retain-highlight
400 (delete-overlay mouse-drag-overlay)))))
402 (defun mouse-insert-selection (click)
403 "Insert the contents of the selection at mouse click."
405 (mouse-set-point click)
407 (if mouse-sel-get-selection-function
408 (insert (or (funcall mouse-sel-get-selection-function) ""))))
410 (defun mouse-sel-validate-selection ()
411 "Remove selection highlight if emacs no longer owns the primary selection."
412 (or (not mouse-sel-check-selection-function)
413 (funcall mouse-sel-check-selection-function)
414 (delete-overlay mouse-drag-overlay)))
416 (add-hook 'pre-command-hook 'mouse-sel-validate-selection)
418 ;;=== Key bindings ========================================================
420 (if (not mouse-sel-default-bindings) nil
422 (global-unset-key [mouse-1])
423 (global-unset-key [drag-mouse-1])
424 (global-unset-key [mouse-3])
426 (global-set-key [down-mouse-1] 'mouse-select)
427 (global-set-key [down-mouse-3] 'mouse-extend)
429 (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) nil
431 (global-set-key [mouse-2] 'mouse-insert-selection)
432 (setq interprogram-cut-function nil
433 interprogram-paste-function nil))
437 ;; mouse-sel.el ends here.