Implement `get-default' operation on X graphics windows, and allow a
authorChris Hanson <org/chris-hanson/cph>
Tue, 27 Jun 1989 10:16:02 +0000 (10:16 +0000)
committerChris Hanson <org/chris-hanson/cph>
Tue, 27 Jun 1989 10:16:02 +0000 (10:16 +0000)
string to be used as a display argument when opening a window.

v7/src/runtime/x11graph.scm

index 96ed7af5067bbebfb64c7a4e7a9f784c1dc16fef..0df3c64fb6f95e03a315f10627992f7f3353c3d2 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/x11graph.scm,v 1.2 1989/06/23 21:35:19 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/x11graph.scm,v 1.3 1989/06/27 10:16:02 cph Rel $
 
 Copyright (c) 1989 Massachusetts Institute of Technology
 
@@ -93,6 +93,7 @@ MIT in each case. |#
           (draw-point ,x-graphics-draw-point)
           (draw-text ,x-graphics-draw-string)
           (flush ,operation/flush)
+          (get-default ,x-window-get-default)
           (map-window ,x-window-map)
           (move-cursor ,x-graphics-move-cursor)
           (move-window ,x-window-set-position)
@@ -137,10 +138,16 @@ MIT in each case. |#
   (implemented-primitive-procedure? x-graphics-open-window))
 
 (define (operation/open display geometry #!optional suppress-map?)
-  (x-graphics-open-window (or display (x-open-display false))
-                         geometry
-                         (and (not (default-object? suppress-map?))
-                              suppress-map?)))
+  (x-graphics-open-window
+   (if (or (not display) (string? display))
+       (let ((d (x-open-display display)))
+        (if (not d)
+            (error "unable to open display" display))
+        d)
+       display)
+   geometry
+   (and (not (default-object? suppress-map?))
+       suppress-map?)))
 
 (define (operation/flush xw)
   (x-window-flush xw)