Add set-rectangle-ink-position./linux-3735fd4-2/bin/mit-scheme --load debug

diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm
index 107c6f6bb5dda665223f4a53967e257cafa367f0..e6b6d44055b7ec81ad17ad6707aa69fa77226e61 100644 (file)
--- a/src/gtk/fix-layout.scm
+++ b/src/gtk/fix-layout.scm
@@ -1172,6 +1172,18 @@ USA.
             (set-fix-rect! rect x y width height)
             (recache-rectangle-extent! ink)))))))
 
+(define (set-rectangle-ink-position! ink x y)
+  (guarantee-fixnum x 'set-rectangle-ink-position!)
+  (guarantee-fixnum y 'set-rectangle-ink-position!)
+  (without-interrupts
+   (lambda ()
+     (let ((rect (rectangle-ink-rect ink)))
+       (if (not (and (fix:= x (fix-rect-x rect))
+                    (fix:= y (fix-rect-y rect))))
+          (begin
+            (set-fix-rect-position! rect x y)
+            (recache-rectangle-extent! ink)))))))
+
 (define-method fix-ink-move! ((ink <rectangle-ink>) dx dy)
   (without-interrupts
    (lambda ()

diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg
index c9c1d504c3e6a29eae347df3aa18c15ac4b731ca..12f64fef0a70202f1afdb6c54121925f4329500d 100644 (file)
--- a/src/gtk/gtk.pkg
+++ b/src/gtk/gtk.pkg
@@ -210,7 +210,8 @@ USA.
          line-ink-dash-color set-line-ink-dash-color!
          line-ink-dashes set-line-ink-dashes!
 
-         <rectangle-ink> rectangle-ink? make-rectangle-ink set-rectangle-ink!
+         <rectangle-ink> rectangle-ink? make-rectangle-ink
+         set-rectangle-ink! set-rectangle-ink-position!
          rectangle-ink-color set-rectangle-ink-color!
          rectangle-ink-width set-rectangle-ink-width!
          rectangle-ink-fill-color set-rectangle-ink-fill-color!