lisp/mouse-sel.el

   1 ;;; mouse-sel.el --- Multi-click selection support for Emacs 19
   2
   3 ;; Copyright (C) 1993, 1994, 1995 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          (global-unset-key [mouse-1])
 256          (global-unset-key [drag-mouse-1])
 257          (global-unset-key [mouse-3])
 258          (global-set-key [down-mouse-1] 'mouse-select)
 259          (unless (eq mouse-sel-default-bindings 'interprogram-cut-paste)
 260            (global-set-key [mouse-2]    'mouse-insert-selection)
 261            (setq interprogram-cut-function nil
 262                  interprogram-paste-function nil))
 263          (global-set-key [down-mouse-3] 'mouse-extend)
 264          ;;
 265          ;; Secondary selection bindings.
 266          (global-unset-key [M-mouse-1])
 267          (global-unset-key [M-drag-mouse-1])
 268          (global-unset-key [M-mouse-3])
 269          (global-set-key [M-down-mouse-1]       'mouse-select-secondary)
 270          (global-set-key [M-mouse-2]            'mouse-insert-secondary)
 271          (global-set-key [M-down-mouse-3]       'mouse-extend-secondary))))
 272
 273 ;;=== Command Variable ====================================================
 274
 275 ;; This has to come after the function `mouse-sel-mode' and its callee.
 276 ;; An alternative is to put the option `mouse-sel-mode' here and remove its
 277 ;; `:initialize' keyword.
 278 (when mouse-sel-mode
 279   (mouse-sel-mode t))
 280
 281 ;;=== Internal Variables/Constants ========================================
 282
 283 (defvar mouse-sel-primary-thing nil
 284   "Type of PRIMARY selection in current buffer.")
 285 (make-variable-buffer-local 'mouse-sel-primary-thing)
 286
 287 (defvar mouse-sel-secondary-thing nil
 288   "Type of SECONDARY selection in current buffer.")
 289 (make-variable-buffer-local 'mouse-sel-secondary-thing)
 290
 291 ;; Ensure that secondary overlay is defined
 292 (unless (overlayp mouse-secondary-overlay)
 293   (setq mouse-secondary-overlay (make-overlay 1 1))
 294   (overlay-put mouse-secondary-overlay 'face 'secondary-selection))
 295
 296 (defconst mouse-sel-selection-alist
 297   '((PRIMARY mouse-drag-overlay mouse-sel-primary-thing)
 298     (SECONDARY mouse-secondary-overlay mouse-sel-secondary-thing))
 299   "Alist associating selections with variables.  Each element is of
 300 the form:
 301
 302    (SELECTION-NAME OVERLAY-SYMBOL SELECTION-THING-SYMBOL)
 303
 304 where   SELECTION-NAME          = name of selection
 305         OVERLAY-SYMBOL          = name of variable containing overlay to use
 306         SELECTION-THING-SYMBOL  = name of variable where the current selection
 307                                   type for this selection should be stored.")
 308
 309 (defvar mouse-sel-set-selection-function
 310   (if (eq mouse-sel-default-bindings 'interprogram-cut-paste)
 311       'x-set-selection
 312     (lambda (selection value)
 313       (if (eq selection 'PRIMARY)
 314           (x-select-text value)
 315         (x-set-selection selection value))))
 316   "Function to call to set selection.
 317 Called with two arguments:
 318
 319   SELECTION, the name of the selection concerned, and
 320   VALUE, the text to store.
 321
 322 This sets the selection as well as the cut buffer for the older applications,
 323 unless `mouse-sel-default-bindings' is `interprogram-cut-paste'.")
 324
 325 (defvar mouse-sel-get-selection-function
 326   (lambda (selection)
 327     (if (eq selection 'PRIMARY)
 328         (or (x-cut-buffer-or-selection-value) x-last-selected-text)
 329       (x-get-selection selection)))
 330   "Function to call to get the selection.
 331 Called with one argument:
 332
 333    SELECTION: the name of the selection concerned.")
 334
 335 ;;=== Support/access functions ============================================
 336
 337 (defun mouse-sel-determine-selection-thing (nclicks)
 338   "Determine what `thing' `mouse-sel' should operate on.
 339 The first argument is NCLICKS, is the number of consecutive
 340 mouse clicks at the same position.
 341
 342 Double-clicking on word constituents selects words.
 343 Double-clicking on symbol constituents selects symbols.
 344 Double-clicking on quotes or parentheses selects sexps.
 345 Double-clicking on whitespace selects whitespace.
 346 Triple-clicking selects lines.
 347 Quad-clicking selects paragraphs.
 348
 349 Feel free to re-define this function to support your own desired
 350 multi-click semantics."
 351   (let* ((next-char (char-after (point)))
 352          (char-syntax (if next-char (char-syntax next-char))))
 353     (if mouse-sel-cycle-clicks
 354         (setq nclicks (1+ (% (1- nclicks) 4))))
 355     (cond
 356      ((= nclicks 1) nil)
 357      ((= nclicks 3) 'line)
 358      ((>= nclicks 4) 'paragraph)
 359      ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp)
 360      ((memq next-char '(? ?\t ?\n)) 'whitespace)
 361      ((eq char-syntax ?_) 'symbol)
 362      ((eq char-syntax ?w) 'word))))
 363
 364 (defun mouse-sel-set-selection (selection value)
 365   "Set the specified SELECTION to VALUE."
 366   (if mouse-sel-set-selection-function
 367       (funcall mouse-sel-set-selection-function selection value)
 368     (put 'mouse-sel-internal-selection selection value)))
 369
 370 (defun mouse-sel-get-selection (selection)
 371   "Get the value of the specified SELECTION."
 372   (if mouse-sel-get-selection-function
 373       (funcall mouse-sel-get-selection-function selection)
 374     (get 'mouse-sel-internal-selection selection)))
 375
 376 (defun mouse-sel-selection-overlay (selection)
 377   "Return overlay corresponding to SELECTION."
 378   (let ((symbol (nth 1 (assoc selection mouse-sel-selection-alist))))
 379     (or symbol (error "No overlay corresponding to %s selection" selection))
 380     (symbol-value symbol)))
 381
 382 (defun mouse-sel-selection-thing (selection)
 383   "Return overlay corresponding to SELECTION."
 384   (let ((symbol (nth 2 (assoc selection mouse-sel-selection-alist))))
 385     (or symbol (error "No symbol corresponding to %s selection" selection))
 386     symbol))
 387
 388 (defun mouse-sel-region-to-primary (orig-window)
 389   "Convert region to PRIMARY overlay and deactivate region.
 390 Argument ORIG-WINDOW specifies the window the cursor was in when the
 391 originating command was issued, and is used to determine whether the
 392 region was visible or not."
 393   (if transient-mark-mode
 394       (let ((overlay (mouse-sel-selection-overlay 'PRIMARY)))
 395         (cond
 396          ((and mark-active
 397                (or highlight-nonselected-windows
 398                    (eq orig-window (selected-window))))
 399           ;; Region was visible, so convert region to overlay
 400           (move-overlay overlay (region-beginning) (region-end)
 401                         (current-buffer)))
 402          ((eq orig-window (selected-window))
 403           ;; Point was visible, so set overlay at point
 404           (move-overlay overlay (point) (point) (current-buffer)))
 405          (t
 406           ;; Nothing was visible, so remove overlay
 407           (delete-overlay overlay)))
 408         (setq mark-active nil))))
 409
 410 (defun mouse-sel-primary-to-region (&optional direction)
 411   "Convert PRIMARY overlay to region.
 412 Optional argument DIRECTION specifies the mouse drag direction: a value of
 413 1 indicates that the mouse was dragged left-to-right, otherwise it was
 414 dragged right-to-left."
 415   (let* ((overlay (mouse-sel-selection-overlay 'PRIMARY))
 416          (start (overlay-start overlay))
 417          (end (overlay-end overlay)))
 418     (if (eq start end)
 419         (progn
 420           (if start (goto-char start))
 421           (deactivate-mark))
 422       (if (and mouse-sel-leave-point-near-mouse (eq direction 1))
 423           (progn
 424             (goto-char end)
 425             (push-mark start 'nomsg 'active))
 426         (goto-char start)
 427         (push-mark end 'nomsg 'active)))
 428     (if transient-mark-mode (delete-overlay overlay))))
 429
 430 (defmacro mouse-sel-eval-at-event-end (event &rest forms)
 431   "Evaluate forms at mouse position.
 432 Move to the end position of EVENT, execute FORMS, and restore original
 433 point and window."
 434     (`
 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
 453 (put 'mouse-sel-eval-at-event-end 'lisp-indent-hook 1)
 454
 455 ;;=== Select ==============================================================
 456
 457 (defun mouse-select (event)
 458   "Set region/selection using the mouse.
 459
 460 Click sets point & mark to click position.
 461 Dragging extends region/selection.
 462
 463 Multi-clicking selects word/lines/paragraphs, as determined by
 464 'mouse-sel-determine-selection-thing.
 465
 466 Clicking mouse-2 while selecting copies selected text to the kill-ring.
 467 Clicking mouse-1 or mouse-3 kills the selected text.
 468
 469 This should be bound to a down-mouse event."
 470   (interactive "@e")
 471   (let (direction)
 472     (unwind-protect
 473         (setq direction (mouse-select-internal 'PRIMARY event))
 474       (mouse-sel-primary-to-region direction))))
 475
 476 (defun mouse-select-secondary (event)
 477   "Set secondary selection using the mouse.
 478
 479 Click sets the start of the secondary selection to click position.
 480 Dragging extends the secondary selection.
 481
 482 Multi-clicking selects word/lines/paragraphs, as determined by
 483 'mouse-sel-determine-selection-thing.
 484
 485 Clicking mouse-2 while selecting copies selected text to the kill-ring.
 486 Clicking mouse-1 or mouse-3 kills the selected text.
 487
 488 This should be bound to a down-mouse event."
 489   (interactive "e")
 490   (mouse-select-internal 'SECONDARY event))
 491
 492 (defun mouse-select-internal (selection event)
 493   "Set SELECTION using the mouse."
 494   (mouse-sel-eval-at-event-end event
 495     (let ((thing-symbol (mouse-sel-selection-thing selection))
 496           (overlay (mouse-sel-selection-overlay selection)))
 497       (set thing-symbol
 498            (mouse-sel-determine-selection-thing (event-click-count event)))
 499       (let ((object-bounds (bounds-of-thing-at-point
 500                             (symbol-value thing-symbol))))
 501         (if object-bounds
 502             (progn
 503               (move-overlay overlay
 504                             (car object-bounds) (cdr object-bounds)
 505                             (current-buffer)))
 506           (move-overlay overlay (point) (point) (current-buffer)))))
 507     (mouse-extend-internal selection)))
 508
 509 ;;=== Extend ==============================================================
 510
 511 (defun mouse-extend (event)
 512   "Extend region/selection using the mouse."
 513   (interactive "e")
 514   (let ((orig-window (selected-window))
 515         direction)
 516     (select-window (posn-window (event-end event)))
 517     (unwind-protect
 518         (progn
 519           (mouse-sel-region-to-primary orig-window)
 520           (setq direction (mouse-extend-internal 'PRIMARY event)))
 521       (mouse-sel-primary-to-region direction))))
 522
 523 (defun mouse-extend-secondary (event)
 524   "Extend secondary selection using the mouse."
 525   (interactive "e")
 526   (save-window-excursion
 527     (mouse-extend-internal 'SECONDARY event)))
 528
 529 (defun mouse-extend-internal (selection &optional initial-event)
 530   "Extend specified SELECTION using the mouse.
 531 Track mouse-motion events, adjusting the SELECTION appropriately.
 532 Optional argument INITIAL-EVENT specifies an initial down-mouse event to
 533 process.
 534
 535 See documentation for mouse-select-internal for more details."
 536   (mouse-sel-eval-at-event-end initial-event
 537     (let ((orig-cursor-type
 538            (cdr (assoc 'cursor-type (frame-parameters (selected-frame))))))
 539       (unwind-protect
 540
 541           (let* ((thing-symbol (mouse-sel-selection-thing selection))
 542                  (overlay (mouse-sel-selection-overlay selection))
 543                  (orig-window (selected-window))
 544                  (orig-window-frame (window-frame orig-window))
 545                  (top (nth 1 (window-edges orig-window)))
 546                  (bottom (nth 3 (window-edges orig-window)))
 547                  (mark-active nil)      ; inhibit normal region highlight
 548                  (echo-keystrokes 0)    ; don't echo mouse events
 549                  min max
 550                  direction
 551                  event)
 552
 553             ;; Get current bounds of overlay
 554             (if (eq (overlay-buffer overlay) (current-buffer))
 555                 (setq min (overlay-start overlay)
 556                       max (overlay-end overlay))
 557               (setq min (point)
 558                     max min)
 559               (set thing-symbol nil))
 560
 561
 562             ;; Bar cursor
 563             (if (fboundp 'modify-frame-parameters)
 564                 (modify-frame-parameters (selected-frame)
 565                                          '((cursor-type . bar))))
 566
 567             ;; Handle dragging
 568             (track-mouse
 569
 570               (while (if initial-event  ; Use initial event
 571                          (prog1
 572                              (setq event initial-event)
 573                            (setq initial-event nil))
 574                        (setq event (read-event))
 575                        (and (consp event)
 576                             (memq (car event) '(mouse-movement switch-frame))))
 577
 578                 (let ((selection-thing (symbol-value thing-symbol))
 579                       (end (event-end event)))
 580
 581                   (cond
 582
 583                    ;; Ignore any movement outside the frame
 584                    ((eq (car-safe event) 'switch-frame) nil)
 585                    ((and (posn-window end)
 586                          (not (eq (let ((posn-w (posn-window end)))
 587                                     (if (windowp posn-w)
 588                                         (window-frame posn-w)
 589                                       posn-w))
 590                                   (window-frame orig-window)))) nil)
 591
 592                    ;; Different window, same frame
 593                    ((not (eq (posn-window end) orig-window))
 594                     (let ((end-row (cdr (cdr (mouse-position)))))
 595                       (cond
 596                        ((and end-row (not (bobp)) (< end-row top))
 597                         (mouse-scroll-subr orig-window (- end-row top)
 598                                            overlay max))
 599                        ((and end-row (not (eobp)) (>= end-row bottom))
 600                         (mouse-scroll-subr orig-window (1+ (- end-row bottom))
 601                                            overlay min))
 602                        )))
 603
 604                    ;; On the mode line
 605                    ((eq (posn-point end) 'mode-line)
 606                     (mouse-scroll-subr orig-window 1 overlay min))
 607
 608                    ;; In original window
 609                    (t (goto-char (posn-point end)))
 610
 611                    )
 612
 613                   ;; Determine direction of drag
 614                   (cond
 615                    ((and (not direction) (not (eq min max)))
 616                     (setq direction (if (< (point) (/ (+ min max) 2)) -1 1)))
 617                    ((and (not (eq direction -1)) (<= (point) min))
 618                     (setq direction -1))
 619                    ((and (not (eq direction 1)) (>= (point) max))
 620                     (setq direction 1)))
 621
 622                   (if (not selection-thing) nil
 623
 624                     ;; If dragging forward, goal is next character
 625                     (if (and (eq direction 1) (not (eobp))) (forward-char 1))
 626
 627                     ;; Move to start/end of selected thing
 628                     (let ((goal (point)))
 629                       (goto-char (if (eq 1 direction) min max))
 630                       (condition-case nil
 631                           (progn
 632                             (while (> (* direction (- goal (point))) 0)
 633                               (forward-thing selection-thing direction))
 634                             (let ((end (point)))
 635                               (forward-thing selection-thing (- direction))
 636                               (goto-char
 637                                (if (> (* direction (- goal (point))) 0)
 638                                    end (point)))))
 639                         (error))))
 640
 641                   ;; Move overlay
 642                   (move-overlay overlay
 643                                 (if (eq 1 direction) min (point))
 644                                 (if (eq -1 direction) max (point))
 645                                 (current-buffer))
 646
 647                   )))                   ; end track-mouse
 648
 649             ;; Finish up after dragging
 650             (let ((overlay-start (overlay-start overlay))
 651                   (overlay-end (overlay-end overlay)))
 652
 653               ;; Set selection
 654               (if (not (eq overlay-start overlay-end))
 655                   (mouse-sel-set-selection
 656                    selection
 657                    (buffer-substring overlay-start overlay-end)))
 658
 659               ;; Handle copy/kill
 660               (let (this-command)
 661                 (cond
 662                  ((eq (event-basic-type last-input-event) 'mouse-2)
 663                   (copy-region-as-kill overlay-start overlay-end)
 664                   (read-event) (read-event))
 665                  ((and (memq (event-basic-type last-input-event)
 666                              '(mouse-1 mouse-3))
 667                        (memq 'down (event-modifiers last-input-event)))
 668                   (kill-region overlay-start overlay-end)
 669                   (move-overlay overlay overlay-start overlay-start)
 670                   (read-event) (read-event))
 671                  ((and (eq (event-basic-type last-input-event) 'mouse-3)
 672                        (memq 'double (event-modifiers last-input-event)))
 673                   (kill-region overlay-start overlay-end)
 674                   (move-overlay overlay overlay-start overlay-start)))))
 675
 676             direction)
 677
 678         ;; Restore cursor
 679         (if (fboundp 'modify-frame-parameters)
 680             (modify-frame-parameters
 681              (selected-frame) (list (cons 'cursor-type orig-cursor-type))))
 682
 683         ))))
 684
 685 ;;=== Paste ===============================================================
 686
 687 (defun mouse-insert-selection (event)
 688   "Insert the contents of the PRIMARY selection at mouse click.
 689 If `mouse-yank-at-point' is non-nil, insert at point instead."
 690   (interactive "e")
 691   (mouse-insert-selection-internal 'PRIMARY event))
 692
 693 (defun mouse-insert-secondary (event)
 694   "Insert the contents of the SECONDARY 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 'SECONDARY event))
 698
 699 (defun mouse-insert-selection-internal (selection event)
 700   "Insert the contents of the named SELECTION at mouse click.
 701 If `mouse-yank-at-point' is non-nil, insert at point instead."
 702   (unless mouse-yank-at-point
 703     (mouse-set-point event))
 704   (when mouse-sel-get-selection-function
 705     (push-mark (point) 'nomsg)
 706     (insert (or (funcall mouse-sel-get-selection-function selection) ""))))
 707
 708 ;;=== Handle loss of selections ===========================================
 709
 710 (defun mouse-sel-lost-selection-hook (selection)
 711   "Remove the overlay for a lost selection."
 712   (let ((overlay (mouse-sel-selection-overlay selection)))
 713     (delete-overlay overlay)))
 714
 715 ;;=== Bug reporting =======================================================
 716
 717 ;(defconst mouse-sel-maintainer-address "mikew@gopher.dosli.govt.nz")
 718
 719 ;(defun mouse-sel-submit-bug-report ()
 720 ;  "Submit a bug report on mouse-sel.el via mail."
 721 ;  (interactive)
 722 ;  (require 'reporter)
 723 ;  (reporter-submit-bug-report
 724 ;   mouse-sel-maintainer-address
 725 ;   (concat "mouse-sel.el "
 726 ;           (or (condition-case nil mouse-sel-version (error))
 727 ;               "(distributed with Emacs)"))
 728 ;   (list 'transient-mark-mode
 729 ;        'delete-selection-mode
 730 ;        'mouse-sel-default-bindings
 731 ;        'mouse-sel-leave-point-near-mouse
 732 ;        'mouse-sel-cycle-clicks
 733 ;        'mouse-sel-selection-alist
 734 ;        'mouse-sel-set-selection-function
 735 ;        'mouse-sel-get-selection-function
 736 ;        'mouse-yank-at-point)))
 737
 738 (provide 'mouse-sel)
 739
 740 ;; mouse-sel.el ends here.