comparison lisp/mouse-copy.el @ 16321:af6d52a93a59

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