annotate lisp/mouse-drag.el @ 103653:b951fe72ccf7

(SOME_MACHINE_LISP): Add ../lisp/term/common-win.elc.
author YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
date Wed, 01 Jul 2009 08:55:33 +0000
parents a9dc0e7c3f2b
children 1d1d5d9bd884
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
17517
8f952e921136 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 16322
diff changeset
1 ;;; mouse-drag.el --- use mouse-2 to do a new style of scrolling
8f952e921136 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 16322
diff changeset
2
64762
41bb365f41c4 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 64091
diff changeset
3 ;; Copyright (C) 1996, 1997, 2001, 2002, 2003, 2004,
100908
a9dc0e7c3f2b Add 2009 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 96510
diff changeset
4 ;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5
16322
f4be70df6bb6 Comment changes.
Richard M. Stallman <rms@gnu.org>
parents: 16320
diff changeset
6 ;; Author: John Heidemann <johnh@ISI.EDU>
f4be70df6bb6 Comment changes.
Richard M. Stallman <rms@gnu.org>
parents: 16320
diff changeset
7 ;; Keywords: mouse
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10
94678
ee5932bf781d Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94102
diff changeset
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
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: 94102
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: 94102
diff changeset
14 ;; (at your option) any later version.
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19 ;; GNU General Public License for more details.
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
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: 94102
diff changeset
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
23
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
24 ;;; Commentary:
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25
94100
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
26 ;; What is ``mouse-drag.el''?
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
27 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
28 ;; Doesn't that scroll bar seem far away when you want to scroll?
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
29 ;; This module overloads mouse-2 to do ``throw'' scrolling. You
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
30 ;; click and drag. The distance you move from your original click
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
31 ;; turns into a scroll amount. The scroll amount is scaled
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
32 ;; exponentially to make both large moves and short adjustments easy.
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
33 ;; What this boils down to is that you can easily scroll around the
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
34 ;; buffer without much mouse movement. Finally, clicks which aren't
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
35 ;; drags are passed off to the old mouse-2 binding, so old mouse-2
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
36 ;; operations (find-file in dired-mode, yanking in most other modes)
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
37 ;; still work.
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
38 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
39 ;; There is an alternative way to scroll, ``drag'' scrolling. You
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
40 ;; can click on a character and then drag it around, scrolling the
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
41 ;; buffer with you. The character always stays under the mouse.
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
42 ;; Compared to throw-scrolling, this approach provides direct
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
43 ;; manipulation (nice) but requires more mouse movement
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
44 ;; (unfortunate). It is offered as an alternative for those who
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
45 ;; prefer it.
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
46 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
47 ;; If you like mouse-drag, you should also check out mouse-copy
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
48 ;; for ``one-click text copy and move''.
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
49 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
50 ;; To use mouse-drag, place the following in your .emacs file:
96510
ad09327f37a0 (mouse-drag-throw, mouse-drag-drag): Autoload.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 94678
diff changeset
51 ;; -either-
94100
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
52 ;; (global-set-key [down-mouse-2] 'mouse-drag-throw)
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
53 ;; -or-
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
54 ;; (global-set-key [down-mouse-2] 'mouse-drag-drag)
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
55 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
56 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
57 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
58 ;; Options:
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
59 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
60 ;; - reverse the throw-scroll direction with \\[mouse-throw-with-scroll-bar]
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
61 ;; - work around a bug with \\[mouse-extras-work-around-drag-bug]
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
62 ;; - auto-enable horizontal scrolling with
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
63 ;; \\[mouse-drag-electric-col-scrolling]
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
64 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
65 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
66 ;; History and related work:
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
67 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
68 ;; One-click copying and moving was inspired by lemacs-19.8.
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
69 ;; Throw-scrolling was inspired by MacPaint's ``hand'' and by Tk's
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
70 ;; mouse-2 scrolling. The package mouse-scroll.el by Tom Wurgler
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
71 ;; <twurgler@goodyear.com> is similar to mouse-drag-throw, but
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
72 ;; doesn't pass clicks through.
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
73 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
74 ;; These functions have been tested in emacs version 19.30,
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
75 ;; and this package has run in the past on 19.25-19.29.
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
76 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
77 ;; Originally mouse-drag was part of a larger package.
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
78 ;; As of 11 July 96 the scrolling functions were split out
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
79 ;; in preparation for incorporation into (the future) emacs-19.32.
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
80 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
81 ;; Thanks:
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
82 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
83 ;; Thanks to Kai Grossjohann
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
84 ;; <grossjoh@dusty.informatik.uni-dortmund.de> for reporting bugs, to
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
85 ;; Tom Wurgler <twurgler@goodyear.com> for reporting bugs and
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
86 ;; suggesting fixes, and to Joel Graber <jgraber@ti.com> for
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
87 ;; prompting me to do drag-scrolling and for an initial
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
88 ;; implementation of horizontal drag-scrolling.
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
89 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
90 ;; -johnh@isi.edu, 11-Jul-96
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
91 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
92 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
93 ;; What's new with mouse-drag 2.24?
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
94 ;;
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
95 ;; - mouse-drag-electric-col-scrolling (default: on)
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
96 ;; auto-enables horizontal scrolling when clicks on wrapped
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
97 ;; lines occur
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
98
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
99 ;; TODO:
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
100 ;; - For mouse-drag-throw, we should try and place some visual indicator
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
101 ;; of the original mouse position (like Firefox does).
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
102
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
103 ;;; Code:
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
104
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
105 ;;
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
106 ;; scrolling code
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
107 ;;
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
108
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
109 (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
110 "Scroll down ROW-DELTA lines and right COL-DELTA, ignoring buffer edge errors.
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
111 Keep the cursor on the screen as needed."
35085
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
112 (let ((scroll-preserve-screen-position nil))
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
113 (if (and row-delta
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
114 (/= 0 row-delta))
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
115 (condition-case nil ;; catch and ignore movement errors
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
116 (scroll-down row-delta)
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
117 (beginning-of-buffer (message "Beginning of buffer"))
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
118 (end-of-buffer (message "End of buffer"))))
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
119 (if (and col-delta
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
120 (/= 0 col-delta))
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
121 (progn
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
122 (scroll-right col-delta)
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
123 ;; 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
124 ;; (if truncation-lines in set).
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
125 ;; This code mimics the behavior we automatically get
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
126 ;; when doing vertical scrolling.
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
127 ;; Problem identified and a fix suggested by Tom Wurgler.
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
128 (cond
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
129 ((< (current-column) (window-hscroll))
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
130 (move-to-column (window-hscroll))) ; make on left column
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
131 ((> (- (current-column) (window-hscroll) (window-width) -2) 0)
acc3474759c0 (mouse-drag-safe-scroll): Bind
Gerd Moellmann <gerd@gnu.org>
parents: 18134
diff changeset
132 (move-to-column (+ (window-width) (window-hscroll) -3))))))))
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
133
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
134 (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
135 "Scroll ROW-DELTA rows and COL-DELTA cols until an event happens."
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
136 (while (sit-for mouse-scroll-delay)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
137 (mouse-drag-safe-scroll row-delta col-delta)))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
138
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
139 (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
140 "Determine if START-POSN and END-POSN are \"close\"."
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
141 (let*
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
142 ((start-col-row (posn-col-row start-posn))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
143 (end-col-row (posn-col-row end-posn)))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
144 (and
94100
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
145 ;; ;; We no longer exclude things by time.
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
146 ;; (< (- (posn-timestamp end-posn) (posn-timestamp start-posn))
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
147 ;; (if (numberp double-click-time)
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
148 ;; (* 2 double-click-time) ;; stretch it a little
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
149 ;; 999999)) ;; non-numeric => check by position alone
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
150 (= (car start-col-row) (car end-col-row))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
151 (= (cdr start-col-row) (cdr end-col-row)))))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
152
18026
e3b0e7dc5efd * mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents: 17517
diff changeset
153 (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
154 "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
155
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
156 (defun mouse-drag-should-do-col-scrolling ()
18134
2441b667abdd (mouse-drag-safe-scroll): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 18026
diff changeset
157 "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
158 Basically, we check for existing horizontal scrolling."
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
159 (or truncate-lines
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
160 (> (window-hscroll (selected-window)) 0)
78463
ad7b04a38ce4 Use window-full-width-p instead of comparing frame-width and
Martin Rudalics <rudalics@gmx.at>
parents: 78236
diff changeset
161 (not (window-full-width-p))
18026
e3b0e7dc5efd * mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents: 17517
diff changeset
162 (and
e3b0e7dc5efd * mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents: 17517
diff changeset
163 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
164 (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
165 (let
e3b0e7dc5efd * mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents: 17517
diff changeset
166 ((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
167 (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
168 (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
169 (setq truncate-lines t)
e3b0e7dc5efd * mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents: 17517
diff changeset
170 nil))))))
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
171
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
172 (defvar mouse-throw-with-scroll-bar nil
18134
2441b667abdd (mouse-drag-safe-scroll): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 18026
diff changeset
173 "*Set direction of mouse-throwing.
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
174 If nil, the text moves in the direction the mouse moves.
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
175 If t, the scroll bar moves in the direction the mouse moves.")
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
176 (defconst mouse-throw-magnifier-min -6)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
177 (defconst mouse-throw-magnifier-max 6)
94100
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
178 (defconst mouse-throw-magnifier-base 1.5)
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
179
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
180 (defun mouse-drag-scroll-delta (mouse-delta)
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
181 ;; Limit the exponential explosion.
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
182 (setq mouse-delta
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
183 (max mouse-throw-magnifier-min
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
184 (min mouse-throw-magnifier-max mouse-delta)))
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
185 (* (round (exp (* (log mouse-throw-magnifier-base) (abs mouse-delta))))
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
186 (if (< mouse-delta 0) -1 1)
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
187 (if mouse-throw-with-scroll-bar 1 -1)))
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
188
96510
ad09327f37a0 (mouse-drag-throw, mouse-drag-drag): Autoload.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 94678
diff changeset
189 ;;;###autoload
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
190 (defun mouse-drag-throw (start-event)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
191 "\"Throw\" the page according to a mouse drag.
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
192
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
193 A \"throw\" is scrolling the page at a speed relative to the distance
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
194 from the original mouse click to the current mouse location. Try it;
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
195 you'll like it. It's easier to observe than to explain.
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
196
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
197 If the mouse is clicked and released in the same place of time we
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
198 assume that the user didn't want to scdebugroll but wanted to whatever
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
199 mouse-2 used to do, so we pass it through.
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
200
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
201 Throw scrolling was inspired (but is not identical to) the \"hand\"
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
202 option in MacPaint, or the middle button in Tk text widgets.
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
203
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
204 If `mouse-throw-with-scroll-bar' is non-nil, then this command scrolls
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
205 in the opposite direction. (Different people have different ideas
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
206 about which direction is natural. Perhaps it has to do with which
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
207 hemisphere you're in.)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
208
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
209 To test this function, evaluate:
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
210 (global-set-key [down-mouse-2] 'mouse-drag-throw)"
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
211 (interactive "e")
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
212 ;; we want to do save-selected-window, but that requires 19.29
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
213 (let* ((start-posn (event-start start-event))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
214 (start-window (posn-window start-posn))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
215 (start-row (cdr (posn-col-row start-posn)))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
216 (start-col (car (posn-col-row start-posn)))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
217 (old-selected-window (selected-window))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
218 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
219 have-scrolled
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
220 window-last-row
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
221 col mouse-col-delta window-last-col
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
222 (scroll-col-delta 0)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
223 adjusted-mouse-col-delta
16320
56f494ed6b13 (mouse-drag-throw): Bind adjusted-mouse-delta.
Richard M. Stallman <rms@gnu.org>
parents: 16319
diff changeset
224 adjusted-mouse-delta
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
225 ;; be conservative about allowing horizontal scrolling
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
226 (col-scrolling-p (mouse-drag-should-do-col-scrolling)))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
227 (select-window start-window)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
228 (track-mouse
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
229 (while (progn
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
230 (setq event (read-event)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
231 end (event-end event)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
232 row (cdr (posn-col-row end))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
233 col (car (posn-col-row end)))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
234 (or (mouse-movement-p event)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
235 (eq (car-safe event) 'switch-frame)))
94100
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
236 (when (eq start-window (posn-window end))
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
237 (when col-scrolling-p
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
238 (setq scroll-col-delta (mouse-drag-scroll-delta (- start-col col))))
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
239 (setq scroll-delta (mouse-drag-scroll-delta (- start-row row))))
90fb63bd51c8 (mouse-throw-magnifier-with-scroll-bar)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93975
diff changeset
240
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
241 (if (or (/= 0 scroll-delta)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
242 (/= 0 scroll-col-delta))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
243 (progn
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
244 (setq have-scrolled t)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
245 (mouse-drag-safe-scroll scroll-delta scroll-col-delta)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
246 (mouse-drag-repeatedly-safe-scroll scroll-delta scroll-col-delta))))) ;xxx
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
247 ;; 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
248 ;; Is there a more correct way to reconstruct the event?
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
249 (if (and (not have-scrolled)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
250 (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
251 (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
252 unread-command-events))
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
253 ;; 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
254 (select-window old-selected-window)))
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
255
96510
ad09327f37a0 (mouse-drag-throw, mouse-drag-drag): Autoload.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 94678
diff changeset
256 ;;;###autoload
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
257 (defun mouse-drag-drag (start-event)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
258 "\"Drag\" the page according to a mouse drag.
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
259
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
260 Drag scrolling moves the page according to the movement of the mouse.
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
261 You \"grab\" the character under the mouse and move it around.
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
262
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
263 If the mouse is clicked and released in the same place of time we
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
264 assume that the user didn't want to scroll but wanted to whatever
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
265 mouse-2 used to do, so we pass it through.
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
266
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
267 Drag scrolling is identical to the \"hand\" option in MacPaint, or the
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
268 middle button in Tk text widgets.
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
269
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
270 To test this function, evaluate:
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
271 (global-set-key [down-mouse-2] 'mouse-drag-drag)"
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
272 (interactive "e")
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
273 ;; we want to do save-selected-window, but that requires 19.29
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
274 (let* ((start-posn (event-start start-event))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
275 (start-window (posn-window start-posn))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
276 (start-row (cdr (posn-col-row start-posn)))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
277 (start-col (car (posn-col-row start-posn)))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
278 (old-selected-window (selected-window))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
279 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
280 have-scrolled
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
281 window-last-row
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
282 col mouse-col-delta window-last-col
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
283 (scroll-col-delta 0)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
284 ;; be conservative about allowing horizontal scrolling
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
285 (col-scrolling-p (mouse-drag-should-do-col-scrolling)))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
286 (select-window start-window)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
287 (setq window-last-row (- (window-height) 2)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
288 window-last-col (- (window-width) 2))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
289 (track-mouse
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
290 (while (progn
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
291 (setq event (read-event)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
292 end (event-end event)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
293 row (cdr (posn-col-row end))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
294 col (car (posn-col-row end)))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
295 (or (mouse-movement-p event)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
296 (eq (car-safe event) 'switch-frame)))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
297 ;; Scroll if see if we're on the edge.
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
298 ;; NEEDSWORK: should handle mouse-in-other window.
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
299 (cond
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
300 ((not (eq start-window (posn-window end)))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
301 t) ; wait for return to original window
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
302 ((<= row 0) (mouse-drag-repeatedly-safe-scroll -1 0))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
303 ((>= row window-last-row) (mouse-drag-repeatedly-safe-scroll 1 0))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
304 ((and col-scrolling-p (<= col 1)) (mouse-drag-repeatedly-safe-scroll 0 -1))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
305 ((and col-scrolling-p (>= col window-last-col)) (mouse-drag-repeatedly-safe-scroll 0 1))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
306 (t
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
307 (setq scroll-delta (- row start-row)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
308 start-row row)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
309 (if col-scrolling-p
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
310 (setq scroll-col-delta (- col start-col)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
311 start-col col))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
312 (if (or (/= 0 scroll-delta)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
313 (/= 0 scroll-col-delta))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
314 (progn
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
315 (setq have-scrolled t)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
316 (mouse-drag-safe-scroll scroll-delta scroll-col-delta)))))))
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
317 ;; 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
318 ;; Is there a more correct way to reconstruct the event?
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
319 (if (and (not have-scrolled)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
320 (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
321 (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
322 unread-command-events))
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
323 ;; 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
324 (select-window old-selected-window)))
096bd345e996 (mouse-drag-throw): Push back non-drag events
Richard M. Stallman <rms@gnu.org>
parents: 35141
diff changeset
325
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
326
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
327 (provide 'mouse-drag)
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
328
93975
1e3a407766b9 Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 79721
diff changeset
329 ;; arch-tag: e47354ff-82f5-42c4-b3dc-88dd9c04b770
16319
8bd3981bd342 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
330 ;;; mouse-drag.el ends here