lisp/mouse-sel.el

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