lisp/mouse-sel.el

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