mwheel scroll horizontally

[Juri Linkov]

Why mwheel.el doesn't allow horizontal scrolling?
The mouse wheel is indispensable for efficient scrolling
around large images like maps in image-mode.

For instance, Gimp allows the Shift modifier to change
the direction of scrolling from vertical to horizontal.
Shift and Control are already in use in mouse-wheel-scroll-amount,
but Meta is available.  What about using Meta for horizontal
scrolling?  The following patch does this.  One problem is that
a new format complicates the defcustom type definition.  Maybe a separate
customizable variable for horizontal scroll definition (e.g.
`mouse-wheel-hscroll-amount') with exactly the same format as
`mouse-wheel-scroll-amount' would be better?

=== modified file 'lisp/mwheel.el'
--- lisp/mwheel.el      2010-08-30 18:48:02 +0000
+++ lisp/mwheel.el      2010-10-04 22:44:45 +0000
@@ -99,7 +99,10 @@ (defcustom mouse-wheel-inhibit-click-tim
   :group 'mouse
   :type 'number)
 
-(defcustom mouse-wheel-scroll-amount '(5 ((shift) . 1) ((control) . nil))
+(defcustom mouse-wheel-scroll-amount '(5 ((shift) . 1) ((control) . nil)
+                                        ((meta) . (hscroll . 5))
+                                        ((meta shift) . (hscroll . 1))
+                                        ((meta control) . (hscroll . nil)))
   "Amount to scroll windows by when spinning the mouse wheel.
 This is an alist mapping the modifier key to the amount to scroll when
 the wheel is moved with the modifier key depressed.
@@ -123,7 +126,13 @@ (defcustom mouse-wheel-scroll-amount '(5
                   (choice :tag "scroll amount"
                           (const :tag "Full screen" :value nil)
                           (integer :tag "Specific # of lines")
-                          (float :tag "Fraction of window"))))
+                          (float :tag "Fraction of window")
+                          (cons
+                           (const :tag "Horizontal scroll" :value hscroll)
+                           (choice :tag "scroll amount"
+                                   (const :tag "Full screen" :value nil)
+                                   (integer :tag "Specific # of lines")
+                                   (float :tag "Fraction of window"))))))
           (repeat
            (cons
             (repeat (choice :tag "modifier"
@@ -132,7 +141,13 @@ (defcustom mouse-wheel-scroll-amount '(5
             (choice :tag "scroll amount"
                     (const :tag "Full screen" :value nil)
                     (integer :tag "Specific # of lines")
-                    (float :tag "Fraction of window")))))
+                    (float :tag "Fraction of window")
+                   (cons
+                    (const :tag "Horizontal scroll" :value hscroll)
+                    (choice :tag "scroll amount"
+                            (const :tag "Full screen" :value nil)
+                            (integer :tag "Specific # of lines")
+                            (float :tag "Fraction of window")))))))
   :set 'mouse-wheel-change-button)
 
 (defcustom mouse-wheel-progressive-speed t
@@ -186,6 +201,12 @@ (defvar mwheel-scroll-up-function 'scrol
 (defvar mwheel-scroll-down-function 'scroll-down
   "Function that does the job of scrolling downward.")
 
+(defvar mwheel-scroll-left-function 'scroll-left
+  "Function that does the job of scrolling left.")
+
+(defvar mwheel-scroll-right-function 'scroll-right
+  "Function that does the job of scrolling right.")
+
 (defun mwheel-scroll (event)
   "Scroll up or down according to the EVENT.
 This should only be bound to mouse buttons 4 and 5."
@@ -200,9 +221,16 @@ (defun mwheel-scroll (event)
                     (point))))
          (mods
          (delq 'click (delq 'double (delq 'triple (event-modifiers event)))))
-         (amt (assoc mods mouse-wheel-scroll-amount)))
-    ;; Extract the actual amount or find the element that has no modifiers.
-    (if amt (setq amt (cdr amt))
+         (amt (assoc mods mouse-wheel-scroll-amount))
+        hscroll)
+    (if amt
+       ;; Extract the actual amount.
+       (progn
+         (setq amt (cdr amt))
+         ;; Set hscroll for horizontal scroll.
+         (when (eq (car-safe amt) 'hscroll)
+           (setq hscroll t amt (cdr amt))))
+      ;; Else find the element that has no modifiers.
       (let ((list-elt mouse-wheel-scroll-amount))
        (while (consp (setq amt (pop list-elt))))))
     (if (floatp amt) (setq amt (1+ (truncate (* amt (window-height))))))
@@ -212,7 +240,12 @@ (defun mwheel-scroll (event)
       (setq amt (* amt (event-click-count event))))
     (unwind-protect
        (let ((button (mwheel-event-button event)))
-         (cond ((eq button mouse-wheel-down-event)
+         (cond (hscroll
+                (cond ((eq button mouse-wheel-down-event)
+                       (funcall mwheel-scroll-right-function amt))
+                      ((eq button mouse-wheel-up-event)
+                       (funcall mwheel-scroll-left-function amt))))
+               ((eq button mouse-wheel-down-event)
                  (condition-case nil (funcall mwheel-scroll-down-function amt)
                    ;; Make sure we do indeed scroll to the beginning of
                    ;; the buffer.