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