Mercurial > emacs
annotate lisp/mouse-drag.el @ 49287:5cb7e7103296
Don't setup the default fontset and
font-encoding-alist at the top level.
(setup-default-fontset): New function.
(create-fontset-from-fontset-spec): Delete autoload cookie.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Fri, 17 Jan 2003 08:13:39 +0000 |
parents | 096bd345e996 |
children | 695cf19ef79e d7ddb3e565de |
rev | line source |
---|---|
17517 | 1 ;;; mouse-drag.el --- use mouse-2 to do a new style of scrolling |
2 | |
35085
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
3 ;; Copyright (C) 1996, 1997, 2001 Free Software Foundation, Inc. |
16319 | 4 |
16322 | 5 ;; Author: John Heidemann <johnh@ISI.EDU> |
6 ;; Keywords: mouse | |
16319 | 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-drag.el''? | |
28 ;;; | |
29 ;;; Doesn't that scroll bar seem far away when you want to scroll? | |
30 ;;; This module overloads mouse-2 to do ``throw'' scrolling. You | |
31 ;;; click and drag. The distance you move from your original click | |
32 ;;; turns into a scroll amount. The scroll amount is scaled | |
33 ;;; exponentially to make both large moves and short adjustments easy. | |
34 ;;; What this boils down to is that you can easily scroll around the | |
35 ;;; buffer without much mouse movement. Finally, clicks which aren't | |
36 ;;; drags are passed off to the old mouse-2 binding, so old mouse-2 | |
37 ;;; operations (find-file in dired-mode, yanking in most other modes) | |
38 ;;; still work. | |
39 ;;; | |
40 ;;; There is an alternative way to scroll, ``drag'' scrolling. You | |
41 ;;; can click on a character and then drag it around, scrolling the | |
42 ;;; buffer with you. The character always stays under the mouse. | |
43 ;;; Compared to throw-scrolling, this approach provides direct | |
44 ;;; manipulation (nice) but requires more mouse movement | |
45 ;;; (unfortunate). It is offered as an alternative for those who | |
46 ;;; prefer it. | |
47 ;;; | |
48 ;;; If you like mouse-drag, you should also check out mouse-copy | |
49 ;;; for ``one-click text copy and move''. | |
50 ;;; | |
51 ;;; To use mouse-drag, place the following in your .emacs file: | |
52 ;;; (require 'mouse-drag) | |
53 ;;; -and either- | |
54 ;;; (global-set-key [down-mouse-2] 'mouse-drag-throw) | |
55 ;;; -or- | |
56 ;;; (global-set-key [down-mouse-2] 'mouse-drag-drag) | |
57 ;;; | |
58 ;;; | |
59 ;;; | |
60 ;;; Options: | |
61 ;;; | |
62 ;;; - reverse the throw-scroll direction with \\[mouse-throw-with-scroll-bar] | |
63 ;;; - work around a bug with \\[mouse-extras-work-around-drag-bug] | |
18026
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
64 ;;; - auto-enable horizontal scrolling with |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
65 ;;; \\[mouse-drag-electric-col-scrolling] |
16319 | 66 ;;; |
67 ;;; | |
68 ;;; History and related work: | |
69 ;;; | |
70 ;;; One-click copying and moving was inspired by lemacs-19.8. | |
71 ;;; Throw-scrolling was inspired by MacPaint's ``hand'' and by Tk's | |
72 ;;; mouse-2 scrolling. The package mouse-scroll.el by Tom Wurgler | |
73 ;;; <twurgler@goodyear.com> is similar to mouse-drag-throw, but | |
74 ;;; doesn't pass clicks through. | |
75 ;;; | |
76 ;;; These functions have been tested in emacs version 19.30, | |
77 ;;; and this package has run in the past on 19.25-19.29. | |
78 ;;; | |
79 ;;; Originally mouse-drag was part of a larger package. | |
80 ;;; As of 11 July 96 the scrolling functions were split out | |
81 ;;; in preparation for incorporation into (the future) emacs-19.32. | |
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@isi.edu, 11-Jul-96 | |
94 ;;; | |
95 ;;; | |
18026
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
96 ;;; What's new with mouse-drag 2.24? |
16319 | 97 ;;; |
18026
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
98 ;;; - mouse-drag-electric-col-scrolling (default: on) |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
99 ;;; auto-enables horizontal scrolling when clicks on wrapped |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
100 ;;; lines occur |
16319 | 101 |
102 ;;; Code: | |
103 | |
104 ;; | |
105 ;; scrolling code | |
106 ;; | |
107 | |
108 (defun mouse-drag-safe-scroll (row-delta &optional col-delta) | |
18134
2441b667abdd
(mouse-drag-safe-scroll): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
18026
diff
changeset
|
109 "Scroll down ROW-DELTA lines and right COL-DELTA, ignoring buffer edge errors. |
16319 | 110 Keep the cursor on the screen as needed." |
35085
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
111 (let ((scroll-preserve-screen-position nil)) |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
112 (if (and row-delta |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
113 (/= 0 row-delta)) |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
114 (condition-case nil ;; catch and ignore movement errors |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
115 (scroll-down row-delta) |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
116 (beginning-of-buffer (message "Beginning of buffer")) |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
117 (end-of-buffer (message "End of buffer")))) |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
118 (if (and col-delta |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
119 (/= 0 col-delta)) |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
120 (progn |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
121 (scroll-right col-delta) |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
122 ;; Make sure that the point stays on the visible screen |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
123 ;; (if truncation-lines in set). |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
124 ;; This code mimics the behavior we automatically get |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
125 ;; when doing vertical scrolling. |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
126 ;; Problem identified and a fix suggested by Tom Wurgler. |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
127 (cond |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
128 ((< (current-column) (window-hscroll)) |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
129 (move-to-column (window-hscroll))) ; make on left column |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
130 ((> (- (current-column) (window-hscroll) (window-width) -2) 0) |
acc3474759c0
(mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents:
18134
diff
changeset
|
131 (move-to-column (+ (window-width) (window-hscroll) -3)))))))) |
16319 | 132 |
133 (defun mouse-drag-repeatedly-safe-scroll (row-delta &optional col-delta) | |
18134
2441b667abdd
(mouse-drag-safe-scroll): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
18026
diff
changeset
|
134 "Scroll ROW-DELTA rows and COL-DELTA cols until an event happens." |
16319 | 135 (while (sit-for mouse-scroll-delay) |
136 (mouse-drag-safe-scroll row-delta col-delta))) | |
137 | |
138 (defun mouse-drag-events-are-point-events-p (start-posn end-posn) | |
18134
2441b667abdd
(mouse-drag-safe-scroll): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
18026
diff
changeset
|
139 "Determine if START-POSN and END-POSN are \"close\"." |
16319 | 140 (let* |
141 ((start-col-row (posn-col-row start-posn)) | |
142 (end-col-row (posn-col-row end-posn))) | |
143 (and | |
144 ;; We no longer exclude things by time. | |
145 ;; (< (- (posn-timestamp end-posn) (posn-timestamp start-posn)) | |
146 ;; (if (numberp double-click-time) | |
147 ;; (* 2 double-click-time) ;; stretch it a little | |
148 ;; 999999)) ;; non-numeric => check by position alone | |
149 (= (car start-col-row) (car end-col-row)) | |
150 (= (cdr start-col-row) (cdr end-col-row))))) | |
151 | |
18026
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
152 (defvar mouse-drag-electric-col-scrolling t |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
153 "If non-nil, mouse-drag on a long line enables truncate-lines.") |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
154 |
16319 | 155 (defun mouse-drag-should-do-col-scrolling () |
18134
2441b667abdd
(mouse-drag-safe-scroll): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
18026
diff
changeset
|
156 "Determine if it's wise to enable col-scrolling for the current window. |
18026
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
157 Basically, we check for existing horizontal scrolling." |
16319 | 158 (or truncate-lines |
159 (> (window-hscroll (selected-window)) 0) | |
35141
0153adccc03d
(mouse-drag-should-do-col-scrolling): Change screen-width to frame-width.
Richard M. Stallman <rms@gnu.org>
parents:
35085
diff
changeset
|
160 (< (window-width) (frame-width)) |
18026
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
161 (and |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
162 mouse-drag-electric-col-scrolling |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
163 (save-excursion ;; on a long line? |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
164 (let |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
165 ((beg (progn (beginning-of-line) (point))) |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
166 (end (progn (end-of-line) (point)))) |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
167 (if (> (- end beg) (window-width)) |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
168 (setq truncate-lines t) |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
169 nil)))))) |
16319 | 170 |
171 (defvar mouse-throw-with-scroll-bar nil | |
18134
2441b667abdd
(mouse-drag-safe-scroll): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
18026
diff
changeset
|
172 "*Set direction of mouse-throwing. |
16319 | 173 If nil, the text moves in the direction the mouse moves. |
174 If t, the scroll bar moves in the direction the mouse moves.") | |
18134
2441b667abdd
(mouse-drag-safe-scroll): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
18026
diff
changeset
|
175 (defconst mouse-throw-magnifier-with-scroll-bar |
16319 | 176 [-16 -8 -4 -2 -1 0 0 0 1 2 4 8 16]) |
177 (defconst mouse-throw-magnifier-with-mouse-movement | |
178 [ 16 8 4 2 1 0 0 0 -1 -2 -4 -8 -16]) | |
179 (defconst mouse-throw-magnifier-min -6) | |
180 (defconst mouse-throw-magnifier-max 6) | |
181 | |
182 (defun mouse-drag-throw (start-event) | |
183 "\"Throw\" the page according to a mouse drag. | |
184 | |
185 A \"throw\" is scrolling the page at a speed relative to the distance | |
186 from the original mouse click to the current mouse location. Try it; | |
187 you'll like it. It's easier to observe than to explain. | |
188 | |
189 If the mouse is clicked and released in the same place of time we | |
190 assume that the user didn't want to scdebugroll but wanted to whatever | |
191 mouse-2 used to do, so we pass it through. | |
192 | |
193 Throw scrolling was inspired (but is not identical to) the \"hand\" | |
194 option in MacPaint, or the middle button in Tk text widgets. | |
195 | |
196 If `mouse-throw-with-scroll-bar' is non-nil, then this command scrolls | |
197 in the opposite direction. (Different people have different ideas | |
198 about which direction is natural. Perhaps it has to do with which | |
199 hemisphere you're in.) | |
200 | |
201 To test this function, evaluate: | |
202 (global-set-key [down-mouse-2] 'mouse-drag-throw)" | |
203 (interactive "e") | |
204 ;; we want to do save-selected-window, but that requires 19.29 | |
205 (let* ((start-posn (event-start start-event)) | |
206 (start-window (posn-window start-posn)) | |
207 (start-row (cdr (posn-col-row start-posn))) | |
208 (start-col (car (posn-col-row start-posn))) | |
209 (old-selected-window (selected-window)) | |
210 event end row mouse-delta scroll-delta | |
41217
096bd345e996
(mouse-drag-throw): Push back non-drag events
Richard M. Stallman <rms@gnu.org>
parents:
35141
diff
changeset
|
211 have-scrolled |
16319 | 212 window-last-row |
213 col mouse-col-delta window-last-col | |
214 (scroll-col-delta 0) | |
215 adjusted-mouse-col-delta | |
16320
56f494ed6b13
(mouse-drag-throw): Bind adjusted-mouse-delta.
Richard M. Stallman <rms@gnu.org>
parents:
16319
diff
changeset
|
216 adjusted-mouse-delta |
16319 | 217 ;; be conservative about allowing horizontal scrolling |
218 (col-scrolling-p (mouse-drag-should-do-col-scrolling))) | |
219 (select-window start-window) | |
220 (track-mouse | |
221 (while (progn | |
222 (setq event (read-event) | |
223 end (event-end event) | |
224 row (cdr (posn-col-row end)) | |
225 col (car (posn-col-row end))) | |
226 (or (mouse-movement-p event) | |
227 (eq (car-safe event) 'switch-frame))) | |
228 (if (eq start-window (posn-window end)) | |
229 (progn | |
230 (setq mouse-delta (- start-row row) | |
231 adjusted-mouse-delta | |
232 (- (cond | |
233 ((<= mouse-delta mouse-throw-magnifier-min) | |
234 mouse-throw-magnifier-min) | |
235 ((>= mouse-delta mouse-throw-magnifier-max) | |
236 mouse-throw-magnifier-max) | |
237 (t mouse-delta)) | |
238 mouse-throw-magnifier-min) | |
239 scroll-delta (aref (if mouse-throw-with-scroll-bar | |
240 mouse-throw-magnifier-with-scroll-bar | |
241 mouse-throw-magnifier-with-mouse-movement) | |
242 adjusted-mouse-delta)) | |
243 (if col-scrolling-p | |
244 (setq mouse-col-delta (- start-col col) | |
245 adjusted-mouse-col-delta | |
246 (- (cond | |
247 ((<= mouse-col-delta mouse-throw-magnifier-min) | |
248 mouse-throw-magnifier-min) | |
249 ((>= mouse-col-delta mouse-throw-magnifier-max) | |
250 mouse-throw-magnifier-max) | |
251 (t mouse-col-delta)) | |
252 mouse-throw-magnifier-min) | |
253 scroll-col-delta (aref (if mouse-throw-with-scroll-bar | |
254 mouse-throw-magnifier-with-scroll-bar | |
255 mouse-throw-magnifier-with-mouse-movement) | |
256 adjusted-mouse-col-delta))))) | |
257 (if (or (/= 0 scroll-delta) | |
258 (/= 0 scroll-col-delta)) | |
259 (progn | |
260 (setq have-scrolled t) | |
261 (mouse-drag-safe-scroll scroll-delta scroll-col-delta) | |
262 (mouse-drag-repeatedly-safe-scroll scroll-delta scroll-col-delta))))) ;xxx | |
263 ;; If it was a click and not a drag, prepare to pass the event on. | |
41217
096bd345e996
(mouse-drag-throw): Push back non-drag events
Richard M. Stallman <rms@gnu.org>
parents:
35141
diff
changeset
|
264 ;; Is there a more correct way to reconstruct the event? |
16319 | 265 (if (and (not have-scrolled) |
266 (mouse-drag-events-are-point-events-p start-posn end)) | |
41217
096bd345e996
(mouse-drag-throw): Push back non-drag events
Richard M. Stallman <rms@gnu.org>
parents:
35141
diff
changeset
|
267 (push (cons (event-basic-type start-event) (cdr start-event)) |
096bd345e996
(mouse-drag-throw): Push back non-drag events
Richard M. Stallman <rms@gnu.org>
parents:
35141
diff
changeset
|
268 unread-command-events)) |
16319 | 269 ;; Now restore the old window. |
41217
096bd345e996
(mouse-drag-throw): Push back non-drag events
Richard M. Stallman <rms@gnu.org>
parents:
35141
diff
changeset
|
270 (select-window old-selected-window))) |
16319 | 271 |
272 (defun mouse-drag-drag (start-event) | |
273 "\"Drag\" the page according to a mouse drag. | |
274 | |
275 Drag scrolling moves the page according to the movement of the mouse. | |
276 You \"grab\" the character under the mouse and move it around. | |
277 | |
278 If the mouse is clicked and released in the same place of time we | |
279 assume that the user didn't want to scroll but wanted to whatever | |
280 mouse-2 used to do, so we pass it through. | |
281 | |
282 Drag scrolling is identical to the \"hand\" option in MacPaint, or the | |
283 middle button in Tk text widgets. | |
284 | |
285 To test this function, evaluate: | |
286 (global-set-key [down-mouse-2] 'mouse-drag-drag)" | |
287 (interactive "e") | |
288 ;; we want to do save-selected-window, but that requires 19.29 | |
289 (let* ((start-posn (event-start start-event)) | |
290 (start-window (posn-window start-posn)) | |
291 (start-row (cdr (posn-col-row start-posn))) | |
292 (start-col (car (posn-col-row start-posn))) | |
293 (old-selected-window (selected-window)) | |
294 event end row mouse-delta scroll-delta | |
41217
096bd345e996
(mouse-drag-throw): Push back non-drag events
Richard M. Stallman <rms@gnu.org>
parents:
35141
diff
changeset
|
295 have-scrolled |
16319 | 296 window-last-row |
297 col mouse-col-delta window-last-col | |
298 (scroll-col-delta 0) | |
299 ;; be conservative about allowing horizontal scrolling | |
300 (col-scrolling-p (mouse-drag-should-do-col-scrolling))) | |
301 (select-window start-window) | |
302 (setq window-last-row (- (window-height) 2) | |
303 window-last-col (- (window-width) 2)) | |
304 (track-mouse | |
305 (while (progn | |
306 (setq event (read-event) | |
307 end (event-end event) | |
308 row (cdr (posn-col-row end)) | |
309 col (car (posn-col-row end))) | |
310 (or (mouse-movement-p event) | |
311 (eq (car-safe event) 'switch-frame))) | |
312 ;; Scroll if see if we're on the edge. | |
313 ;; NEEDSWORK: should handle mouse-in-other window. | |
314 (cond | |
315 ((not (eq start-window (posn-window end))) | |
316 t) ; wait for return to original window | |
317 ((<= row 0) (mouse-drag-repeatedly-safe-scroll -1 0)) | |
318 ((>= row window-last-row) (mouse-drag-repeatedly-safe-scroll 1 0)) | |
319 ((and col-scrolling-p (<= col 1)) (mouse-drag-repeatedly-safe-scroll 0 -1)) | |
320 ((and col-scrolling-p (>= col window-last-col)) (mouse-drag-repeatedly-safe-scroll 0 1)) | |
321 (t | |
322 (setq scroll-delta (- row start-row) | |
323 start-row row) | |
324 (if col-scrolling-p | |
325 (setq scroll-col-delta (- col start-col) | |
326 start-col col)) | |
327 (if (or (/= 0 scroll-delta) | |
328 (/= 0 scroll-col-delta)) | |
329 (progn | |
330 (setq have-scrolled t) | |
331 (mouse-drag-safe-scroll scroll-delta scroll-col-delta))))))) | |
332 ;; If it was a click and not a drag, prepare to pass the event on. | |
41217
096bd345e996
(mouse-drag-throw): Push back non-drag events
Richard M. Stallman <rms@gnu.org>
parents:
35141
diff
changeset
|
333 ;; Is there a more correct way to reconstruct the event? |
16319 | 334 (if (and (not have-scrolled) |
335 (mouse-drag-events-are-point-events-p start-posn end)) | |
41217
096bd345e996
(mouse-drag-throw): Push back non-drag events
Richard M. Stallman <rms@gnu.org>
parents:
35141
diff
changeset
|
336 (push (cons (event-basic-type start-event) (cdr start-event)) |
096bd345e996
(mouse-drag-throw): Push back non-drag events
Richard M. Stallman <rms@gnu.org>
parents:
35141
diff
changeset
|
337 unread-command-events)) |
16319 | 338 ;; Now restore the old window. |
41217
096bd345e996
(mouse-drag-throw): Push back non-drag events
Richard M. Stallman <rms@gnu.org>
parents:
35141
diff
changeset
|
339 (select-window old-selected-window))) |
096bd345e996
(mouse-drag-throw): Push back non-drag events
Richard M. Stallman <rms@gnu.org>
parents:
35141
diff
changeset
|
340 |
16319 | 341 |
342 (provide 'mouse-drag) | |
343 | |
344 ;;; mouse-drag.el ends here |