Mercurial > emacs

--- a/lisp/ChangeLog	Wed Nov 25 17:15:19 2009 +0000
+++ b/lisp/ChangeLog	Wed Nov 25 17:18:26 2009 +0000
@@ -1,3 +1,27 @@
+2009-11-25  Juri Linkov  <juri@jurta.org>
+
+	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  <juri@jurta.org>

 	Provide additional default values (directories at other Dired
--- a/lisp/doc-view.el	Wed Nov 25 17:15:19 2009 +0000
+++ b/lisp/doc-view.el	Wed Nov 25 17:18:26 2009 +0000
@@ -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)
-  (let ((hscroll (window-hscroll))
-	(cur-page (doc-view-current-page)))
-    (when (= (window-vscroll) (image-scroll-up nil))
-      (doc-view-next-page)
-      (when (/= cur-page (doc-view-current-page))
-	(image-bob)
-	(image-bol 1))
-      (set-window-hscroll (selected-window) hscroll))))
+(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 arg))
+	  (doc-view-next-page)
+	  (when (/= cur-page (doc-view-current-page))
+	    (image-bob)
+	    (image-bol 1))
+	  (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)
-  (let ((hscroll (window-hscroll))
-	(cur-page (doc-view-current-page)))
-    (when (= (window-vscroll) (image-scroll-down nil))
-      (doc-view-previous-page)
-      (when (/= cur-page (doc-view-current-page))
-	(image-eob)
-	(image-bol 1))
-      (set-window-hscroll (selected-window) hscroll))))
+(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 arg))
+	  (doc-view-previous-page)
+	  (when (/= cur-page (doc-view-current-page))
+	    (image-eob)
+	    (image-bol 1))
+	  (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)
--- a/lisp/mwheel.el	Wed Nov 25 17:15:19 2009 +0000
+++ b/lisp/mwheel.el	Wed Nov 25 17:18:26 2009 +0000
@@ -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