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