(scroll-bar-drag-position): New function.

(scroll-bar-maybe-set-window-start): New function.

1 files changed, 32 insertions, 0 deletions

diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index 07d78e2c985..98b90856574 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -114,6 +114,38 @@ EVENT should be a scroll bar click or drag event."
         (beginning-of-line)
         (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.
 (defun scroll-bar-drag-1 (event)
   (let* ((start-position (event-start event))