Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

(scroll-bar-scroll-down, scroll-bar-scroll-up):

Browse source 
Set point-before-scroll at end even if there was an error.
This commit is contained in:
Karl Heuer 1998-09-13 03:51:22 +00:00
parent 7ff020486d
commit def7db1da1
1 changed files with 22 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
lisp/scroll-bar.el
View file

@ -250,16 +250,17 @@ EVENT should be a scroll bar click."
(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))))
(unwind-protect
(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.
@ -270,16 +271,17 @@ EVENT should be a scroll bar click."
(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))))
(unwind-protect
(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.