diff options
author | Richard M. Stallman <rms@gnu.org> | 1998-04-08 07:25:05 +0000 |
---|---|---|
committer | Richard M. Stallman <rms@gnu.org> | 1998-04-08 07:25:05 +0000 |
commit | befa133ea6e603c4f2124815943ebeaf300a5745 (patch) | |
tree | 5eaa1715123ca55a3b9879f3540ccd9f2730f5fe /lisp/scroll-bar.el | |
parent | 3c0567c659eaa362b581f21f0ceb5a45a69f0297 (diff) | |
download | emacs-befa133ea6e603c4f2124815943ebeaf300a5745.tar.gz |
(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.
Diffstat (limited to 'lisp/scroll-bar.el')
-rw-r--r-- | lisp/scroll-bar.el | 99 |
1 files 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. |