+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
(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-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-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-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 (&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 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)
(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
"/" (: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)
(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."
(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
;; 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
projects / emacs.git / commitdiff