From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Sun, 7 Apr 2013 17:20:30 +0000 (-0700)
Subject: Add no-window? parameter to gtk-graphics/open.
X-Git-Tag: mit-scheme-pucked-9.2.12~521
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b9f0452d886e4e9a20ab3cb50bda400fa13d8c97;p=mit-scheme.git

Add no-window? parameter to gtk-graphics/open.
---

diff --git a/src/gtk/gtk-graphics.scm b/src/gtk/gtk-graphics.scm
index a8921ffad..ff08b1ccf 100644
--- a/src/gtk/gtk-graphics.scm
+++ b/src/gtk/gtk-graphics.scm
@@ -70,26 +70,29 @@ USA.
 
 (define gtk-graphics/available? gtk-thread-running?)
 
-(define (gtk-graphics/open make-device #!optional width height)
+(define (gtk-graphics/open make-device #!optional width height no-window?)
   (let ((width (if (default-object? width) 512 width))
-	(height (if (default-object? height) 384 height)))
+	(height (if (default-object? height) 384 height))
+	(no-window? (if (default-object? no-window?) #f no-window?)))
     (guarantee-positive-fixnum width 'gtk-graphics/open)
     (guarantee-positive-fixnum height 'gtk-graphics/open)
-    (let ((window (gtk-window-new 'toplevel))
-	  (scroller (gtk-scrolled-view-new))
-	  (layout (make-fix-layout width height))
-	  (drawing (make-fix-drawing))
-	  (graphics (make-gtk-graphics width height)))
-      (fix-drawing-add-ink! drawing graphics)
-      (set-fix-drawing-size! drawing width height)
-      (set-fix-layout-drawing! layout drawing 0 0)
-      (gtk-widget-set-hexpand layout #t)
-      (gtk-widget-set-vexpand layout #t)
-      (gtk-container-add scroller layout)
-      (gtk-container-set-border-width window 5)
-      (gtk-container-add window scroller)
-      (gtk-widget-show-all window)
-      (make-device graphics))))
+    (if no-window?
+	(make-device (make-gtk-graphics width height))
+	(let ((window (gtk-window-new 'toplevel))
+	      (scroller (gtk-scrolled-view-new))
+	      (layout (make-fix-layout width height))
+	      (drawing (make-fix-drawing))
+	      (graphics (make-gtk-graphics width height)))
+	  (fix-drawing-add-ink! drawing graphics)
+	  (set-fix-drawing-size! drawing width height)
+	  (set-fix-layout-drawing! layout drawing 0 0)
+	  (gtk-widget-set-hexpand layout #t)
+	  (gtk-widget-set-vexpand layout #t)
+	  (gtk-container-add scroller layout)
+	  (gtk-container-set-border-width window 5)
+	  (gtk-container-add window scroller)
+	  (gtk-widget-show-all window)
+	  (make-device graphics)))))
 
 (define (toplevel graphics)
   (let ((widgets (fix-drawing-widgets (fix-ink-drawing graphics))))