From 84f19a49c7ca3bdd3c223894a8a2523037f2493f Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Wed, 25 Sep 1996 03:30:55 +0000 Subject: [PATCH] Initial revision --- lisp/mouse-drag.el | 344 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 344 insertions(+) create mode 100644 lisp/mouse-drag.el diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el new file mode 100644 index 00000000000..f8196c75de3 --- /dev/null +++ b/lisp/mouse-drag.el @@ -0,0 +1,344 @@ +;;; mouse-drag.el +;;; Copyright (C) 1996 Free Software Foundation, Inc. + +;;; Author: John Heidemann +;;; Keywords: mouse + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; What is ``mouse-drag.el''? +;;; +;;; Doesn't that scroll bar seem far away when you want to scroll? +;;; This module overloads mouse-2 to do ``throw'' scrolling. You +;;; click and drag. The distance you move from your original click +;;; turns into a scroll amount. The scroll amount is scaled +;;; exponentially to make both large moves and short adjustments easy. +;;; What this boils down to is that you can easily scroll around the +;;; buffer without much mouse movement. Finally, clicks which aren't +;;; drags are passed off to the old mouse-2 binding, so old mouse-2 +;;; operations (find-file in dired-mode, yanking in most other modes) +;;; still work. +;;; +;;; There is an alternative way to scroll, ``drag'' scrolling. You +;;; can click on a character and then drag it around, scrolling the +;;; buffer with you. The character always stays under the mouse. +;;; Compared to throw-scrolling, this approach provides direct +;;; manipulation (nice) but requires more mouse movement +;;; (unfortunate). It is offered as an alternative for those who +;;; prefer it. +;;; +;;; If you like mouse-drag, you should also check out mouse-copy +;;; for ``one-click text copy and move''. +;;; +;;; To use mouse-drag, place the following in your .emacs file: +;;; (require 'mouse-drag) +;;; -and either- +;;; (global-set-key [down-mouse-2] 'mouse-drag-throw) +;;; -or- +;;; (global-set-key [down-mouse-2] 'mouse-drag-drag) +;;; +;;; +;;; +;;; Options: +;;; +;;; - reverse the throw-scroll direction with \\[mouse-throw-with-scroll-bar] +;;; - work around a bug with \\[mouse-extras-work-around-drag-bug] +;;; +;;; +;;; History and related work: +;;; +;;; One-click copying and moving was inspired by lemacs-19.8. +;;; Throw-scrolling was inspired by MacPaint's ``hand'' and by Tk's +;;; mouse-2 scrolling. The package mouse-scroll.el by Tom Wurgler +;;; is similar to mouse-drag-throw, but +;;; doesn't pass clicks through. +;;; +;;; These functions have been tested in emacs version 19.30, +;;; and this package has run in the past on 19.25-19.29. +;;; +;;; Originally mouse-drag was part of a larger package. +;;; As of 11 July 96 the scrolling functions were split out +;;; in preparation for incorporation into (the future) emacs-19.32. +;;; +;;; +;;; Thanks: +;;; +;;; Thanks to Kai Grossjohann +;;; for reporting bugs, to +;;; Tom Wurgler for reporting bugs and +;;; suggesting fixes, and to Joel Graber for +;;; prompting me to do drag-scrolling and for an initial +;;; implementation of horizontal drag-scrolling. +;;; +;;; -johnh@isi.edu, 11-Jul-96 +;;; +;;; +;;; Old changes, for reference: +;;; +;;; What's new with mouse-extras 2.21? +;;; +;;; - support for emacs-19.{29,30} +;;; - point now stays on the visible screen during horizontal scrolling +;;; (bug identified and fix suggested by Tom Wurgler ) +;;; - better work-around for lost-mouse-events bug (supports double/triple +;;; clicks), see \\[mouse-extras-work-around-drag-bug] for details. +;;; - work-around for lost-mouse-events bug now is OFF by default; +;;; enable it if you have problems +;;; + + + +;;; Code: + +;; +;; scrolling code +;; + +(defun mouse-drag-safe-scroll (row-delta &optional col-delta) + "* Scroll down ROW-DELTA lines and right COL-DELTA, ignoring buffer edge errors. +Keep the cursor on the screen as needed." + (if (and row-delta + (/= 0 row-delta)) + (condition-case nil ;; catch and ignore movement errors + (scroll-down row-delta) + (beginning-of-buffer (message "Beginning of buffer")) + (end-of-buffer (message "End of buffer")))) + (if (and col-delta + (/= 0 col-delta)) + (progn + (scroll-right col-delta) + ;; Make sure that the point stays on the visible screen + ;; (if truncation-lines in set). + ;; This code mimics the behavior we automatically get + ;; when doing vertical scrolling. + ;; Problem identified and a fix suggested by Tom Wurgler. + (cond + ((< (current-column) (window-hscroll)) + (move-to-column (window-hscroll))) ; make on left column + ((> (- (current-column) (window-hscroll) (window-width) -2) 0) + (move-to-column (+ (window-width) (window-hscroll) -3))))))) + +(defun mouse-drag-repeatedly-safe-scroll (row-delta &optional col-delta) + "* Scroll ROW-DELTA rows and COL-DELTA cols until an event happens." + (while (sit-for mouse-scroll-delay) + (mouse-drag-safe-scroll row-delta col-delta))) + +(defun mouse-drag-events-are-point-events-p (start-posn end-posn) + "* Determine if START-POSN and END-POSN are \"close\"." + (let* + ((start-col-row (posn-col-row start-posn)) + (end-col-row (posn-col-row end-posn))) + (and +;; We no longer exclude things by time. +;; (< (- (posn-timestamp end-posn) (posn-timestamp start-posn)) +;; (if (numberp double-click-time) +;; (* 2 double-click-time) ;; stretch it a little +;; 999999)) ;; non-numeric => check by position alone + (= (car start-col-row) (car end-col-row)) + (= (cdr start-col-row) (cdr end-col-row))))) + +(defun mouse-drag-should-do-col-scrolling () + "* Determine if it's wise to enable col-scrolling for the current window." + (or truncate-lines + (> (window-hscroll (selected-window)) 0) + (< (window-width) (screen-width)))) + +(defvar mouse-throw-with-scroll-bar nil + "* Set direction of mouse-throwing. +If nil, the text moves in the direction the mouse moves. +If t, the scroll bar moves in the direction the mouse moves.") +(defconst mouse-throw-magnifier-with-scroll-bar + [-16 -8 -4 -2 -1 0 0 0 1 2 4 8 16]) +(defconst mouse-throw-magnifier-with-mouse-movement + [ 16 8 4 2 1 0 0 0 -1 -2 -4 -8 -16]) +(defconst mouse-throw-magnifier-min -6) +(defconst mouse-throw-magnifier-max 6) + +(defun mouse-drag-throw (start-event) + "\"Throw\" the page according to a mouse drag. + +A \"throw\" is scrolling the page at a speed relative to the distance +from the original mouse click to the current mouse location. Try it; +you'll like it. It's easier to observe than to explain. + +If the mouse is clicked and released in the same place of time we +assume that the user didn't want to scdebugroll but wanted to whatever +mouse-2 used to do, so we pass it through. + +Throw scrolling was inspired (but is not identical to) the \"hand\" +option in MacPaint, or the middle button in Tk text widgets. + +If `mouse-throw-with-scroll-bar' is non-nil, then this command scrolls +in the opposite direction. (Different people have different ideas +about which direction is natural. Perhaps it has to do with which +hemisphere you're in.) + +To test this function, evaluate: + (global-set-key [down-mouse-2] 'mouse-drag-throw)" + (interactive "e") + ;; we want to do save-selected-window, but that requires 19.29 + (let* ((start-posn (event-start start-event)) + (start-window (posn-window start-posn)) + (start-row (cdr (posn-col-row start-posn))) + (start-col (car (posn-col-row start-posn))) + (old-selected-window (selected-window)) + event end row mouse-delta scroll-delta + have-scrolled point-event-p old-binding + window-last-row + col mouse-col-delta window-last-col + (scroll-col-delta 0) + adjusted-mouse-col-delta + ;; be conservative about allowing horizontal scrolling + (col-scrolling-p (mouse-drag-should-do-col-scrolling))) + (select-window start-window) + (track-mouse + (while (progn + (setq event (read-event) + end (event-end event) + row (cdr (posn-col-row end)) + col (car (posn-col-row end))) + (or (mouse-movement-p event) + (eq (car-safe event) 'switch-frame))) + (if (eq start-window (posn-window end)) + (progn + (setq mouse-delta (- start-row row) + adjusted-mouse-delta + (- (cond + ((<= mouse-delta mouse-throw-magnifier-min) + mouse-throw-magnifier-min) + ((>= mouse-delta mouse-throw-magnifier-max) + mouse-throw-magnifier-max) + (t mouse-delta)) + mouse-throw-magnifier-min) + scroll-delta (aref (if mouse-throw-with-scroll-bar + mouse-throw-magnifier-with-scroll-bar + mouse-throw-magnifier-with-mouse-movement) + adjusted-mouse-delta)) + (if col-scrolling-p + (setq mouse-col-delta (- start-col col) + adjusted-mouse-col-delta + (- (cond + ((<= mouse-col-delta mouse-throw-magnifier-min) + mouse-throw-magnifier-min) + ((>= mouse-col-delta mouse-throw-magnifier-max) + mouse-throw-magnifier-max) + (t mouse-col-delta)) + mouse-throw-magnifier-min) + scroll-col-delta (aref (if mouse-throw-with-scroll-bar + mouse-throw-magnifier-with-scroll-bar + mouse-throw-magnifier-with-mouse-movement) + adjusted-mouse-col-delta))))) + (if (or (/= 0 scroll-delta) + (/= 0 scroll-col-delta)) + (progn + (setq have-scrolled t) + (mouse-drag-safe-scroll scroll-delta scroll-col-delta) + (mouse-drag-repeatedly-safe-scroll scroll-delta scroll-col-delta))))) ;xxx + ;; If it was a click and not a drag, prepare to pass the event on. + ;; Note: We must determine the pass-through event before restoring + ;; the window, but invoke it after. Sigh. + (if (and (not have-scrolled) + (mouse-drag-events-are-point-events-p start-posn end)) + (setq point-event-p t + old-binding (key-binding + (vector (event-basic-type start-event))))) + ;; Now restore the old window. + (select-window old-selected-window) + ;; For clicks, call the old function. + (if point-event-p + (call-interactively old-binding)))) + +(defun mouse-drag-drag (start-event) + "\"Drag\" the page according to a mouse drag. + +Drag scrolling moves the page according to the movement of the mouse. +You \"grab\" the character under the mouse and move it around. + +If the mouse is clicked and released in the same place of time we +assume that the user didn't want to scroll but wanted to whatever +mouse-2 used to do, so we pass it through. + +Drag scrolling is identical to the \"hand\" option in MacPaint, or the +middle button in Tk text widgets. + +To test this function, evaluate: + (global-set-key [down-mouse-2] 'mouse-drag-drag)" + (interactive "e") + ;; we want to do save-selected-window, but that requires 19.29 + (let* ((start-posn (event-start start-event)) + (start-window (posn-window start-posn)) + (start-row (cdr (posn-col-row start-posn))) + (start-col (car (posn-col-row start-posn))) + (old-selected-window (selected-window)) + event end row mouse-delta scroll-delta + have-scrolled point-event-p old-binding + window-last-row + col mouse-col-delta window-last-col + (scroll-col-delta 0) + ;; be conservative about allowing horizontal scrolling + (col-scrolling-p (mouse-drag-should-do-col-scrolling))) + (select-window start-window) + (setq window-last-row (- (window-height) 2) + window-last-col (- (window-width) 2)) + (track-mouse + (while (progn + (setq event (read-event) + end (event-end event) + row (cdr (posn-col-row end)) + col (car (posn-col-row end))) + (or (mouse-movement-p event) + (eq (car-safe event) 'switch-frame))) + ;; Scroll if see if we're on the edge. + ;; NEEDSWORK: should handle mouse-in-other window. + (cond + ((not (eq start-window (posn-window end))) + t) ; wait for return to original window + ((<= row 0) (mouse-drag-repeatedly-safe-scroll -1 0)) + ((>= row window-last-row) (mouse-drag-repeatedly-safe-scroll 1 0)) + ((and col-scrolling-p (<= col 1)) (mouse-drag-repeatedly-safe-scroll 0 -1)) + ((and col-scrolling-p (>= col window-last-col)) (mouse-drag-repeatedly-safe-scroll 0 1)) + (t + (setq scroll-delta (- row start-row) + start-row row) + (if col-scrolling-p + (setq scroll-col-delta (- col start-col) + start-col col)) + (if (or (/= 0 scroll-delta) + (/= 0 scroll-col-delta)) + (progn + (setq have-scrolled t) + (mouse-drag-safe-scroll scroll-delta scroll-col-delta))))))) + ;; If it was a click and not a drag, prepare to pass the event on. + ;; Note: We must determine the pass-through event before restoring + ;; the window, but invoke it after. Sigh. + (if (and (not have-scrolled) + (mouse-drag-events-are-point-events-p start-posn end)) + (setq point-event-p t + old-binding (key-binding + (vector (event-basic-type start-event))))) + ;; Now restore the old window. + (select-window old-selected-window) + ;; For clicks, call the old function. + (if point-event-p + (call-interactively old-binding)))) + +(provide 'mouse-drag) + +;;; mouse-drag.el ends here -- 2.39.2