lisp/mouse-sel.el

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