mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-17 11:20:39 -08:00
(scroll-bar-drag-position): New function.
(scroll-bar-maybe-set-window-start): New function.
This commit is contained in:
parent
12c11fcd42
commit
aeee66be3b
1 changed files with 32 additions and 0 deletions
|
|
@ -114,6 +114,38 @@ EVENT should be a scroll bar click or drag event."
|
||||||
(beginning-of-line)
|
(beginning-of-line)
|
||||||
(set-window-start window (point))))))
|
(set-window-start window (point))))))
|
||||||
|
|
||||||
|
(defun scroll-bar-drag-position (portion-whole)
|
||||||
|
"Calculate new window start for drag event."
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (+ (point-min)
|
||||||
|
(scroll-bar-scale portion-whole
|
||||||
|
(- (point-max) (point-min)))))
|
||||||
|
(beginning-of-line)
|
||||||
|
(point)))
|
||||||
|
|
||||||
|
(defun scroll-bar-maybe-set-window-start (event)
|
||||||
|
"Set the window start according to where the scroll bar is dragged.
|
||||||
|
Only change window start if the new start is substantially different.
|
||||||
|
EVENT should be a scroll bar click or drag event."
|
||||||
|
(interactive "e")
|
||||||
|
(let* ((end-position (event-end event))
|
||||||
|
(window (nth 0 end-position))
|
||||||
|
(portion-whole (nth 2 end-position))
|
||||||
|
(next-portion-whole (cons (1+ (car portion-whole))
|
||||||
|
(cdr portion-whole)))
|
||||||
|
portion-start
|
||||||
|
next-portion-start
|
||||||
|
(current-start (window-start window)))
|
||||||
|
(save-excursion
|
||||||
|
(set-buffer (window-buffer window))
|
||||||
|
(setq portion-start (scroll-bar-drag-position portion-whole))
|
||||||
|
(setq next-portion-start (max
|
||||||
|
(scroll-bar-drag-position next-portion-whole)
|
||||||
|
(1+ portion-start)))
|
||||||
|
(if (or (> current-start next-portion-start)
|
||||||
|
(< current-start portion-start))
|
||||||
|
(set-window-start window portion-start)))))
|
||||||
|
|
||||||
;; Scroll the window to the proper position for EVENT.
|
;; Scroll the window to the proper position for EVENT.
|
||||||
(defun scroll-bar-drag-1 (event)
|
(defun scroll-bar-drag-1 (event)
|
||||||
(let* ((start-position (event-start event))
|
(let* ((start-position (event-start event))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue