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   `(let ((posn (event-end ,event)))
 441     (if posn (mouse-minibuffer-check ,event))
 442     (if (and posn (not (windowp (posn-window posn))))
 443         (error "Cursor not in text area of window"))
 444     (let (orig-window orig-point-marker)
 445       (setq orig-window (selected-window))
 446       (if posn (select-window (posn-window posn)))
 447       (setq orig-point-marker (point-marker))
 448       (if (and posn (numberp (posn-point posn)))
 449           (goto-char (posn-point posn)))
 450       (unwind-protect
 451            (progn
 452              ,@forms)
 453         (goto-char (marker-position orig-point-marker))
 454         (move-marker orig-point-marker nil)
 455         (select-window orig-window)))))
 456
 457 (put 'mouse-sel-eval-at-event-end 'lisp-indent-hook 1)
 458
 459 ;;=== Select ==============================================================
 460
 461 (defun mouse-select (event)
 462   "Set region/selection using the mouse.
 463
 464 Click sets point & mark to click position.
 465 Dragging extends region/selection.
 466
 467 Multi-clicking selects word/lines/paragraphs, as determined by
 468 'mouse-sel-determine-selection-thing.
 469
 470 Clicking mouse-2 while selecting copies selected text to the kill-ring.
 471 Clicking mouse-1 or mouse-3 kills the selected text.
 472
 473 This should be bound to a down-mouse event."
 474   (interactive "@e")
 475   (let (direction)
 476     (unwind-protect
 477         (setq direction (mouse-select-internal 'PRIMARY event))
 478       (mouse-sel-primary-to-region direction))))
 479
 480 (defun mouse-select-secondary (event)
 481   "Set secondary selection using the mouse.
 482
 483 Click sets the start of the secondary selection to click position.
 484 Dragging extends the secondary selection.
 485
 486 Multi-clicking selects word/lines/paragraphs, as determined by
 487 'mouse-sel-determine-selection-thing.
 488
 489 Clicking mouse-2 while selecting copies selected text to the kill-ring.
 490 Clicking mouse-1 or mouse-3 kills the selected text.
 491
 492 This should be bound to a down-mouse event."
 493   (interactive "e")
 494   (mouse-select-internal 'SECONDARY event))
 495
 496 (defun mouse-select-internal (selection event)
 497   "Set SELECTION using the mouse."
 498   (mouse-sel-eval-at-event-end event
 499     (let ((thing-symbol (mouse-sel-selection-thing selection))
 500           (overlay (mouse-sel-selection-overlay selection)))
 501       (set thing-symbol
 502            (mouse-sel-determine-selection-thing (event-click-count event)))
 503       (let ((object-bounds (bounds-of-thing-at-point
 504                             (symbol-value thing-symbol))))
 505         (if object-bounds
 506             (progn
 507               (move-overlay overlay
 508                             (car object-bounds) (cdr object-bounds)
 509                             (current-buffer)))
 510           (move-overlay overlay (point) (point) (current-buffer)))))
 511     (mouse-extend-internal selection)))
 512
 513 ;;=== Extend ==============================================================
 514
 515 (defun mouse-extend (event)
 516   "Extend region/selection using the mouse."
 517   (interactive "e")
 518   (let ((orig-window (selected-window))
 519         direction)
 520     (select-window (posn-window (event-end event)))
 521     (unwind-protect
 522         (progn
 523           (mouse-sel-region-to-primary orig-window)
 524           (setq direction (mouse-extend-internal 'PRIMARY event)))
 525       (mouse-sel-primary-to-region direction))))
 526
 527 (defun mouse-extend-secondary (event)
 528   "Extend secondary selection using the mouse."
 529   (interactive "e")
 530   (save-window-excursion
 531     (mouse-extend-internal 'SECONDARY event)))
 532
 533 (defun mouse-extend-internal (selection &optional initial-event)
 534   "Extend specified SELECTION using the mouse.
 535 Track mouse-motion events, adjusting the SELECTION appropriately.
 536 Optional argument INITIAL-EVENT specifies an initial down-mouse event to
 537 process.
 538
 539 See documentation for mouse-select-internal for more details."
 540   (mouse-sel-eval-at-event-end initial-event
 541     (let ((orig-cursor-type
 542            (cdr (assoc 'cursor-type (frame-parameters (selected-frame))))))
 543       (unwind-protect
 544
 545           (let* ((thing-symbol (mouse-sel-selection-thing selection))
 546                  (overlay (mouse-sel-selection-overlay selection))
 547                  (orig-window (selected-window))
 548                  (orig-window-frame (window-frame orig-window))
 549                  (top (nth 1 (window-edges orig-window)))
 550                  (bottom (nth 3 (window-edges orig-window)))
 551                  (mark-active nil)      ; inhibit normal region highlight
 552                  (echo-keystrokes 0)    ; don't echo mouse events
 553                  min max
 554                  direction
 555                  event)
 556
 557             ;; Get current bounds of overlay
 558             (if (eq (overlay-buffer overlay) (current-buffer))
 559                 (setq min (overlay-start overlay)
 560                       max (overlay-end overlay))
 561               (setq min (point)
 562                     max min)
 563               (set thing-symbol nil))
 564
 565
 566             ;; Bar cursor
 567             (if (fboundp 'modify-frame-parameters)
 568                 (modify-frame-parameters (selected-frame)
 569                                          '((cursor-type . bar))))
 570
 571             ;; Handle dragging
 572             (track-mouse
 573
 574               (while (if initial-event  ; Use initial event
 575                          (prog1
 576                              (setq event initial-event)
 577                            (setq initial-event nil))
 578                        (setq event (read-event))
 579                        (and (consp event)
 580                             (memq (car event) '(mouse-movement switch-frame))))
 581
 582                 (let ((selection-thing (symbol-value thing-symbol))
 583                       (end (event-end event)))
 584
 585                   (cond
 586
 587                    ;; Ignore any movement outside the frame
 588                    ((eq (car-safe event) 'switch-frame) nil)
 589                    ((and (posn-window end)
 590                          (not (eq (let ((posn-w (posn-window end)))
 591                                     (if (windowp posn-w)
 592                                         (window-frame posn-w)
 593                                       posn-w))
 594                                   (window-frame orig-window)))) nil)
 595
 596                    ;; Different window, same frame
 597                    ((not (eq (posn-window end) orig-window))
 598                     (let ((end-row (cdr (cdr (mouse-position)))))
 599                       (cond
 600                        ((and end-row (not (bobp)) (< end-row top))
 601                         (mouse-scroll-subr orig-window (- end-row top)
 602                                            overlay max))
 603                        ((and end-row (not (eobp)) (>= end-row bottom))
 604                         (mouse-scroll-subr orig-window (1+ (- end-row bottom))
 605                                            overlay min))
 606                        )))
 607
 608                    ;; On the mode line
 609                    ((eq (posn-point end) 'mode-line)
 610                     (mouse-scroll-subr orig-window 1 overlay min))
 611
 612                    ;; In original window
 613                    (t (goto-char (posn-point end)))
 614
 615                    )
 616
 617                   ;; Determine direction of drag
 618                   (cond
 619                    ((and (not direction) (not (eq min max)))
 620                     (setq direction (if (< (point) (/ (+ min max) 2)) -1 1)))
 621                    ((and (not (eq direction -1)) (<= (point) min))
 622                     (setq direction -1))
 623                    ((and (not (eq direction 1)) (>= (point) max))
 624                     (setq direction 1)))
 625
 626                   (if (not selection-thing) nil
 627
 628                     ;; If dragging forward, goal is next character
 629                     (if (and (eq direction 1) (not (eobp))) (forward-char 1))
 630
 631                     ;; Move to start/end of selected thing
 632                     (let ((goal (point)))
 633                       (goto-char (if (eq 1 direction) min max))
 634                       (condition-case nil
 635                           (progn
 636                             (while (> (* direction (- goal (point))) 0)
 637                               (forward-thing selection-thing direction))
 638                             (let ((end (point)))
 639                               (forward-thing selection-thing (- direction))
 640                               (goto-char
 641                                (if (> (* direction (- goal (point))) 0)
 642                                    end (point)))))
 643                         (error))))
 644
 645                   ;; Move overlay
 646                   (move-overlay overlay
 647                                 (if (eq 1 direction) min (point))
 648                                 (if (eq -1 direction) max (point))
 649                                 (current-buffer))
 650
 651                   )))                   ; end track-mouse
 652
 653             ;; Finish up after dragging
 654             (let ((overlay-start (overlay-start overlay))
 655                   (overlay-end (overlay-end overlay)))
 656
 657               ;; Set selection
 658               (if (not (eq overlay-start overlay-end))
 659                   (mouse-sel-set-selection
 660                    selection
 661                    (buffer-substring overlay-start overlay-end)))
 662
 663               ;; Handle copy/kill
 664               (let (this-command)
 665                 (cond
 666                  ((eq (event-basic-type last-input-event) 'mouse-2)
 667                   (copy-region-as-kill overlay-start overlay-end)
 668                   (read-event) (read-event))
 669                  ((and (memq (event-basic-type last-input-event)
 670                              '(mouse-1 mouse-3))
 671                        (memq 'down (event-modifiers last-input-event)))
 672                   (kill-region overlay-start overlay-end)
 673                   (move-overlay overlay overlay-start overlay-start)
 674                   (read-event) (read-event))
 675                  ((and (eq (event-basic-type last-input-event) 'mouse-3)
 676                        (memq 'double (event-modifiers last-input-event)))
 677                   (kill-region overlay-start overlay-end)
 678                   (move-overlay overlay overlay-start overlay-start)))))
 679
 680             direction)
 681
 682         ;; Restore cursor
 683         (if (fboundp 'modify-frame-parameters)
 684             (modify-frame-parameters
 685              (selected-frame) (list (cons 'cursor-type orig-cursor-type))))
 686
 687         ))))
 688
 689 ;;=== Paste ===============================================================
 690
 691 (defun mouse-insert-selection (event)
 692   "Insert the contents of the PRIMARY selection at mouse click.
 693 If `mouse-yank-at-point' is non-nil, insert at point instead."
 694   (interactive "e")
 695   (mouse-insert-selection-internal 'PRIMARY event))
 696
 697 (defun mouse-insert-secondary (event)
 698   "Insert the contents of the SECONDARY selection at mouse click.
 699 If `mouse-yank-at-point' is non-nil, insert at point instead."
 700   (interactive "e")
 701   (mouse-insert-selection-internal 'SECONDARY event))
 702
 703 (defun mouse-insert-selection-internal (selection event)
 704   "Insert the contents of the named SELECTION at mouse click.
 705 If `mouse-yank-at-point' is non-nil, insert at point instead."
 706   (unless mouse-yank-at-point
 707     (mouse-set-point event))
 708   (when mouse-sel-get-selection-function
 709     (push-mark (point) 'nomsg)
 710     (insert (or (funcall mouse-sel-get-selection-function selection) ""))))
 711
 712 ;;=== Handle loss of selections ===========================================
 713
 714 (defun mouse-sel-lost-selection-hook (selection)
 715   "Remove the overlay for a lost selection."
 716   (let ((overlay (mouse-sel-selection-overlay selection)))
 717     (delete-overlay overlay)))
 718
 719 ;;=== Bug reporting =======================================================
 720
 721 ;(defconst mouse-sel-maintainer-address "mikew@gopher.dosli.govt.nz")
 722
 723 ;(defun mouse-sel-submit-bug-report ()
 724 ;  "Submit a bug report on mouse-sel.el via mail."
 725 ;  (interactive)
 726 ;  (require 'reporter)
 727 ;  (reporter-submit-bug-report
 728 ;   mouse-sel-maintainer-address
 729 ;   (concat "mouse-sel.el "
 730 ;           (or (condition-case nil mouse-sel-version (error))
 731 ;               "(distributed with Emacs)"))
 732 ;   (list 'transient-mark-mode
 733 ;        'delete-selection-mode
 734 ;        'mouse-sel-default-bindings
 735 ;        'mouse-sel-leave-point-near-mouse
 736 ;        'mouse-sel-cycle-clicks
 737 ;        'mouse-sel-selection-alist
 738 ;        'mouse-sel-set-selection-function
 739 ;        'mouse-sel-get-selection-function
 740 ;        'mouse-yank-at-point)))
 741
 742 (provide 'mouse-sel)
 743
 744 ;;; mouse-sel.el ends here