From cb183ca05d7a8c75f00ea8c1e62394afd804be33 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Wed, 8 Apr 1998 07:25:05 +0000 Subject: [PATCH] (scroll-bar-drag): Set point-before-scroll in the right buffer, from point in the right window. (scroll-bar-scroll-down, scroll-bar-scroll-up): Likewise. --- lisp/scroll-bar.el | 99 +++++++++++++++++++++++++--------------------- 1 file changed, 54 insertions(+), 45 deletions(-) diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index f94fc6754af..2100a1f51ec 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -214,61 +214,70 @@ EVENT should be a scroll bar click or drag event." If you click outside the slider, the window scrolls to bring the slider there." (interactive "e") (let* (done - (echo-keystrokes 0)) - (or point-before-scroll - (setq point-before-scroll (point))) - ;; Our scrolling can move point; don't let that clear point-before-scroll. - (let (point-before-scroll) - (scroll-bar-drag-1 event) - (track-mouse - (while (not done) - (setq event (read-event)) - (if (eq (car-safe event) 'mouse-movement) - (setq event (read-event))) - (cond ((eq (car-safe event) 'scroll-bar-movement) - (scroll-bar-drag-1 event)) - (t - ;; Exit when we get the drag event; ignore that event. - (setq done t))))) - (sit-for 0)))) + (echo-keystrokes 0) + (end-position (event-end event)) + (window (nth 0 end-position)) + (before-scroll)) + (with-current-buffer (window-buffer window) + (setq before-scroll point-before-scroll)) + (save-selected-window + (select-window window) + (setq before-scroll + (or before-scroll (point)))) + (scroll-bar-drag-1 event) + (track-mouse + (while (not done) + (setq event (read-event)) + (if (eq (car-safe event) 'mouse-movement) + (setq event (read-event))) + (cond ((eq (car-safe event) 'scroll-bar-movement) + (scroll-bar-drag-1 event)) + (t + ;; Exit when we get the drag event; ignore that event. + (setq done t))))) + (sit-for 0) + (with-current-buffer (window-buffer window) + (setq point-before-scroll before-scroll)))) (defun scroll-bar-scroll-down (event) "Scroll the window's top line down to the location of the scroll bar click. EVENT should be a scroll bar click." (interactive "e") - (let ((old-selected-window (selected-window))) - (unwind-protect - (progn - (let* ((end-position (event-end event)) - (window (nth 0 end-position)) - (portion-whole (nth 2 end-position))) - (let (point-before-scroll) - (select-window window)) - (or point-before-scroll - (setq point-before-scroll (point))) - (let (point-before-scroll) - (scroll-down - (scroll-bar-scale portion-whole (1- (window-height))))))) - (select-window old-selected-window)))) + (let* ((end-position (event-end event)) + (window (nth 0 end-position)) + (before-scroll)) + (with-current-buffer (window-buffer window) + (setq before-scroll point-before-scroll)) + (save-selected-window + (let ((portion-whole (nth 2 end-position))) + (select-window window) + (setq before-scroll + (or before-scroll (point))) + (scroll-down + (scroll-bar-scale portion-whole (1- (window-height)))))) + (sit-for 0) + (with-current-buffer (window-buffer window) + (setq point-before-scroll before-scroll)))) (defun scroll-bar-scroll-up (event) "Scroll the line next to the scroll bar click to the top of the window. EVENT should be a scroll bar click." (interactive "e") - (let ((old-selected-window (selected-window))) - (unwind-protect - (progn - (let* ((end-position (event-end event)) - (window (nth 0 end-position)) - (portion-whole (nth 2 end-position))) - (let (point-before-scroll) - (select-window window)) - (or point-before-scroll - (setq point-before-scroll (point))) - (let (point-before-scroll) - (scroll-up - (scroll-bar-scale portion-whole (1- (window-height))))))) - (select-window old-selected-window)))) + (let* ((end-position (event-end event)) + (window (nth 0 end-position)) + (before-scroll)) + (with-current-buffer (window-buffer window) + (setq before-scroll point-before-scroll)) + (save-selected-window + (let ((portion-whole (nth 2 end-position))) + (select-window window) + (setq before-scroll + (or before-scroll (point))) + (scroll-up + (scroll-bar-scale portion-whole (1- (window-height)))))) + (sit-for 0) + (with-current-buffer (window-buffer window) + (setq point-before-scroll before-scroll)))) ;;;; Bindings. -- 2.39.2