X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/84f19a49c7ca3bdd3c223894a8a2523037f2493f..2f8efa69e0260bbd41c36f7365bd7beec6d9c51f:/lisp/mouse-drag.el diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el index f8196c75de..446ef27a03 100644 --- a/lisp/mouse-drag.el +++ b/lisp/mouse-drag.el @@ -1,8 +1,10 @@ -;;; mouse-drag.el -;;; Copyright (C) 1996 Free Software Foundation, Inc. +;;; mouse-drag.el --- use mouse-2 to do a new style of scrolling -;;; Author: John Heidemann -;;; Keywords: mouse +;; Copyright (C) 1996, 1997, 2001, 2002, 2003, 2004, +;; 2005, 2006 Free Software Foundation, Inc. + +;; Author: John Heidemann +;; Keywords: mouse ;; This file is part of GNU Emacs. @@ -18,8 +20,8 @@ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -60,6 +62,8 @@ ;;; ;;; - 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: @@ -90,20 +94,11 @@ ;;; -johnh@isi.edu, 11-Jul-96 ;;; ;;; -;;; Old changes, for reference: -;;; -;;; What's new with mouse-extras 2.21? +;;; What's new with mouse-drag 2.24? ;;; -;;; - 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 -;;; - - +;;; - mouse-drag-electric-col-scrolling (default: on) +;;; auto-enables horizontal scrolling when clicks on wrapped +;;; lines occur ;;; Code: @@ -112,36 +107,37 @@ ;; (defun mouse-drag-safe-scroll (row-delta &optional col-delta) - "* Scroll down ROW-DELTA lines and right COL-DELTA, ignoring buffer edge errors. + "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))))))) + (let ((scroll-preserve-screen-position nil)) + (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." + "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\"." + "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))) @@ -154,17 +150,30 @@ Keep the cursor on the screen as needed." (= (car start-col-row) (car end-col-row)) (= (cdr start-col-row) (cdr end-col-row))))) +(defvar mouse-drag-electric-col-scrolling t + "If non-nil, mouse-drag on a long line enables truncate-lines.") + (defun mouse-drag-should-do-col-scrolling () - "* Determine if it's wise to enable col-scrolling for the current window." + "Determine if it's wise to enable col-scrolling for the current window. +Basically, we check for existing horizontal scrolling." (or truncate-lines (> (window-hscroll (selected-window)) 0) - (< (window-width) (screen-width)))) + (< (window-width) (frame-width)) + (and + mouse-drag-electric-col-scrolling + (save-excursion ;; on a long line? + (let + ((beg (progn (beginning-of-line) (point))) + (end (progn (end-of-line) (point)))) + (if (> (- end beg) (window-width)) + (setq truncate-lines t) + nil)))))) (defvar mouse-throw-with-scroll-bar nil - "* Set direction of mouse-throwing. + "*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 +(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]) @@ -200,11 +209,12 @@ To test this function, evaluate: (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 + have-scrolled window-last-row col mouse-col-delta window-last-col (scroll-col-delta 0) adjusted-mouse-col-delta + adjusted-mouse-delta ;; be conservative about allowing horizontal scrolling (col-scrolling-p (mouse-drag-should-do-col-scrolling))) (select-window start-window) @@ -252,18 +262,13 @@ To test this function, evaluate: (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. + ;; Is there a more correct way to reconstruct the event? (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))))) + (push (cons (event-basic-type start-event) (cdr start-event)) + unread-command-events)) ;; Now restore the old window. - (select-window old-selected-window) - ;; For clicks, call the old function. - (if point-event-p - (call-interactively old-binding)))) + (select-window old-selected-window))) (defun mouse-drag-drag (start-event) "\"Drag\" the page according to a mouse drag. @@ -288,7 +293,7 @@ To test this function, evaluate: (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 + have-scrolled window-last-row col mouse-col-delta window-last-col (scroll-col-delta 0) @@ -326,19 +331,16 @@ To test this function, evaluate: (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. + ;; Is there a more correct way to reconstruct the event? (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))))) + (push (cons (event-basic-type start-event) (cdr start-event)) + unread-command-events)) ;; Now restore the old window. - (select-window old-selected-window) - ;; For clicks, call the old function. - (if point-event-p - (call-interactively old-binding)))) + (select-window old-selected-window))) + (provide 'mouse-drag) +;;; arch-tag: e47354ff-82f5-42c4-b3dc-88dd9c04b770 ;;; mouse-drag.el ends here