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 ;;; Commentary:
  21 ;;
  22 ;; This module provides multi-click mouse support for GNU Emacs versions
  23 ;; 19.18 and later.  I've tried to make it behave more like standard X
  24 ;; clients (eg. xterm) than the default Emacs 19 mouse selection handlers.
  25 ;; Basically:
  26 ;;
  27 ;;   * Clicking mouse-1 starts (cancels) selection, dragging extends it.
  28 ;;
  29 ;;   * Clicking or dragging mouse-3 extends the selection as well.
  30 ;;
  31 ;;   * Double-clicking on word constituents selects words.
  32 ;;     Double-clicking on symbol constituents selects symbols.
  33 ;;     Double-clicking on quotes or parentheses selects sexps.
  34 ;;     Double-clicking on whitespace selects whitespace.
  35 ;;     Triple-clicking selects lines.
  36 ;;     Quad-clicking selects paragraphs.
  37 ;;
  38 ;;   * Selecting sets the region & X primary selection, but does NOT affect
  39 ;;     the kill-ring.  Because the mouse handlers set the primary selection
  40 ;;     directly, mouse-sel sets the variables interprogram-cut-function
  41 ;;     and interprogram-paste-function to nil.
  42 ;;
  43 ;;   * Clicking mouse-2 inserts the contents of the primary selection at
  44 ;;     the mouse position (or point, if mouse-yank-at-point is non-nil).
  45 ;;
  46 ;;   * Pressing mouse-2 while selecting or extending copies selection
  47 ;;     to the kill ring.  Pressing mouse-1 or mouse-3 kills it.
  48 ;;
  49 ;;   * Double-clicking mouse-3 also kills selection.
  50 ;;
  51 ;;   * M-mouse-1, M-mouse-2 & M-mouse-3 work similarly to mouse-1, mouse-2
  52 ;;     & mouse-3, but operate on the X secondary selection rather than the
  53 ;;     primary selection and region.
  54 ;;
  55 ;; This module requires my thingatpt.el module, which it uses to find the
  56 ;; bounds of words, lines, sexps, etc.
  57 ;;
  58 ;; Thanks to KevinB@bartley.demon.co.uk for his useful input.
  59 ;;
  60 ;;--- Customisation -------------------------------------------------------
  61 ;;
  62 ;; * You may want to use none or more of following:
  63 ;;
  64 ;;      ;; Enable region highlight
  65 ;;      (transient-mark-mode 1)
  66 ;;
  67 ;;      ;; But only in the selected window
  68 ;;      (setq highlight-nonselected-windows nil)
  69 ;;
  70 ;;      ;; Enable pending-delete
  71 ;;      (delete-selection-mode 1)
  72 ;;
  73 ;; * You can control the way mouse-sel binds its keys by setting the value
  74 ;;   of mouse-sel-default-bindings before loading mouse-sel.
  75 ;;
  76 ;;   (a) If mouse-sel-default-bindings = t (the default)
  77 ;;
  78 ;;       Mouse sets and insert selection
  79 ;;         mouse-1              mouse-select
  80 ;;         mouse-2              mouse-insert-selection
  81 ;;         mouse-3              mouse-extend
  82 ;;
  83 ;;       Selection/kill-ring interaction is disabled
  84 ;;         interprogram-cut-function   = nil
  85 ;;         interprogram-paste-function = nil
  86 ;;
  87 ;;   (b) If mouse-sel-default-bindings = 'interprogram-cut-paste
  88 ;;
  89 ;;       Mouse sets selection, and pastes from kill-ring
  90 ;;         mouse-1              mouse-select
  91 ;;         mouse-2              mouse-yank-at-click
  92 ;;         mouse-3              mouse-extend
  93 ;;
  94 ;;       Selection/kill-ring interaction is retained
  95 ;;         interprogram-cut-function   = x-select-text
  96 ;;         interprogram-paste-function = x-cut-buffer-or-selection-value
  97 ;;
  98 ;;       What you lose is the ability to select some text in
  99 ;;       delete-selection-mode and yank over the top of it.
 100 ;;
 101 ;;   (c) If mouse-sel-default-bindings = nil, no bindings are made.
 102 ;;
 103 ;; * By default, mouse-insert-selection (mouse-2) inserts the selection at
 104 ;;   the mouse position.  You can tell it to insert at point instead with:
 105 ;;
 106 ;;     (setq mouse-yank-at-point t)
 107 ;;
 108 ;; * I like to leave point at the end of the region nearest to where the
 109 ;;   mouse was, even though this makes region highlighting mis-leading (the
 110 ;;   cursor makes it look like one extra character is selected).  You can
 111 ;;   disable this behaviour with:
 112 ;;
 113 ;;     (setq mouse-sel-leave-point-near-mouse nil)
 114 ;;
 115 ;; * By default, mouse-select cycles the click count after 4 clicks.  That
 116 ;;   is, clicking mouse-1 five times has the same effect as clicking it
 117 ;;   once, clicking six times has the same effect as clicking twice, etc.
 118 ;;   Disable this behaviour with:
 119 ;;
 120 ;;     (setq mouse-sel-cycle-clicks nil)
 121 ;;
 122 ;; * The variables mouse-sel-{set,get}-selection-function control how the
 123 ;;   selection is handled.  Under X Windows, these variables default so
 124 ;;   that the X primary selection is used.  Under other windowing systems,
 125 ;;   alternate functions are used, which simply store the selection value
 126 ;;   in a variable.
 127 ;;
 128 ;; * You can change the selection highlight face by altering the properties
 129 ;;   of mouse-drag-overlay, eg.
 130 ;;
 131 ;;     (overlay-put mouse-drag-overlay 'face 'bold)
 132
 133 ;;; Code: =================================================================
 134
 135 (provide 'mouse-sel)
 136
 137 (require 'mouse)
 138 (require 'thingatpt)
 139 (require 'backquote)
 140
 141 ;;=== User Variables ======================================================
 142
 143 (defvar mouse-sel-leave-point-near-mouse t
 144   "*Leave point near last mouse position.
 145 If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end
 146 of the region nearest to where the mouse last was.
 147 If nil, point will always be placed at the beginning of the region.")
 148
 149 (defvar mouse-sel-cycle-clicks t
 150   "*If non-nil, \\[mouse-select] cycles the click-counts after 4 clicks.")
 151
 152 (defvar mouse-sel-default-bindings t
 153   "Set to nil before loading `mouse-sel' to prevent default mouse bindings.")
 154
 155 ;;=== Internal Variables/Constants ========================================
 156
 157 (defvar mouse-sel-primary-thing nil
 158   "Type of PRIMARY selection in current buffer.")
 159 (make-variable-buffer-local 'mouse-sel-primary-thing)
 160
 161 (defvar mouse-sel-secondary-thing nil
 162   "Type of SECONDARY selection in current buffer.")
 163 (make-variable-buffer-local 'mouse-sel-secondary-thing)
 164
 165 ;; Ensure that secondary overlay is defined
 166 (if (overlayp mouse-secondary-overlay) nil
 167   (setq mouse-secondary-overlay (make-overlay 1 1))
 168   (overlay-put mouse-secondary-overlay 'face 'secondary-selection))
 169
 170 (defconst mouse-sel-selection-alist
 171   '((PRIMARY mouse-drag-overlay mouse-sel-primary-thing)
 172     (SECONDARY mouse-secondary-overlay mouse-sel-secondary-thing))
 173   "Alist associating selections with variables.  Each element is of
 174 the form:
 175
 176    (SELECTION-NAME OVERLAY-SYMBOL SELECTION-THING-SYMBOL)
 177
 178 where   SELECTION-NAME          = name of selection
 179         OVERLAY-SYMBOL          = name of variable containing overlay to use
 180         SELECTION-THING-SYMBOL  = name of variable where the current selection
 181                                   type for this selection should be stored.")
 182
 183 (defvar mouse-sel-set-selection-function
 184   (if (fboundp 'x-set-selection)
 185       'x-set-selection)
 186   "Function to call to set selection.
 187 Called with two arguments:
 188
 189   SELECTION, the name of the selection concerned, and
 190   VALUE, the text to store.")
 191
 192 (defvar mouse-sel-get-selection-function
 193   (if (fboundp 'x-get-selection)
 194       'x-get-selection)
 195   "Function to call to get the selection.
 196 Called with one argument:
 197
 198    SELECTION: the name of the selection concerned.")
 199
 200 (defvar mouse-sel-selection-owner-p-function
 201   (if (fboundp 'x-selection-owner-p)
 202       'x-selection-owner-p)
 203   "Function to check whether Emacs still owns the selection.
 204 Called with one argument:
 205
 206    SELECTION: the name of the selection concerned.")
 207
 208 ;;=== Support/access functions ============================================
 209
 210 (defun mouse-sel-determine-selection-thing (nclicks)
 211   "Determine what `thing' `mouse-sel' should operate on.
 212 The first argument is NCLICKS, is the number of consecutive
 213 mouse clicks at the same position.
 214
 215 Double-clicking on word constituents selects words.
 216 Double-clicking on symbol constituents selects symbols.
 217 Double-clicking on quotes or parentheses selects sexps.
 218 Double-clicking on whitespace selects whitespace.
 219 Triple-clicking selects lines.
 220 Quad-clicking selects paragraphs.
 221
 222 Feel free to re-define this function to support your own desired
 223 multi-click semantics."
 224   (let* ((next-char (char-after (point)))
 225          (char-syntax (if next-char (char-syntax next-char))))
 226     (if mouse-sel-cycle-clicks
 227         (setq nclicks (1+ (% (1- nclicks) 4))))
 228     (cond
 229      ((= nclicks 1) nil)
 230      ((= nclicks 3) 'line)
 231      ((>= nclicks 4) 'paragraph)
 232      ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp)
 233      ((memq next-char '(? ?\t ?\n)) 'whitespace)
 234      ((eq char-syntax ?_) 'symbol)
 235      ((eq char-syntax ?w) 'word))))
 236
 237 (defun mouse-sel-set-selection (selection value)
 238   "Set the specified SELECTION to VALUE."
 239   (if mouse-sel-set-selection-function
 240       (funcall mouse-sel-set-selection-function selection value)
 241     (put 'mouse-sel-internal-selection selection value)))
 242
 243 (defun mouse-sel-get-selection (selection)
 244   "Get the value of the specified SELECTION."
 245   (if mouse-sel-get-selection-function
 246       (funcall mouse-sel-get-selection-function selection)
 247     (get 'mouse-sel-internal-selection selection)))
 248
 249 (defun mouse-sel-selection-owner-p (selection)
 250   "Determine whether Emacs owns the specified SELECTION."
 251   (if mouse-sel-selection-owner-p-function
 252       (funcall mouse-sel-selection-owner-p-function selection)
 253     t))
 254
 255 (defun mouse-sel-selection-overlay (selection)
 256   "Return overlay corresponding to SELECTION."
 257   (let ((symbol (nth 1 (assoc selection mouse-sel-selection-alist))))
 258     (or symbol (error "No overlay corresponding to %s selection" selection))
 259     (symbol-value symbol)))
 260
 261 (defun mouse-sel-selection-thing (selection)
 262   "Return overlay corresponding to SELECTION."
 263   (let ((symbol (nth 2 (assoc selection mouse-sel-selection-alist))))
 264     (or symbol (error "No symbol corresponding to %s selection" selection))
 265     symbol))
 266
 267 (defun mouse-sel-region-to-primary (orig-window)
 268   "Convert region to PRIMARY overlay and deactivate region.
 269 Argument ORIG-WINDOW specifies the window the cursor was in when the
 270 originating command was issued, and is used to determine whether the
 271 region was visible or not."
 272   (if transient-mark-mode
 273       (let ((overlay (mouse-sel-selection-overlay 'PRIMARY)))
 274         (cond
 275          ((and mark-active
 276                (or highlight-nonselected-windows
 277                    (eq orig-window (selected-window))))
 278           ;; Region was visible, so convert region to overlay
 279           (move-overlay overlay (region-beginning) (region-end)
 280                         (current-buffer)))
 281          ((eq orig-window (selected-window))
 282           ;; Point was visible, so set overlay at point
 283           (move-overlay overlay (point) (point) (current-buffer)))
 284          (t
 285           ;; Nothing was visible, so remove overlay
 286           (delete-overlay overlay)))
 287         (setq mark-active nil))))
 288
 289 (defun mouse-sel-primary-to-region (&optional direction)
 290   "Convert PRIMARY overlay to region.
 291 Optional argument DIRECTION specifies the mouse drag direction: a value of
 292 1 indicates that the mouse was dragged left-to-right, otherwise it was
 293 dragged right-to-left."
 294   (let* ((overlay (mouse-sel-selection-overlay 'PRIMARY))
 295          (start (overlay-start overlay))
 296          (end (overlay-end overlay)))
 297     (if (eq start end)
 298         (progn
 299           (if start (goto-char start))
 300           (deactivate-mark))
 301       (if (and mouse-sel-leave-point-near-mouse (eq direction 1))
 302           (progn
 303             (goto-char end)
 304             (push-mark start 'nomsg 'active))
 305         (goto-char start)
 306         (push-mark end 'nomsg 'active)))
 307     (if transient-mark-mode (delete-overlay overlay))))
 308
 309 (defmacro mouse-sel-eval-at-event-end (event &rest forms)
 310   "Evaluate forms at mouse position.
 311 Move to the end position of EVENT, execute FORMS, and restore original
 312 point and window."
 313     (`
 314      (let ((posn (event-end (, event))))
 315        (if posn (mouse-minibuffer-check (, event)))
 316        (if (and posn (not (windowp (posn-window posn))))
 317            (error "Cursor not in text area of window"))
 318        (let (orig-window orig-point-marker)
 319          (setq orig-window (selected-window))
 320          (if posn (select-window (posn-window posn)))
 321          (setq orig-point-marker (point-marker))
 322          (if (and posn (numberp (posn-point posn)))
 323              (goto-char (posn-point posn)))
 324          (unwind-protect
 325              (progn
 326                (,@ forms))
 327            (goto-char (marker-position orig-point-marker))
 328            (move-marker orig-point-marker nil)
 329            (select-window orig-window)
 330            )))))
 331
 332 (put 'mouse-sel-eval-at-event-end 'lisp-indent-hook 1)
 333
 334 ;;=== Select ==============================================================
 335
 336 (defun mouse-select (event)
 337   "Set region/selection using the mouse.
 338
 339 Click sets point & mark to click position.
 340 Dragging extends region/selection.
 341
 342 Multi-clicking selects word/lines/paragraphs, as determined by
 343 'mouse-sel-determine-selection-thing.
 344
 345 Clicking mouse-2 while selecting copies selected text to the kill-ring.
 346 Clicking mouse-1 or mouse-3 kills the selected text.
 347
 348 This should be bound to a down-mouse event."
 349   (interactive "@e")
 350   (let (direction)
 351     (unwind-protect
 352         (setq direction (mouse-select-internal 'PRIMARY event))
 353       (mouse-sel-primary-to-region direction))))
 354
 355 (defun mouse-select-secondary (event)
 356    "Set secondary selection using the mouse.
 357
 358 Click sets the start of the secondary selection to click position.
 359 Dragging extends the secondary selection.
 360
 361 Multi-clicking selects word/lines/paragraphs, as determined by
 362 'mouse-sel-determine-selection-thing.
 363
 364 Clicking mouse-2 while selecting copies selected text to the kill-ring.
 365 Clicking mouse-1 or mouse-3 kills the selected text.
 366
 367 This should be bound to a down-mouse event."
 368    (interactive "e")
 369   (mouse-select-internal 'SECONDARY event))
 370
 371 (defun mouse-select-internal (selection event)
 372   "Set SELECTION using the mouse."
 373   (mouse-sel-eval-at-event-end event
 374     (let ((thing-symbol (mouse-sel-selection-thing selection))
 375           (overlay (mouse-sel-selection-overlay selection)))
 376       (set thing-symbol
 377            (mouse-sel-determine-selection-thing (event-click-count event)))
 378       (let ((object-bounds (bounds-of-thing-at-point
 379                             (symbol-value thing-symbol))))
 380         (if object-bounds
 381             (progn
 382               (move-overlay overlay
 383                             (car object-bounds) (cdr object-bounds)
 384                             (current-buffer)))
 385           (move-overlay overlay (point) (point) (current-buffer)))))
 386     (mouse-extend-internal selection)))
 387
 388 ;;=== Extend ==============================================================
 389
 390 (defun mouse-extend (event)
 391   "Extend region/selection using the mouse."
 392   (interactive "e")
 393   (let ((orig-window (selected-window))
 394         direction)
 395     (select-window (posn-window (event-end event)))
 396     (unwind-protect
 397         (progn
 398           (mouse-sel-region-to-primary orig-window)
 399           (setq direction (mouse-extend-internal 'PRIMARY event)))
 400       (mouse-sel-primary-to-region direction))))
 401
 402 (defun mouse-extend-secondary (event)
 403   "Extend secondary selection using the mouse."
 404   (interactive "e")
 405   (save-window-excursion
 406     (mouse-extend-internal 'SECONDARY event)))
 407
 408 (defun mouse-extend-internal (selection &optional initial-event)
 409   "Extend specified SELECTION using the mouse.
 410 Track mouse-motion events, adjusting the SELECTION appropriately.
 411 Optional argument INITIAL-EVENT specifies an initial down-mouse event to
 412 process.
 413
 414 See documentation for mouse-select-internal for more details."
 415   (mouse-sel-eval-at-event-end initial-event
 416     (let ((orig-cursor-type
 417            (cdr (assoc 'cursor-type (frame-parameters (selected-frame))))))
 418       (unwind-protect
 419
 420           (let* ((thing-symbol (mouse-sel-selection-thing selection))
 421                  (overlay (mouse-sel-selection-overlay selection))
 422                  (orig-window (selected-window))
 423                  (orig-window-frame (window-frame orig-window))
 424                  (top (nth 1 (window-edges orig-window)))
 425                  (bottom (nth 3 (window-edges orig-window)))
 426                  (mark-active nil)      ; inhibit normal region highlight
 427                  (echo-keystrokes 0)    ; don't echo mouse events
 428                  min max
 429                  direction
 430                  event)
 431
 432             ;; Get current bounds of overlay
 433             (if (eq (overlay-buffer overlay) (current-buffer))
 434                 (setq min (overlay-start overlay)
 435                       max (overlay-end overlay))
 436               (setq min (point)
 437                     max min)
 438               (set thing-symbol nil))
 439
 440
 441             ;; Bar cursor
 442             (if (fboundp 'modify-frame-parameters)
 443                 (modify-frame-parameters (selected-frame)
 444                                          '((cursor-type . bar))))
 445
 446             ;; Handle dragging
 447             (track-mouse
 448
 449               (while (if initial-event  ; Use initial event
 450                          (prog1
 451                              (setq event initial-event)
 452                            (setq initial-event nil))
 453                        (setq event (read-event))
 454                        (and (consp event)
 455                             (memq (car event) '(mouse-movement switch-frame))))
 456
 457                 (let ((selection-thing (symbol-value thing-symbol))
 458                       (end (event-end event)))
 459
 460                   (cond
 461
 462                    ;; Ignore any movement outside the frame
 463                    ((eq (car-safe event) 'switch-frame) nil)
 464                    ((and (posn-window end)
 465                          (not (eq (let ((posn-w (posn-window end)))
 466                                     (if (windowp posn-w)
 467                                         (window-frame posn-w)
 468                                       posn-w))
 469                                   (window-frame orig-window)))) nil)
 470
 471                    ;; Different window, same frame
 472                    ((not (eq (posn-window end) orig-window))
 473                     (let ((end-row (cdr (cdr (mouse-position)))))
 474                       (cond
 475                        ((and end-row (not (bobp)) (< end-row top))
 476                         (mouse-scroll-subr orig-window (- end-row top)
 477                                            overlay max))
 478                        ((and end-row (not (eobp)) (>= end-row bottom))
 479                         (mouse-scroll-subr orig-window (1+ (- end-row bottom))
 480                                            overlay min))
 481                        )))
 482
 483                    ;; On the mode line
 484                    ((eq (posn-point end) 'mode-line)
 485                     (mouse-scroll-subr orig-window 1 overlay min))
 486
 487                    ;; In original window
 488                    (t (goto-char (posn-point end)))
 489
 490                    )
 491
 492                   ;; Determine direction of drag
 493                   (cond
 494                    ((and (not direction) (not (eq min max)))
 495                     (setq direction (if (< (point) (/ (+ min max) 2)) -1 1)))
 496                    ((and (not (eq direction -1)) (<= (point) min))
 497                     (setq direction -1))
 498                    ((and (not (eq direction 1)) (>= (point) max))
 499                     (setq direction 1)))
 500
 501                   (if (not selection-thing) nil
 502
 503                     ;; If dragging forward, goal is next character
 504                     (if (and (eq direction 1) (not (eobp))) (forward-char 1))
 505
 506                     ;; Move to start/end of selected thing
 507                     (let ((goal (point))
 508                           last)
 509                       (goto-char (if (eq 1 direction) min max))
 510                       (condition-case nil
 511                           (progn
 512                             (while (> (* direction (- goal (point))) 0)
 513                               (setq last (point))
 514                               (forward-thing selection-thing direction))
 515                             (let ((end (point)))
 516                               (forward-thing selection-thing (- direction))
 517                               (goto-char
 518                                (if (> (* direction (- goal (point))) 0)
 519                                    end last))))
 520                         (error))))
 521
 522                   ;; Move overlay
 523                   (move-overlay overlay
 524                                 (if (eq 1 direction) min (point))
 525                                 (if (eq -1 direction) max (point))
 526                                 (current-buffer))
 527
 528                   )))                   ; end track-mouse
 529
 530             ;; Finish up after dragging
 531             (let ((overlay-start (overlay-start overlay))
 532                   (overlay-end (overlay-end overlay)))
 533
 534               ;; Set selection
 535               (if (not (eq overlay-start overlay-end))
 536                   (mouse-sel-set-selection
 537                    selection
 538                    (buffer-substring overlay-start overlay-end)))
 539
 540               ;; Handle copy/kill
 541               (let (this-command)
 542                 (cond
 543                  ((eq (event-basic-type last-input-event) 'mouse-2)
 544                   (copy-region-as-kill overlay-start overlay-end)
 545                   (read-event) (read-event))
 546                  ((and (memq (event-basic-type last-input-event)
 547                              '(mouse-1 mouse-3))
 548                        (memq 'down (event-modifiers last-input-event)))
 549                   (kill-region overlay-start overlay-end)
 550                   (move-overlay overlay overlay-start overlay-start)
 551                   (read-event) (read-event))
 552                  ((and (eq (event-basic-type last-input-event) 'mouse-3)
 553                        (memq 'double (event-modifiers last-input-event)))
 554                   (kill-region overlay-start overlay-end)
 555                   (move-overlay overlay overlay-start overlay-start)))))
 556
 557             direction)
 558
 559         ;; Restore cursor
 560         (if (fboundp 'modify-frame-parameters)
 561             (modify-frame-parameters
 562              (selected-frame) (list (cons 'cursor-type orig-cursor-type))))
 563
 564         ))))
 565
 566 ;;=== Paste ===============================================================
 567
 568 (defun mouse-insert-selection (event)
 569   "Insert the contents of the PRIMARY selection at mouse click.
 570 If `mouse-yank-at-point' is non-nil, insert at point instead."
 571   (interactive "e")
 572   (mouse-insert-selection-internal 'PRIMARY event))
 573
 574 (defun mouse-insert-secondary (event)
 575   "Insert the contents of the SECONDARY selection at mouse click.
 576 If `mouse-yank-at-point' is non-nil, insert at point instead."
 577   (interactive "e")
 578   (mouse-insert-selection-internal 'SECONDARY event))
 579
 580 (defun mouse-insert-selection-internal (selection event)
 581   "Insert the contents of the named SELECTION at mouse click.
 582 If `mouse-yank-at-point' is non-nil, insert at point instead."
 583   (or mouse-yank-at-point
 584       (mouse-set-point event))
 585   (if mouse-sel-get-selection-function
 586       (progn
 587         (push-mark (point) 'nomsg)
 588         (insert (or (funcall mouse-sel-get-selection-function selection) "")))))
 589
 590 ;;=== Validate selection ==================================================
 591
 592 (defun mouse-sel-validate-selection ()
 593   "Validate selections in mouse-sel-selection-alist.
 594 For each listed selection, remove the selection overlay if Emacs no longer
 595 owns the selection."
 596   (let ((owner-p-function mouse-sel-selection-owner-p-function)
 597         (alist mouse-sel-selection-alist)
 598         selection overlay)
 599     (if owner-p-function
 600         (while alist
 601           (setq selection (car (car alist))
 602                 overlay (symbol-value (nth 1 (car alist)))
 603                 alist (cdr alist))
 604           (or (funcall owner-p-function selection)
 605               (delete-overlay overlay))))))
 606
 607 (add-hook 'pre-command-hook 'mouse-sel-validate-selection)
 608
 609 ;;=== Key bindings ========================================================
 610
 611 (if (not mouse-sel-default-bindings) nil
 612
 613   (global-unset-key [mouse-1])
 614   (global-unset-key [drag-mouse-1])
 615   (global-unset-key [mouse-3])
 616
 617   (global-set-key [down-mouse-1]        'mouse-select)
 618   (global-set-key [down-mouse-3]        'mouse-extend)
 619
 620   (global-unset-key [M-mouse-1])
 621   (global-unset-key [M-drag-mouse-1])
 622   (global-unset-key [M-mouse-3])
 623
 624   (global-set-key [M-down-mouse-1]      'mouse-select-secondary)
 625   (global-set-key [M-down-mouse-3]      'mouse-extend-secondary)
 626
 627   (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) nil
 628
 629     (global-set-key [mouse-2]           'mouse-insert-selection)
 630
 631     (setq interprogram-cut-function nil
 632           interprogram-paste-function nil))
 633
 634   (global-set-key [M-mouse-2]           'mouse-insert-secondary)
 635
 636   )
 637
 638 ;;=== Bug reporting =======================================================
 639
 640 (defconst mouse-sel-maintainer-address "mikew@gopher.dosli.govt.nz")
 641
 642 (defun mouse-sel-submit-bug-report ()
 643   "Submit a bug report on mouse-sel.el via mail."
 644   (interactive)
 645   (require 'reporter)
 646   (reporter-submit-bug-report
 647    mouse-sel-maintainer-address
 648    (concat "mouse-sel.el "
 649             (or (condition-case nil mouse-sel-version (error))
 650                 "(distributed with Emacs)"))
 651    (list 'transient-mark-mode
 652          'delete-selection-mode
 653          'mouse-sel-default-bindings
 654          'mouse-sel-leave-point-near-mouse
 655          'mouse-sel-cycle-clicks
 656          'mouse-sel-selection-alist
 657          'mouse-sel-set-selection-function
 658          'mouse-sel-get-selection-function
 659          'mouse-sel-selection-owner-p-function
 660          'mouse-yank-at-point)))
 661
 662 ;; mouse-sel.el ends here.