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