From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Wed, 20 Nov 2013 01:00:16 +0000 (-0700)
Subject: gtk-screen: Eliminate compile-system.
X-Git-Tag: mit-scheme-pucked-9.2.12~366^2~13
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c364ec3910f818bf56e52e157c87506968ac6b04;p=mit-scheme.git

gtk-screen: Eliminate compile-system.
---

diff --git a/src/gtk-screen/compile.scm b/src/gtk-screen/compile.scm
index d6db56c99..e86b782e9 100644
--- a/src/gtk-screen/compile.scm
+++ b/src/gtk-screen/compile.scm
@@ -2,9 +2,20 @@
 
 ;;;; Compile the Gtk-Screen system
 
-(fluid-let ((load/suppress-loading-message? #t))
-  (load-option 'CREF)
-  ;; DISPLAY need not be set.
-  (ignore-errors (lambda () (load-option 'GTK))))
+(load-option 'CREF)
+(load-option 'SOS)
+(load-option 'GTK)
 
-(compile-system "gtk-screen" (directory-pathname (current-load-pathname)))
\ No newline at end of file
+(with-working-directory-pathname (directory-pathname (current-load-pathname))
+  (lambda ()
+    (if (name->package '(EDWIN SCREEN GTK-SCREEN))
+	(error "The (EDWIN SCREEN GTK-SCREEN) package already exists.")
+	(let ((package-set (package-set-pathname "gtk-screen")))
+	  (if (not (file-modification-time<? "gtk-screen.pkg" package-set))
+	      (cref/generate-trivial-constructor "gtk-screen"))
+	  (construct-packages-from-file (fasload package-set))))
+
+    (let ((env (->environment '(edwin screen gtk-screen))))
+      (compile-file "gtk-screen" '() env)
+      (compile-file "gtk-faces"  '() env))
+    (cref/generate-constructors "gtk-screen" 'ALL)))
\ No newline at end of file