mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-28 10:56:36 +00:00
Code Issues Releases Activity

(scroll-bar-drag): Set point-before-scroll

Browse Source 
in the right buffer, from point in the right window.
(scroll-bar-scroll-down, scroll-bar-scroll-up): Likewise.
This commit is contained in:
Richard M. Stallman 1998-04-08 07:25:05 +00:00
parent 53016bead4
commit cb183ca05d
1 changed files with 54 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
lisp/scroll-bar.el
View File

@ -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." If you click outside the slider, the window scrolls to bring the slider there."
(interactive "e") (interactive "e")
(let* (done (let* (done
(echo-keystrokes 0)) (echo-keystrokes 0)
(or point-before-scroll (end-position (event-end event))
(setq point-before-scroll (point))) (window (nth 0 end-position))
;; Our scrolling can move point; don't let that clear point-before-scroll. (before-scroll))
(let (point-before-scroll) (with-current-buffer (window-buffer window)
(scroll-bar-drag-1 event) (setq before-scroll point-before-scroll))
(track-mouse (save-selected-window
(while (not done) (select-window window)
(setq event (read-event)) (setq before-scroll
(if (eq (car-safe event) 'mouse-movement) (or before-scroll (point))))
(setq event (read-event))) (scroll-bar-drag-1 event)
(cond ((eq (car-safe event) 'scroll-bar-movement) (track-mouse
(scroll-bar-drag-1 event)) (while (not done)
(t (setq event (read-event))
;; Exit when we get the drag event; ignore that event. (if (eq (car-safe event) 'mouse-movement)
(setq done t))))) (setq event (read-event)))
(sit-for 0)))) (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) (defun scroll-bar-scroll-down (event)
"Scroll the window's top line down to the location of the scroll bar click. "Scroll the window's top line down to the location of the scroll bar click.
EVENT should be a scroll bar click." EVENT should be a scroll bar click."
(interactive "e") (interactive "e")
(let ((old-selected-window (selected-window))) (let* ((end-position (event-end event))
(unwind-protect (window (nth 0 end-position))
(progn (before-scroll))
(let* ((end-position (event-end event)) (with-current-buffer (window-buffer window)
(window (nth 0 end-position)) (setq before-scroll point-before-scroll))
(portion-whole (nth 2 end-position))) (save-selected-window
(let (point-before-scroll) (let ((portion-whole (nth 2 end-position)))
(select-window window)) (select-window window)
(or point-before-scroll (setq before-scroll
(setq point-before-scroll (point))) (or before-scroll (point)))
(let (point-before-scroll) (scroll-down
(scroll-down (scroll-bar-scale portion-whole (1- (window-height))))))
(scroll-bar-scale portion-whole (1- (window-height))))))) (sit-for 0)
(select-window old-selected-window)))) (with-current-buffer (window-buffer window)
(setq point-before-scroll before-scroll))))
(defun scroll-bar-scroll-up (event) (defun scroll-bar-scroll-up (event)
"Scroll the line next to the scroll bar click to the top of the window. "Scroll the line next to the scroll bar click to the top of the window.
EVENT should be a scroll bar click." EVENT should be a scroll bar click."
(interactive "e") (interactive "e")
(let ((old-selected-window (selected-window))) (let* ((end-position (event-end event))
(unwind-protect (window (nth 0 end-position))
(progn (before-scroll))
(let* ((end-position (event-end event)) (with-current-buffer (window-buffer window)
(window (nth 0 end-position)) (setq before-scroll point-before-scroll))
(portion-whole (nth 2 end-position))) (save-selected-window
(let (point-before-scroll) (let ((portion-whole (nth 2 end-position)))
(select-window window)) (select-window window)
(or point-before-scroll (setq before-scroll
(setq point-before-scroll (point))) (or before-scroll (point)))
(let (point-before-scroll) (scroll-up
(scroll-up (scroll-bar-scale portion-whole (1- (window-height))))))
(scroll-bar-scale portion-whole (1- (window-height))))))) (sit-for 0)
(select-window old-selected-window)))) (with-current-buffer (window-buffer window)
(setq point-before-scroll before-scroll))))
;;;; Bindings. ;;;; Bindings.