gtk-screen: Customize scrollbar behavior.

Specialize the internal fix-layout-adjustment-parameters generic.

diff --git a/src/gtk-screen/gtk-screen.pkg b/src/gtk-screen/gtk-screen.pkg
index ff999951b042c2c24fd1bcbe9c2f4922df0ae306..e41a6a5fb1958f79015ff46596bf29672711ad87 100644 (file)
--- a/src/gtk-screen/gtk-screen.pkg
+++ b/src/gtk-screen/gtk-screen.pkg
@@ -89,6 +89,7 @@ USA.
          gtk-paned-view-init)
   (import (gtk fix-layout)
          fix-widget-geometry
+         fix-layout-adjustment-parameters
 
          drawing-damage
          fix-drawing-display-list

diff --git a/src/gtk-screen/gtk-screen.scm b/src/gtk-screen/gtk-screen.scm
index 560e60bb3a3d25857f22e976391aa626af2526c0..6e7787e038fe3706f99f93733c16ae4281ea4189 100644 (file)
--- a/src/gtk-screen/gtk-screen.scm
+++ b/src/gtk-screen/gtk-screen.scm
@@ -1214,6 +1214,23 @@ USA.
 (define-integrable (editor-frame? object)
   (object-of-class? editor-frame object))
 
+(define-method fix-layout-adjustment-parameters ((widget <text-widget>)
+                                                view-size extent-size
+                                                extent-low receiver)
+  (declare (ignore widget))
+  (if (fix:< view-size extent-size)
+      ;; Drawing is larger than viewport: thumb (page) is viewport.
+      (begin
+       (%trace ";  large-drawing:"extent-size" view:"view-size"\n")
+       (receiver extent-low view-size))
+      ;; Viewport is larger than drawing: thumb (page) is 0.
+      (begin
+       (%trace ";  drawing:"extent-size" large-view:"view-size"\n")
+       ;; When page-size = extent-size, high will be extent-low [see
+       ;; adjust-adjustment].  Thus high and low are extent-low, and
+       ;; value will be clamped to extent-low.
+       (receiver extent-low extent-size))))
+
 (define-class (<modeline-widget> (constructor make-modeline-widget (screen)))
     (<edwin-widget>))