mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-27 10:54:40 +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."
(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.