X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4ebeb09d6dbb2f0c6dd28bf161d7786b5e71f2bb..f38d351407f2c700b32fc90f9935c70507b5b14c:/lisp/mouse-drag.el

diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el
index 3f41d9f18f..54475da310 100644
--- a/lisp/mouse-drag.el
+++ b/lisp/mouse-drag.el
@@ -1,8 +1,9 @@
-;;; 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 <johnh@ISI.EDU>
-;;; Keywords: mouse
+;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+
+;; Author: John Heidemann <johnh@ISI.EDU>
+;; Keywords: mouse
 
 ;; This file is part of GNU Emacs.
 
@@ -60,6 +61,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 +93,11 @@
 ;;;    -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 <twurgler@goodyear.com>)
-;;; - 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
+;;; 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
 
 ;;; Code:
 
@@ -112,7 +106,7 @@
 ;;
 
 (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))
@@ -126,7 +120,7 @@ Keep the cursor on the screen as needed."
 	(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 
+	;; This code mimics the behavior we automatically get
 	;; when doing vertical scrolling.
 	;; Problem identified and a fix suggested by Tom Wurgler.
 	(cond
@@ -136,12 +130,12 @@ Keep the cursor on the screen as needed."
 	  (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 +148,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) (screen-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])