lisp/mouse-copy.el

   1 ;;; mouse-copy.el --- one-click text copy and move
   2
   3 ;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005,
   4 ;;   2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
   5
   6 ;; Author: John Heidemann <johnh@ISI.EDU>
   7 ;; Keywords: mouse
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; What is ``mouse-copy.el''?
  27 ;;
  28 ;; It provides one-click text copy and move.  Rather than the
  29 ;; standard stroke-out-a-region (down-mouse-1, up-mouse-1) followed
  30 ;; by a yank (down-mouse-2, up-mouse-2 or C-y), you can now stroke
  31 ;; out a region and have it automatically pasted at the current
  32 ;; point.  You can also move text just as easily.  Although the
  33 ;; difference may not sound like much, it does make mousing text
  34 ;; around a lot easier, IMHO.
  35 ;;
  36 ;; If you like mouse-copy, you should also check out mouse-drag
  37 ;; for ``one-click scrolling''.
  38 ;;
  39 ;; To use mouse-copy, place the following in your .emacs file:
  40 ;;      (require 'mouse-copy)
  41 ;;     (global-set-key [M-down-mouse-1] 'mouse-drag-secondary-pasting)
  42 ;;     (global-set-key [M-S-down-mouse-1] 'mouse-drag-secondary-moving)
  43 ;;
  44 ;; (These definitions override the old binding of M-mouse-1 to
  45 ;; mouse-drag-secondary.  I find I don't use that command much so its
  46 ;; loss is not important, and it can be made up with a M-mouse-1
  47 ;; followed by a M-mouse-3.  I personally reserve M-mouse bindings
  48 ;; for my window manager and bind everything to C-mouse.)
  49 ;;
  50 ;;
  51 ;; History and related work:
  52 ;;
  53 ;; One-click copying and moving was inspired by lemacs-19.8.
  54 ;; Throw-scrolling was inspired by MacPaint's ``hand'' and by Tk's
  55 ;; mouse-2 scrolling.  The package mouse-scroll.el by Tom Wurgler
  56 ;; <twurgler@goodyear.com> is similar to mouse-drag-throw, but
  57 ;; doesn't pass clicks through.
  58 ;;
  59 ;; These functions have been tested in emacs version 19.30,
  60 ;; and this package has run in the past on 19.25-19.29.
  61 ;;
  62 ;; Originally mouse-copy was part of a larger package.
  63 ;; As of 11 July 96 the scrolling functions were split out
  64 ;; in preparation for incorporation into (the future) emacs-19.32.
  65 ;;
  66 ;;
  67 ;; Known Bugs:
  68 ;;
  69 ;; - Highlighting is sub-optimal under 19.29 and XFree86-3.1.1
  70 ;;   (see \\[mouse-copy-work-around-drag-bug] for details).
  71 ;; - mouse-drag-secondary-pasting and mouse-drag-secondary-moving
  72 ;;   require X11R5 (or better) and so fail under older versions
  73 ;;   of Open Windows (like that present in Solaris/x86 2.1).
  74 ;;
  75 ;;
  76 ;; Future plans:
  77 ;;
  78 ;; I read about the chording features of Plan-9's Acme environment at
  79 ;; <http://www.zip.com.au/~cs/app/wily/auug.html>.  I'd like
  80 ;; to incorporate some of these ideas into mouse-copy.  The only
  81 ;; lose is that this is not the current Emacs Way Of Doing Things, so
  82 ;; there would be a learning curve for existing emacs users.
  83 ;;
  84 ;;
  85 ;; Thanks:
  86 ;;
  87 ;; Thanks to Kai Grossjohann
  88 ;; <grossjoh@dusty.informatik.uni-dortmund.de> for reporting bugs, to
  89 ;; Tom Wurgler <twurgler@goodyear.com> for reporting bugs and
  90 ;; suggesting fixes, and to Joel Graber <jgraber@ti.com> for
  91 ;; prompting me to do drag-scrolling and for an initial
  92 ;; implementation of horizontal drag-scrolling.
  93 ;;
  94 ;;    -johnh, 11-Jul-96
  95 \f
  96 ;;; Code:
  97
  98 ;;
  99 ;; move/paste code
 100 ;;
 101
 102 (defvar mouse-copy-last-paste-start nil
 103   "Internal to `mouse-drag-secondary-pasting'.")
 104 (defvar mouse-copy-last-paste-end nil
 105   "Internal to `mouse-drag-secondary-pasting'.")
 106
 107 (defvar mouse-copy-have-drag-bug nil
 108   "Set to enable mouse-copy-work-around-drag-bug.
 109 See `mouse-copy-work-around-drag-bug' for details.")
 110
 111 (defun mouse-copy-work-around-drag-bug (start-event end-event)
 112   "Code to work around a bug in post-19.29 Emacs: it drops mouse-drag events.
 113 The problem occurs under XFree86-3.1.1 (X11R6pl11) but not under X11R5,
 114 and under post-19.29 but not early versions of Emacs.
 115
 116 19.29 and 19.30 seems to drop mouse drag events
 117 sometimes. (Reproducible under XFree86-3.1.1 (X11R6pl11) and
 118 XFree86-3.1.2 under Linux 1.2.x.  Doesn't occur under X11R5 and SunOS
 119 4.1.1.)
 120
 121 To see if you have the problem:
 122 Disable this routine (with (setq mouse-copy-have-drag-bug nil)).
 123 Click and drag for a while.
 124 If highlighting stops tracking, you have the bug.
 125 If you have the bug (or the real fix :-), please let me know."
 126
 127   ;; To work-around, call mouse-set-secondary with a fake
 128   ;; drag event to set the overlay,
 129   ;; the load the x-selection.
 130   (save-excursion
 131     (let*
 132         ((start-posn (event-start start-event))
 133          (end-posn (event-end end-event))
 134          (end-buffer (window-buffer (posn-window end-posn)))
 135          ;; First, figure out the region (left as point/mark).
 136          (range (progn
 137                   (set-buffer end-buffer)
 138                   (mouse-start-end (posn-point start-posn)
 139                                  (posn-point end-posn)
 140                                  (1- (event-click-count start-event)))))
 141          (beg (car range))
 142          (end (car (cdr range))))
 143       ;; Second, set the overlay.
 144       (if mouse-secondary-overlay
 145           (move-overlay mouse-secondary-overlay beg end)
 146         (setq mouse-secondary-overlay (make-overlay beg (posn-point end))))
 147       (overlay-put mouse-secondary-overlay 'face 'secondary-selection)
 148       ;; Third, set the selection.
 149       ;; (setq me-beg beg me-end end me-range range)  ; for debugging
 150       (set-buffer end-buffer)
 151       (x-set-selection 'SECONDARY (buffer-substring beg end)))))
 152
 153
 154 (defun mouse-drag-secondary-pasting (start-event)
 155   "Drag out a secondary selection, then paste it at the current point.
 156
 157 To test this function, evaluate:
 158         (global-set-key [M-down-mouse-1] 'mouse-drag-secondary-pasting)
 159 put the point at one place, then click and drag over some other region."
 160   (interactive "e")
 161   ;; Work-around: We see and react to each part of a multi-click event
 162   ;; as it proceeds.  For a triple-event, this means the double-event
 163   ;; has already copied something that the triple-event will re-copy
 164   ;; (a Bad Thing).  We therefore undo the prior insertion if we're on
 165   ;; a multiple event.
 166   (if (and mouse-copy-last-paste-start
 167            (>= (event-click-count start-event) 2))
 168       (delete-region mouse-copy-last-paste-start
 169                      mouse-copy-last-paste-end))
 170
 171   ;; HACK: We assume that mouse-drag-secondary returns nil if
 172   ;; there's no secondary selection.  This assumption holds as of
 173   ;; emacs-19.22 but is not documented.  It's not clear that there's
 174   ;; any other way to get this information.
 175   (if (mouse-drag-secondary start-event)
 176       (progn
 177         (if mouse-copy-have-drag-bug
 178             (mouse-copy-work-around-drag-bug start-event last-input-event))
 179         ;; Remember what we do so we can undo it, if necessary.
 180         (setq mouse-copy-last-paste-start (point))
 181         (insert (x-get-selection 'SECONDARY))
 182         (setq mouse-copy-last-paste-end (point)))
 183     (setq mouse-copy-last-paste-start nil)))
 184
 185
 186 (defun mouse-kill-preserving-secondary ()
 187   "Kill the text in the secondary selection, but leave the selection set.
 188
 189 This command is like \\[mouse-kill-secondary] (that is, the secondary
 190 selection is deleted and placed in the kill ring), except that it also
 191 leaves the secondary buffer active on exit.
 192
 193 This command was derived from mouse-kill-secondary in emacs-19.28
 194 by johnh@ficus.cs.ucla.edu."
 195   (interactive)
 196   (let* ((keys (this-command-keys))
 197          (click (elt keys (1- (length keys)))))
 198     (or (eq (overlay-buffer mouse-secondary-overlay)
 199             (if (listp click)
 200                 (window-buffer (posn-window (event-start click)))
 201               (current-buffer)))
 202         (error "Select or click on the buffer where the secondary selection is")))
 203   (with-current-buffer (overlay-buffer mouse-secondary-overlay)
 204     (kill-region (overlay-start mouse-secondary-overlay)
 205                  (overlay-end mouse-secondary-overlay)))
 206   ;; (delete-overlay mouse-secondary-overlay)
 207   ;; (x-set-selection 'SECONDARY nil)
 208   ;; (setq mouse-secondary-overlay nil)
 209 )
 210
 211 (defun mouse-drag-secondary-moving (start-event)
 212   "Sweep out a secondary selection, then move it to the current point."
 213   (interactive "e")
 214   ;; HACK:  We assume that mouse-drag-secondary returns nil if
 215   ;; there's no secondary selection.  This works as of emacs-19.22.
 216   ;; It's not clear that there's any other way to get this information.
 217   (if (mouse-drag-secondary start-event)
 218       (progn
 219         (mouse-kill-preserving-secondary)
 220         (insert (x-get-selection 'SECONDARY))))
 221 )
 222
 223 (provide 'mouse-copy)
 224
 225 ;; arch-tag: 3d50293b-c089-4273-b412-4fc96a5f26ff
 226 ;;; mouse-copy.el ends here