X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/ab5796a9f97180707734a81320e3eb81937281fe..9b026d9f13d4a7694e9dfebce171564cf8ec2dd4:/lisp/mouse-drag.el diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el index 9906114ca3..e024b2aa55 100644 --- a/lisp/mouse-drag.el +++ b/lisp/mouse-drag.el @@ -1,16 +1,17 @@ ;;; mouse-drag.el --- use mouse-2 to do a new style of scrolling -;; Copyright (C) 1996, 1997, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 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 +;; 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. +;; the Free Software Foundation, either version 3 of the License, 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 @@ -18,87 +19,87 @@ ;; 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. +;; along with GNU Emacs. If not, see . ;;; 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] -;;; - auto-enable horizontal scrolling with -;;; \\[mouse-drag-electric-col-scrolling] -;;; -;;; -;;; 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 -;;; -;;; -;;; What's new with mouse-drag 2.24? -;;; -;;; - mouse-drag-electric-col-scrolling (default: on) -;;; auto-enables horizontal scrolling when clicks on wrapped -;;; lines occur - +;; 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: +;; -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] +;; - auto-enable horizontal scrolling with +;; \\[mouse-drag-electric-col-scrolling] +;; +;; +;; 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 +;; +;; +;; What's new with mouse-drag 2.24? +;; +;; - mouse-drag-electric-col-scrolling (default: on) +;; auto-enables horizontal scrolling when clicks on wrapped +;; lines occur + +;; TODO: +;; - For mouse-drag-throw, we should try and place some visual indicator +;; of the original mouse position (like Firefox does). + ;;; Code: ;; @@ -141,11 +142,11 @@ Keep the cursor on the screen as needed." ((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 + ;; ;; 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))))) @@ -157,12 +158,12 @@ Keep the cursor on the screen as needed." Basically, we check for existing horizontal scrolling." (or truncate-lines (> (window-hscroll (selected-window)) 0) - (< (window-width) (frame-width)) + (not (window-full-width-p)) (and mouse-drag-electric-col-scrolling (save-excursion ;; on a long line? (let - ((beg (progn (beginning-of-line) (point))) + ((beg (line-beginning-position)) (end (progn (end-of-line) (point)))) (if (> (- end beg) (window-width)) (setq truncate-lines t) @@ -172,13 +173,20 @@ Basically, we check for existing horizontal scrolling." "*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) +(defconst mouse-throw-magnifier-base 1.5) +(defun mouse-drag-scroll-delta (mouse-delta) + ;; Limit the exponential explosion. + (setq mouse-delta + (max mouse-throw-magnifier-min + (min mouse-throw-magnifier-max mouse-delta))) + (* (round (exp (* (log mouse-throw-magnifier-base) (abs mouse-delta)))) + (if (< mouse-delta 0) -1 1) + (if mouse-throw-with-scroll-bar 1 -1))) + +;;;###autoload (defun mouse-drag-throw (start-event) "\"Throw\" the page according to a mouse drag. @@ -225,35 +233,11 @@ To test this function, evaluate: 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))))) + (when (eq start-window (posn-window end)) + (when col-scrolling-p + (setq scroll-col-delta (mouse-drag-scroll-delta (- start-col col)))) + (setq scroll-delta (mouse-drag-scroll-delta (- start-row row)))) + (if (or (/= 0 scroll-delta) (/= 0 scroll-col-delta)) (progn @@ -269,6 +253,7 @@ To test this function, evaluate: ;; Now restore the old window. (select-window old-selected-window))) +;;;###autoload (defun mouse-drag-drag (start-event) "\"Drag\" the page according to a mouse drag. @@ -341,5 +326,4 @@ To test this function, evaluate: (provide 'mouse-drag) -;;; arch-tag: e47354ff-82f5-42c4-b3dc-88dd9c04b770 ;;; mouse-drag.el ends here