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