bug#26347: patch for mwheel.el

[Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>]

This patch tries to extend a global minor mode `mouse-wheel-mode' and
makes Emacs scroll both vertically and horizontally by swiping
`touchpad' or tilting `trackbar’.

To make the tilt scroll work, add a following line to init file.

  (setq mwheel-tilt-scroll-p t)

How it is implemented is described below.

To scroll horizontally, a function `mwheel-scroll' is extended.  An
event `wheel-right' or `wheel-left' calls `scroll-right' or
`scroll-right', respectively.

During not only horizontal scroll but also vertical scroll,
`auto-hscroll-mode' should be disabled by following three aspects.

(1) It should be off during horizontal scroll.  If it is on, scope
    jumps randomly when point is at the edge.  Also, since
    horizontal scroll does not move point, there will be
    inconsistency between point and scope, and the inconsistency
    will result in unexpected shift of the scope.

(2) It should be off during vertical scroll.  When a buffer is with
    short and long alternative lines, scope jumps from the end of
    long line to the end of short line.  Sudden shift of the scope
    makes edition of a wide document hard.

(3) During horizontal scroll, you may scroll a little in vertical
    direction without intention.  The scrolling should be tolerance
    against such perturbation.  This is somewhat similar to (2).

After scroll, you want to set `auto-hscroll-mode' t back again
otherwise too inconvenient for edition.  Approach of this patch is to
turn on another minor-mode `mwheel--scroll-mode' with
`auto-hscroll-mode' nil at the beginning of `mwheel-scroll'.  The
minor mode is turned off upon any key inputs that move point.

This is my first to time to send a patch.  I follow `(emacs) Sending
Patches’.  I hope this is helpful.





--- /Applications/MacPorts/Emacs-25.1.app/Contents/Resources/lisp/mwheel.el	2017-04-03 16:28:52.000000000 +0900
+++ mwheel.el	2017-04-03 16:20:16.000000000 +0900
@@ -187,8 +187,8 @@

 (defun mwheel-scroll (event)
   "Scroll up or down according to the EVENT.
-This should be bound only to mouse buttons 4 and 5 on non-Windows
-systems."
+This should be bound only to mouse buttons 4, 5, 6, and 7 on
+non-Windows systems."
   (interactive (list last-input-event))
   (let* ((curwin (if mouse-wheel-follow-mouse
                      (prog1
@@ -210,6 +210,9 @@
       ;; When the double-mouse-N comes in, a mouse-N has been executed already,
       ;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...).
       (setq amt (* amt (event-click-count event))))
+    ;; Turn on minor-mode with auto-hscroll-mode nil for tilt scroll
+    (if mwheel-tilt-scroll-p
+        (with-current-buffer buffer (mwheel--scroll-mode 1)))
     (unwind-protect
 	(let ((button (mwheel-event-button event)))
 	  (cond ((eq button mouse-wheel-down-event)
@@ -231,6 +234,16 @@
                  (condition-case nil (funcall mwheel-scroll-up-function amt)
                    ;; Make sure we do indeed scroll to the end of the buffer.
                    (end-of-buffer (while t (funcall mwheel-scroll-up-function)))))
+                ((eq button mouse-wheel-left-event) ; for tilt scroll
+                 (when mwheel-tilt-scroll-p
+                   (funcall (if mwheel-flip-direction
+                                mwheel-scroll-right-function
+                              mwheel-scroll-left-function) amt)))
+                ((eq button mouse-wheel-right-event) ; for tilt scroll
+                 (when mwheel-tilt-scroll-p
+                   (funcall (if mwheel-flip-direction
+                                mwheel-scroll-left-function
+                              mwheel-scroll-right-function) amt)))
 		(t (error "Bad binding in mwheel-scroll"))))
       (if curwin (select-window curwin)))
     ;; If there is a temporarily active region, deactivate it if
@@ -276,7 +289,7 @@
         (global-unset-key key))))
   ;; Setup bindings as needed.
   (when mouse-wheel-mode
-    (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event))
+    (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event mouse-wheel-right-event mouse-wheel-left-event))
       (dolist (key (mapcar (lambda (amt) `[(,@(if (consp amt) (car amt)) ,event)])
                            mouse-wheel-scroll-amount))
         (global-set-key key 'mwheel-scroll)
@@ -288,6 +301,92 @@
   "Enable mouse wheel support."
   (mouse-wheel-mode (if uninstall -1 1)))

+
+;;;
+;;; For tilt-scroll
+;;;
+(defcustom mwheel-tilt-scroll-p nil
+  "Enable tilt scroll and disable `auto-hscroll-mode' during scroll."
+  :group 'mouse
+  :type 'boolean)
+
+(defcustom mwheel-flip-direction nil
+  "Swap direction of 'wheel-right and 'wheel-left."
+  :group 'mouse
+  :type 'boolean)
+
+(defcustom mwheel-scroll-left-function 'scroll-left
+  "Function that does the job of scrolling left."
+  :group 'mouse
+  :type 'function)
+
+(defcustom mwheel-scroll-right-function 'scroll-right
+  "Function that does the job of scrolling right."
+  :group 'mouse
+  :type 'function)
+
+(defcustom mouse-wheel-left-event
+  (if (or (featurep 'w32-win) (featurep 'ns-win))
+      'wheel-left
+    (intern "mouse-6"))
+  "Event used for scrolling left."
+  :group 'mouse
+  :type 'symbol)
+
+(defcustom mouse-wheel-right-event
+  (if (or (featurep 'w32-win) (featurep 'ns-win))
+      'wheel-right
+    (intern "mouse-7"))
+  "Event used for scrolling right."
+  :group 'mouse
+  :type 'symbol)
+
+(defvar mouse--cursor-type cursor-type
+  "Cursor used by user.  This variable is used internally to
+  restore original `cursor-type'.")
+
+(defun mwheel-disable--scroll-mode ()
+  "Disable minor mode `mwheel--scroll-mode' to enable
+`auto-hscroll-mode' back.  Then invoke command that is bound to
+the original key."
+  (interactive)
+  (mwheel--scroll-mode 0) ; turn off minor-mode
+  (call-interactively (key-binding (this-command-keys))))
+
+(define-minor-mode mwheel--scroll-mode
+  "A minor-mode with `auto-hscroll-mode' off.  This minor mode is
+used internally."
+  :init-value nil
+  :keymap (let ((map (make-sparse-keymap)))
+            (define-key map [remap keyboard-quit] 'mwheel-disable--scroll-mode)
+            (define-key map [remap mouse-drag-region] 'mwheel-disable--scroll-mode)
+            (define-key map [remap right-char] 'mwheel-disable--scroll-mode)
+            (define-key map [remap forward-char] 'mwheel-disable--scroll-mode)
+            (define-key map [remap forward-word] 'mwheel-disable--scroll-mode)
+            (define-key map [remap forward-sentence] 'mwheel-disable--scroll-mode)
+            (define-key map [remap left-char] 'mwheel-disable--scroll-mode)
+            (define-key map [remap backward-char] 'mwheel-disable--scroll-mode)
+            (define-key map [remap backward-word] 'mwheel-disable--scroll-mode)
+            (define-key map [remap backward-sentence] 'mwheel-disable--scroll-mode)
+            (define-key map [remap move-beginning-of-line] 'mwheel-disable--scroll-mode)
+            (define-key map [remap move-end-of-line] 'mwheel-disable--scroll-mode)
+            (define-key map [remap next-line] 'mwheel-disable--scroll-mode)
+            (define-key map [remap scroll-up-command] 'mwheel-disable--scroll-mode)
+            (define-key map [remap previous-line] 'mwheel-disable--scroll-mode)
+            (define-key map [remap scroll-down-command] 'mwheel-disable--scroll-mode)
+            (define-key map [remap beginning-of-buffer] 'mwheel-disable--scroll-mode)
+            (define-key map [remap end-of-buffer] 'mwheel-disable--scroll-mode)
+            ;; listed as much as I can ... map all but (where-is-internal 'mwheel-scroll)
+            map)
+  :group 'mouse
+
+  (if mwheel--scroll-mode
+      (progn
+        (setq-local cursor-type 'hollow)
+        (setq-local auto-hscroll-mode nil))
+    (setq-local cursor-type mouse--cursor-type)
+    (setq-local auto-hscroll-mode t)))
+
 (provide 'mwheel)

 ;;; mwheel.el ends here