code.delx.au - gnu-emacs/blob - lisp/mouse-copy.el

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