-#| -*-Scheme-*- |#
+#| -*-Scheme-*-
-;;;; Compile the GTK system
+Copyright (C) 2009, 2010, 2011, 2012, 2013 Matthew Birkholz
-(fluid-let ((load/suppress-loading-message? #t))
- (load-option 'CREF)
- (load-option 'SOS)
- (load-option 'FFI))
+This file is part of an extension to MIT/GNU Scheme.
-(with-system-library-directories
- '("./")
+MIT/GNU Scheme is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+MIT/GNU Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
+
+|#
+
+;;;; Compile the GTK wrapper.
+
+(load-option 'CREF)
+(load-option 'SOS)
+(load-option 'FFI)
+(with-working-directory-pathname (directory-pathname (current-load-pathname))
(lambda ()
- (compile-system "gtk" (directory-pathname (current-load-pathname))
- ;; Temporary hack, until the released CREF loosens up
- ;; and simply warns about new options it does not
- ;; support, like the depends-on options commented out
- ;; of gtk.pkg and recreated below.
- 'dependencies
- (let (
- ;; gtk.scm includes the Gtk c-includes, but does
- ;; not otherwise use the FFI.
- (c-types '("gtk-const.bin"))
-
- ;; The wrappers use the FFI, c-includes, and
- ;; some integrable definitions in gtk.scm.
- ;; Dependencies between them are rare.
- (base '("gtk.bin" "gtk"
- ;; "../runtime/ffi" ;; No workie???!!!
- ))
-
- ;; Users of the toolkit interface do NOT use the
- ;; FFI directly, and do not need integrable
- ;; definitions.
- (user '()))
- `(("gtk" ,@c-types)
- ("gobject" ,@base)
- ("gio" ,@base)
- ("pango" ,@base)
- ("cairo" ,@base)
- ("gtk-widget" ,@base)
- ("scm-widget" ,@base)
- ("fix-layout" "pango" "cairo" ,@base ,@c-types)
- ("keys" ,@base ,@c-types)
- ("gtk-graphics" ,@base)
- ("main" ,@base)
- ("thread" "main" ,@user)
- ("gtk-ev" ,@base)
- ("fix-demo" ,@user)
- ("swat" ,@user)
- ("swat-pole-zero" ,@user))))))
\ No newline at end of file
+ (with-system-library-directories
+ '("./")
+ (lambda ()
+ (if (name->package '(GTK))
+ (error "The GTK package already exists.")
+ (let ((package-set (package-set-pathname "gtk")))
+ (if (not (file-exists? package-set))
+ (cref/generate-trivial-constructor "gtk"))
+ (construct-packages-from-file (fasload package-set))))
+
+ ;; gtk.scm includes the Gtk c-includes, but does not otherwise
+ ;; use the FFI.
+ (compile-file "gtk" '("gtk-const.bin") (->environment '(gtk)))
+ ;; Mostly to set! c-includes:
+ (load "gtk" (->environment '(gtk)))
+
+ ;; The wrappers use the FFI, c-includes, and some integrable
+ ;; definitions in gtk.scm. Dependencies between them are
+ ;; rare.
+ (compile-file "gobject" '("gtk") (->environment '(gtk gobject)))
+ (compile-file "gio" '("gtk") (->environment '(gtk gio)))
+ (compile-file "pango" '("gtk") (->environment '(gtk pango)))
+ (compile-file "cairo" '("gtk") (->environment '(gtk cairo)))
+ (compile-file "gtk-widget" '("gtk") (->environment '(gtk gtk-widget)))
+ (compile-file "scm-widget" '("gtk") (->environment '(gtk widget)))
+ (compile-file "fix-layout" '("pango" "cairo" "gtk")
+ (->environment '(gtk fix-layout)))
+ (compile-file "keys" '("gtk") (->environment '(gtk keys)))
+ (compile-file "main" '("gtk") (->environment '(gtk main)))
+ (compile-file "thread" '("main") (->environment '(gtk thread)))
+ (compile-file "gtk-ev" '("gtk") (->environment '(gtk event-viewer)))
+ (compile-file "gtk-graphics" '("gtk")
+ (->environment '(runtime gtk-graphics)))
+
+ ;; Users of the toolkit interface do NOT use the FFI directly,
+ ;; and do not need integrable definitions.
+ (compile-file "fix-demo" '() (->environment '(gtk fix-layout demo)))
+ (compile-file "swat" '() (->environment '(gtk swat)))
+ (compile-file "swat-pole-zero" '() (->environment '(swat)))
+
+ (cref/generate-constructors "gtk" 'ALL)))))
\ No newline at end of file
|#
(load-option 'CREF)
-(compile-system "mit" (directory-pathname (current-load-pathname))
- 'dependencies
- `(("solar" "geometry")
- ("earth" "geometry" "matrices")
- ("mit-cil" "mit-syntax" ,@(directory-read "cil-*.txt"))
- ("tellurion" "geometry" "matrices")))
\ No newline at end of file
+
+(with-working-directory-pathname (directory-pathname (current-load-pathname))
+ (lambda ()
+ (if (name->package '(PLANETARIUM))
+ (error "The PLANETARIUM package already exists.")
+ (let ((package-set (package-set-pathname "mit")))
+ (if (not (file-exists? package-set))
+ (cref/generate-trivial-constructor "mit"))
+ (construct-packages-from-file (fasload package-set))))
+
+ (compile-file "mit-r3rs" '() (->environment '(r3rs extras)))
+ (load "mit-r3rs" (->environment '(r3rs extras)))
+
+ (compile-file "mit-syntax" '() (->environment '(planetarium syntax)))
+ (load "mit-syntax" (->environment '(planetarium syntax)))
+
+ (let ((planet (->environment '(planetarium))))
+ (for-each (lambda (file) (compile-file file '() planet))
+ '("geometry" "matrices" "time" "graphics"))
+ (compile-file "solar" '("geometry") planet)
+ (compile-file "earth" '("geometry" "matrices") planet)
+ (compile-file "tellurion" '("geometry" "matrices") planet))
+
+ (compile-file "mit-gtk" '()
+ (->environment '(planetarium gtk-graphics)))
+ (compile-file "mit-x" '()
+ (->environment '(planetarium x-graphics)))
+ (compile-file "mit-graphics" '()
+ (->environment '(planetarium simple-graphics)))
+
+ (compile-file "mit-cil" `("mit-syntax" ,@(directory-read "cil-*.txt"))
+ (->environment '(planetarium earth-cil)))
+
+ (cref/generate-constructors "mit" 'ALL)))
\ No newline at end of file
projects / mit-scheme.git / commitdiff