# HG changeset patch # User Juri Linkov # Date 1259169506 0 # Node ID 7ce04dfc904dcc005ce936bfebe8cbb3eb4cb0e8 # Parent 16d3ef458ae11906bf3be4fac08e8c8bb9eec509 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'. diff -r 16d3ef458ae1 -r 7ce04dfc904d lisp/ChangeLog --- 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 + + 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 Provide additional default values (directories at other Dired diff -r 16d3ef458ae1 -r 7ce04dfc904d lisp/doc-view.el --- 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) diff -r 16d3ef458ae1 -r 7ce04dfc904d lisp/mwheel.el --- 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