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 it's 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] will leave point at the end
 169 of the region nearest to where the mouse last was.
 170 If nil, point will always be placed at the beginning of the region.")
 171
 172 (defvar mouse-sel-retain-highlight nil
 173   "*Retain highlight on mouse-drag-overlay.
 174 If non-nil, regions selected using \\[mouse-select] and \\[mouse-extend] will
 175 remain highlighted.
 176 If nil, highlighting will be turned off when the mouse is lifted.")
 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 is 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 On click, point & mark are set to click position, and mark is disabled.
 233 Dragging extends region/selection.
 234
 235 Double-clicking on word constituents selects words.
 236 Double-clicking on symbol constituents selects symbols.
 237 Double-clicking on quotes or parentheses selects sexps.
 238 Double-clicking on whitespace selects whitespace.
 239 Triple-clicking selects lines.
 240
 241 Clicking mouse-2 while selecting copies the region to the kill-ring.
 242 Clicking mouse-1 or mouse-3 kills the region.
 243
 244 This should be bound to a down-mouse event."
 245   (interactive "e")
 246   (mouse-set-point EVENT)
 247   (setq mouse-sel-selection-type
 248         (mouse-sel-determine-selection-type (event-click-count EVENT)))
 249   (let ((object-bounds (bounds-of-thing-at-point mouse-sel-selection-type)))
 250     (if object-bounds
 251         (progn
 252           (setq mark-active t)
 253           (goto-char (car object-bounds))
 254           (set-mark (cdr object-bounds)))
 255       (deactivate-mark)))
 256   (mouse-extend))
 257
 258 (defun mouse-extend (&optional EVENT)
 259   "Extend region/selection using the mouse.
 260
 261 See documentation for mouse-select for more details.
 262
 263 This should be bound to a down-mouse event."
 264   (interactive "e")
 265   (if EVENT (select-window (posn-window (event-end EVENT))))
 266   (let* ((min (if mark-active (region-beginning) (point)))
 267          (max (if mark-active (region-end) (point)))
 268          (orig-window (selected-window))
 269          (orig-window-frame (window-frame orig-window))
 270          (top (nth 1 (window-edges orig-window)))
 271          (bottom (nth 3 (window-edges orig-window)))
 272          (orig-cursor-type
 273           (cdr (assoc 'cursor-type (frame-parameters (selected-frame)))))
 274          direction
 275          event)
 276
 277     ;; Inhibit normal region highlight
 278     (setq mark-active nil)
 279
 280     ;; Highlight region (forcing re-highlight)
 281     (move-overlay mouse-drag-overlay min max (current-buffer))
 282     (overlay-put mouse-drag-overlay 'face
 283                  (overlay-get mouse-drag-overlay 'face))
 284
 285     ;; Bar cursor
 286     (if (fboundp 'modify-frame-parameters)
 287         (modify-frame-parameters (selected-frame) '((cursor-type . bar))))
 288
 289     ;; Handle dragging
 290     (unwind-protect
 291         (progn
 292           (track-mouse
 293
 294             (while (if EVENT            ; Use initial event
 295                        (prog1
 296                            (setq event EVENT)
 297                          (setq EVENT nil))
 298                      (setq event (read-event))
 299                      (and (consp event)
 300                           (memq (car event) '(mouse-movement switch-frame))))
 301
 302               (let ((end (event-end event)))
 303
 304                 (cond
 305
 306                  ;; Ignore any movement outside the frame
 307                  ((eq (car-safe event) 'switch-frame) nil)
 308                  ((and (posn-window end)
 309                        (not (eq (let ((posn-w (posn-window end)))
 310                                   (if (windowp posn-w)
 311                                       (window-frame posn-w)
 312                                     posn-w))
 313                                 (window-frame orig-window)))) nil)
 314
 315                  ;; Different window, same frame
 316                  ((not (eq (posn-window end) orig-window))
 317                   (let ((end-row (cdr (cdr (mouse-position)))))
 318                     (cond
 319                      ((and end-row (not (bobp)) (< end-row top))
 320                       (mouse-scroll-subr (- end-row top)
 321                                          mouse-drag-overlay max))
 322                      ((and end-row (not (eobp)) (>= end-row bottom))
 323                       (mouse-scroll-subr (1+ (- end-row bottom))
 324                                          mouse-drag-overlay min))
 325                      )))
 326
 327                  ;; On the mode line
 328                  ((eq (posn-point end) 'mode-line)
 329                   (mouse-scroll-subr 1 mouse-drag-overlay min))
 330
 331                  ;; In original window
 332                  (t (goto-char (posn-point end)))
 333
 334                  )
 335
 336                 ;; Determine direction of drag
 337                 (cond
 338                  ((and (not direction) (not (eq min max)))
 339                   (setq direction (if (< (point) (/ (+ min max) 2)) -1 1)))
 340                  ((and (not (eq direction -1)) (<= (point) min))
 341                   (setq direction -1))
 342                  ((and (not (eq direction 1)) (>= (point) max))
 343                   (setq direction 1)))
 344
 345                 (if (not mouse-sel-selection-type) nil
 346
 347                   ;; If dragging forward, goal is next character
 348                   (if (and (eq direction 1) (not (eobp))) (forward-char 1))
 349
 350                   ;; Move to start/end of selected thing
 351                   (let ((goal (point))
 352                         last)
 353                     (goto-char (if (eq 1 direction) min max))
 354                     (condition-case nil
 355                         (progn
 356                           (while (> (* direction (- goal (point))) 0)
 357                             (setq last (point))
 358                             (forward-thing mouse-sel-selection-type
 359                                            direction))
 360                           (let ((end (point)))
 361                             (forward-thing mouse-sel-selection-type
 362                                            (- direction))
 363                             (goto-char
 364                              (if (> (* direction (- goal (point))) 0)
 365                                  end last))))
 366                       (error))))
 367
 368                 ;; Move overlay
 369                 (move-overlay mouse-drag-overlay
 370                               (if (eq 1 direction) min (point))
 371                               (if (eq -1 direction) max (point))
 372                               (current-buffer))
 373
 374                 )))                     ; end track-mouse
 375
 376           (let ((overlay-start (overlay-start mouse-drag-overlay))
 377                 (overlay-end (overlay-end mouse-drag-overlay)))
 378
 379             ;; Set region
 380             (if (eq overlay-start overlay-end)
 381                 (deactivate-mark)
 382               (if (and mouse-sel-leave-point-near-mouse (eq direction 1))
 383                   (progn
 384                     (set-mark overlay-start)
 385                     (goto-char overlay-end))
 386                 (set-mark overlay-end)
 387                 (goto-char overlay-start)))
 388
 389             ;; Set selection
 390             (if (and mark-active mouse-sel-set-selection-function)
 391                 (funcall mouse-sel-set-selection-function
 392                          (buffer-substring overlay-start overlay-end)))
 393
 394             ;; Handle copy/kill
 395             (cond
 396              ((eq (car-safe last-input-event) 'down-mouse-2)
 397               (copy-region-as-kill overlay-start overlay-end)
 398               (read-event) (read-event))
 399              ((memq (car-safe last-input-event) '(down-mouse-1 down-mouse-3))
 400               (kill-region overlay-start overlay-end)
 401               (deactivate-mark)
 402               (read-event) (read-event))
 403              ((eq (car-safe last-input-event) 'double-mouse-3)
 404               (kill-region overlay-start overlay-end)
 405               (deactivate-mark)))))
 406
 407       ;; Restore cursor
 408       (if (fboundp 'modify-frame-parameters)
 409           (modify-frame-parameters
 410            (selected-frame) (list (cons 'cursor-type orig-cursor-type))))
 411
 412       ;; Remove overlay
 413       (or mouse-sel-retain-highlight
 414           (delete-overlay mouse-drag-overlay)))))
 415
 416 (defun mouse-insert-selection (click)
 417   "Insert the contents of the selection at mouse click.
 418 If `mouse-yank-at-point' is non-nil, insert at point instead."
 419   (interactive "e")
 420   (or mouse-yank-at-point
 421       (mouse-set-point click))
 422   (deactivate-mark)
 423   (if mouse-sel-get-selection-function
 424       (insert (or (funcall mouse-sel-get-selection-function) ""))))
 425
 426 (defun mouse-sel-validate-selection ()
 427   "Remove selection highlight if emacs no longer owns the primary selection."
 428   (or (not mouse-sel-check-selection-function)
 429       (funcall mouse-sel-check-selection-function)
 430       (delete-overlay mouse-drag-overlay)))
 431
 432 (add-hook 'pre-command-hook 'mouse-sel-validate-selection)
 433
 434 ;;=== Key bindings ========================================================
 435
 436 (if (not mouse-sel-default-bindings) nil
 437
 438   (global-unset-key [mouse-1])
 439   (global-unset-key [drag-mouse-1])
 440   (global-unset-key [mouse-3])
 441
 442   (global-set-key [down-mouse-1]        'mouse-select)
 443   (global-set-key [down-mouse-3]        'mouse-extend)
 444
 445   (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) nil
 446
 447     (global-set-key [mouse-2]   'mouse-insert-selection)
 448     (setq interprogram-cut-function nil
 449           interprogram-paste-function nil))
 450
 451   )
 452
 453 ;; mouse-sel.el ends here.