Mercurial > emacs
annotate lisp/mouse-copy.el @ 97528:184bb2071e3f
mail/: Add new (temporary) libaries for which to test Rmail/mbox such
that Rmail/babyl is not affected. This creates a facility/feature
called "pmail" (analagous to "rmail") that can be used independently
from Rmail for testing purposes. The plan is to replace the "rmail"
files eventually and remove "pmail" entirely at that point. In the
interim, interested developers can use either Rmail or Pmail or both
(which is not recommended for the casual User or the faint of heart).
author | Paul Reilly <pmr@pajato.com> |
---|---|
date | Mon, 18 Aug 2008 04:51:28 +0000 |
parents | ee5932bf781d |
children | a9dc0e7c3f2b |
rev | line source |
---|---|
17517 | 1 ;;; mouse-copy.el --- one-click text copy and move |
16321 | 2 |
74442 | 3 ;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005, |
79721 | 4 ;; 2006, 2007, 2008 Free Software Foundation, Inc. |
16321 | 5 |
6 ;; Author: John Heidemann <johnh@ISI.EDU> | |
7 ;; Keywords: mouse | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94101
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
16321 | 12 ;; it under the terms of the GNU General Public License as published by |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94101
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94101
diff
changeset
|
14 ;; (at your option) any later version. |
16321 | 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 | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94101
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
16321 | 23 |
24 ;;; Commentary: | |
25 | |
94101
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
26 ;; What is ``mouse-copy.el''? |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
27 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
28 ;; It provides one-click text copy and move. Rather than the |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
29 ;; standard stroke-out-a-region (down-mouse-1, up-mouse-1) followed |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
30 ;; by a yank (down-mouse-2, up-mouse-2 or C-y), you can now stroke |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
31 ;; out a region and have it automatically pasted at the current |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
32 ;; point. You can also move text just as easily. Although the |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
33 ;; difference may not sound like much, it does make mousing text |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
34 ;; around a lot easier, IMHO. |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
35 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
36 ;; If you like mouse-copy, you should also check out mouse-drag |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
37 ;; for ``one-click scrolling''. |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
38 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
39 ;; To use mouse-copy, place the following in your .emacs file: |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
40 ;; (require 'mouse-copy) |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
41 ;; (global-set-key [M-down-mouse-1] 'mouse-drag-secondary-pasting) |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
42 ;; (global-set-key [M-S-down-mouse-1] 'mouse-drag-secondary-moving) |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
43 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
44 ;; (These definitions override the old binding of M-mouse-1 to |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
45 ;; mouse-drag-secondary. I find I don't use that command much so its |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
46 ;; loss is not important, and it can be made up with a M-mouse-1 |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
47 ;; followed by a M-mouse-3. I personally reserve M-mouse bindings |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
48 ;; for my window manager and bind everything to C-mouse.) |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
49 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
50 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
51 ;; History and related work: |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
52 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
53 ;; One-click copying and moving was inspired by lemacs-19.8. |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
54 ;; Throw-scrolling was inspired by MacPaint's ``hand'' and by Tk's |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
55 ;; mouse-2 scrolling. The package mouse-scroll.el by Tom Wurgler |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
56 ;; <twurgler@goodyear.com> is similar to mouse-drag-throw, but |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
57 ;; doesn't pass clicks through. |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
58 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
59 ;; These functions have been tested in emacs version 19.30, |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
60 ;; and this package has run in the past on 19.25-19.29. |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
61 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
62 ;; Originally mouse-copy was part of a larger package. |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
63 ;; As of 11 July 96 the scrolling functions were split out |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
64 ;; in preparation for incorporation into (the future) emacs-19.32. |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
65 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
66 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
67 ;; Known Bugs: |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
68 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
69 ;; - Highlighting is sub-optimal under 19.29 and XFree86-3.1.1 |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
70 ;; (see \\[mouse-copy-work-around-drag-bug] for details). |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
71 ;; - mouse-drag-secondary-pasting and mouse-drag-secondary-moving |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
72 ;; require X11R5 (or better) and so fail under older versions |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
73 ;; of Open Windows (like that present in Solaris/x86 2.1). |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
74 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
75 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
76 ;; Future plans: |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
77 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
78 ;; I read about the chording features of Plan-9's Acme environment at |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
79 ;; <http://www.zip.com.au/~cs/app/wily/auug.html>. I'd like |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
80 ;; to incorporate some of these ideas into mouse-copy. The only |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
81 ;; lose is that this is not the current Emacs Way Of Doing Things, so |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
82 ;; there would be a learning curve for existing emacs users. |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
83 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
84 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
85 ;; Thanks: |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
86 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
87 ;; Thanks to Kai Grossjohann |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
88 ;; <grossjoh@dusty.informatik.uni-dortmund.de> for reporting bugs, to |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
89 ;; Tom Wurgler <twurgler@goodyear.com> for reporting bugs and |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
90 ;; suggesting fixes, and to Joel Graber <jgraber@ti.com> for |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
91 ;; prompting me to do drag-scrolling and for an initial |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
92 ;; implementation of horizontal drag-scrolling. |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
93 ;; |
26ae5706998a
Fix comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93975
diff
changeset
|
94 ;; -johnh, 11-Jul-96 |
16321 | 95 |
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) | |
73756
7b9a60623646
(mouse-copy-work-around-drag-bug): Fix typo in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
68651
diff
changeset
|
112 "Code to work around a bug in post-19.29 Emacs: it drops mouse-drag events. |
16321 | 113 The problem occurs under XFree86-3.1.1 (X11R6pl11) but not under X11R5, |
73756
7b9a60623646
(mouse-copy-work-around-drag-bug): Fix typo in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
68651
diff
changeset
|
114 and under post-19.29 but not early versions of Emacs. |
16321 | 115 |
116 19.29 and 19.30 seems to drop mouse drag events | |
47122
3629687a948d
(mouse-copy-work-around-drag-bug): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents:
18027
diff
changeset
|
117 sometimes. (Reproducible under XFree86-3.1.1 (X11R6pl11) and |
16321 | 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: | |
47122
3629687a948d
(mouse-copy-work-around-drag-bug): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents:
18027
diff
changeset
|
122 Disable this routine (with (setq mouse-copy-have-drag-bug nil)). |
16321 | 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 | |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47122
diff
changeset
|
153 |
16321 | 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))) | |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47122
diff
changeset
|
184 |
16321 | 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 (save-excursion | |
204 (set-buffer (overlay-buffer mouse-secondary-overlay)) | |
205 (kill-region (overlay-start mouse-secondary-overlay) | |
206 (overlay-end mouse-secondary-overlay))) | |
207 ;; (delete-overlay mouse-secondary-overlay) | |
208 ;; (x-set-selection 'SECONDARY nil) | |
209 ;; (setq mouse-secondary-overlay nil) | |
210 ) | |
211 | |
212 (defun mouse-drag-secondary-moving (start-event) | |
213 "Sweep out a secondary selection, then move it to the current point." | |
214 (interactive "e") | |
215 ;; HACK: We assume that mouse-drag-secondary returns nil if | |
216 ;; there's no secondary selection. This works as of emacs-19.22. | |
217 ;; It's not clear that there's any other way to get this information. | |
218 (if (mouse-drag-secondary start-event) | |
219 (progn | |
220 (mouse-kill-preserving-secondary) | |
221 (insert (x-get-selection 'SECONDARY)))) | |
222 ) | |
223 | |
224 (provide 'mouse-copy) | |
225 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79721
diff
changeset
|
226 ;; arch-tag: 3d50293b-c089-4273-b412-4fc96a5f26ff |
16321 | 227 ;;; mouse-copy.el ends here |