[Emacs-diffs] emacs/lisp ChangeLog doc-view.el mwheel.el

[Juri Linkov]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Juri Linkov <jurta>     09/11/25 17:18:30

Modified files:
        lisp           : ChangeLog doc-view.el mwheel.el 

Log message:
        Mouse-wheel scrolling for DocView Continuous mode.  (Bug#4896)
        
        * mwheel.el (mwheel-scroll-up-function)
        (mwheel-scroll-down-function): New defvars.
        (mwheel-scroll): Funcall `mwheel-scroll-up-function' instead of
        `scroll-up', and `mwheel-scroll-down-function' instead of
        `scroll-down'.
        
        * doc-view.el (doc-view-scroll-up-or-next-page)
        (doc-view-scroll-down-or-previous-page): Add optional ARG.
        Use this ARG in the call to image-scroll-up/image-scroll-down.
        Change `interactive' spec to "P".  Goto next/previous page only
        when `doc-view-continuous-mode' is non-nil or ARG is nil (for the
        SPC/DEL case).  Doc fix.
        (doc-view-next-line-or-next-page)
        (doc-view-previous-line-or-previous-page): Rename arg to ARG
        for consistency.
        (doc-view-mode): Set buffer-local `mwheel-scroll-up-function' to
        `doc-view-scroll-up-or-next-page', and buffer-local
        `mwheel-scroll-down-function' to
        `doc-view-scroll-down-or-previous-page'.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.16733&r2=1.16734
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/doc-view.el?cvsroot=emacs&r1=1.90&r2=1.91
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/mwheel.el?cvsroot=emacs&r1=1.56&r2=1.57

Patches:
Index: ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.16733
retrieving revision 1.16734
diff -u -b -r1.16733 -r1.16734
--- ChangeLog   25 Nov 2009 17:15:21 -0000      1.16733
+++ ChangeLog   25 Nov 2009 17:18:26 -0000      1.16734
@@ -1,5 +1,29 @@
 2009-11-25  Juri Linkov  <address@hidden>
 
+       Mouse-wheel scrolling for DocView Continuous mode.  (Bug#4896)
+
+       * mwheel.el (mwheel-scroll-up-function)
+       (mwheel-scroll-down-function): New defvars.
+       (mwheel-scroll): Funcall `mwheel-scroll-up-function' instead of
+       `scroll-up', and `mwheel-scroll-down-function' instead of
+       `scroll-down'.
+
+       * doc-view.el (doc-view-scroll-up-or-next-page)
+       (doc-view-scroll-down-or-previous-page): Add optional ARG.
+       Use this ARG in the call to image-scroll-up/image-scroll-down.
+       Change `interactive' spec to "P".  Goto next/previous page only
+       when `doc-view-continuous-mode' is non-nil or ARG is nil (for the
+       SPC/DEL case).  Doc fix.
+       (doc-view-next-line-or-next-page)
+       (doc-view-previous-line-or-previous-page): Rename arg to ARG
+       for consistency.
+       (doc-view-mode): Set buffer-local `mwheel-scroll-up-function' to
+       `doc-view-scroll-up-or-next-page', and buffer-local
+       `mwheel-scroll-down-function' to
+       `doc-view-scroll-down-or-previous-page'.
+
+2009-11-25  Juri Linkov  <address@hidden>
+
        Provide additional default values (directories at other Dired
        windows) via M-n in the minibuffer of some Dired commands.
 

Index: doc-view.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/doc-view.el,v
retrieving revision 1.90
retrieving revision 1.91
diff -u -b -r1.90 -r1.91
--- doc-view.el 24 Nov 2009 07:47:49 -0000      1.90
+++ doc-view.el 25 Nov 2009 17:18:30 -0000      1.91
@@ -431,39 +431,49 @@
   (interactive)
   (doc-view-goto-page (length doc-view-current-files)))
 
-(defun doc-view-scroll-up-or-next-page ()
-  "Scroll page up if possible, else goto next page."
-  (interactive)
+(defun doc-view-scroll-up-or-next-page (&optional arg)
+  "Scroll page up ARG lines if possible, else goto next page.
+When `doc-view-continuous-mode' is non-nil, scrolling upward
+at the bottom edge of the page moves to the next page.
+Otherwise, goto next page only on typing SPC (ARG is nil)."
+  (interactive "P")
+  (if (or doc-view-continuous-mode (null arg))
   (let ((hscroll (window-hscroll))
        (cur-page (doc-view-current-page)))
-    (when (= (window-vscroll) (image-scroll-up nil))
+       (when (= (window-vscroll) (image-scroll-up arg))
       (doc-view-next-page)
       (when (/= cur-page (doc-view-current-page))
        (image-bob)
        (image-bol 1))
-      (set-window-hscroll (selected-window) hscroll))))
+         (set-window-hscroll (selected-window) hscroll)))
+    (image-scroll-up arg)))
 
-(defun doc-view-scroll-down-or-previous-page ()
-  "Scroll page down if possible, else goto previous page."
-  (interactive)
+(defun doc-view-scroll-down-or-previous-page (&optional arg)
+  "Scroll page down ARG lines if possible, else goto previous page.
+When `doc-view-continuous-mode' is non-nil, scrolling downward
+at the top edge of the page moves to the previous page.
+Otherwise, goto previous page only on typing DEL (ARG is nil)."
+  (interactive "P")
+  (if (or doc-view-continuous-mode (null arg))
   (let ((hscroll (window-hscroll))
        (cur-page (doc-view-current-page)))
-    (when (= (window-vscroll) (image-scroll-down nil))
+       (when (= (window-vscroll) (image-scroll-down arg))
       (doc-view-previous-page)
       (when (/= cur-page (doc-view-current-page))
        (image-eob)
        (image-bol 1))
-      (set-window-hscroll (selected-window) hscroll))))
+         (set-window-hscroll (selected-window) hscroll)))
+    (image-scroll-down arg)))
 
-(defun doc-view-next-line-or-next-page (&optional n)
-  "Scroll upward by N lines if possible, else goto next page.
-When `doc-view-continuous-mode' is non-nil, scrolling a line upward at
-the bottom edge of the page moves to the next page."
+(defun doc-view-next-line-or-next-page (&optional arg)
+  "Scroll upward by ARG lines if possible, else goto next page.
+When `doc-view-continuous-mode' is non-nil, scrolling a line upward
+at the bottom edge of the page moves to the next page."
   (interactive "p")
   (if doc-view-continuous-mode
       (let ((hscroll (window-hscroll))
            (cur-page (doc-view-current-page)))
-       (when (= (window-vscroll) (image-next-line n))
+       (when (= (window-vscroll) (image-next-line arg))
          (doc-view-next-page)
          (when (/= cur-page (doc-view-current-page))
            (image-bob)
@@ -471,21 +481,21 @@
          (set-window-hscroll (selected-window) hscroll)))
     (image-next-line 1)))
 
-(defun doc-view-previous-line-or-previous-page (&optional n)
-  "Scroll downward by N lines if possible, else goto previous page.
+(defun doc-view-previous-line-or-previous-page (&optional arg)
+  "Scroll downward by ARG lines if possible, else goto previous page.
 When `doc-view-continuous-mode' is non-nil, scrolling a line downward
 at the top edge of the page moves to the previous page."
   (interactive "p")
   (if doc-view-continuous-mode
       (let ((hscroll (window-hscroll))
            (cur-page (doc-view-current-page)))
-       (when (= (window-vscroll) (image-previous-line n))
+       (when (= (window-vscroll) (image-previous-line arg))
          (doc-view-previous-page)
          (when (/= cur-page (doc-view-current-page))
            (image-eob)
            (image-bol 1))
          (set-window-hscroll (selected-window) hscroll)))
-    (image-previous-line n)))
+    (image-previous-line arg)))
 
 ;;;; Utility Functions
 
@@ -1245,6 +1255,10 @@
           "/" (:eval (number-to-string (length doc-view-current-files)))))
     ;; Don't scroll unless the user specifically asked for it.
     (set (make-local-variable 'auto-hscroll-mode) nil)
+    (set (make-local-variable 'mwheel-scroll-up-function)
+        'doc-view-scroll-up-or-next-page)
+    (set (make-local-variable 'mwheel-scroll-down-function)
+        'doc-view-scroll-down-or-previous-page)
     (set (make-local-variable 'cursor-type) nil)
     (use-local-map doc-view-mode-map)
     (set (make-local-variable 'after-revert-hook) 'doc-view-reconvert-doc)

Index: mwheel.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/mwheel.el,v
retrieving revision 1.56
retrieving revision 1.57
diff -u -b -r1.56 -r1.57
--- mwheel.el   12 Sep 2009 19:03:52 -0000      1.56
+++ mwheel.el   25 Nov 2009 17:18:30 -0000      1.57
@@ -179,6 +179,12 @@
   (if (eq (event-basic-type last-input-event) mouse-wheel-click-event)
       (setq this-command 'ignore)))
 
+(defvar mwheel-scroll-up-function 'scroll-up
+  "Function that does the job of scrolling upward.")
+
+(defvar mwheel-scroll-down-function 'scroll-down
+  "Function that does the job of scrolling downward.")
+
 (defun mwheel-scroll (event)
   "Scroll up or down according to the EVENT.
 This should only be bound to mouse buttons 4 and 5."
@@ -206,12 +212,12 @@
     (unwind-protect
        (let ((button (mwheel-event-button event)))
          (cond ((eq button mouse-wheel-down-event)
-                 (condition-case nil (scroll-down amt)
+                 (condition-case nil (funcall mwheel-scroll-down-function amt)
                    ;; Make sure we do indeed scroll to the beginning of
                    ;; the buffer.
                    (beginning-of-buffer
                     (unwind-protect
-                        (scroll-down)
+                        (funcall mwheel-scroll-down-function)
                       ;; If the first scroll succeeded, then some scrolling
                       ;; is possible: keep scrolling til the beginning but
                       ;; do not signal an error.  For some reason, we have
@@ -221,9 +227,9 @@
                       ;; to only affect scroll-down.  --Stef
                       (set-window-start (selected-window) (point-min))))))
                ((eq button mouse-wheel-up-event)
-                 (condition-case nil (scroll-up amt)
+                 (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 (scroll-up)))))
+                   (end-of-buffer (while t (funcall 
mwheel-scroll-up-function)))))
                (t (error "Bad binding in mwheel-scroll"))))
       (if curwin (select-window curwin)))
     ;; If there is a temporarily active region, deactivate it iff