Require FFI option. Punt compile-/run-time separation.

This eliminates unanalyzable (unCREFable) syntax transformers, and
compile-time imports.

Bind c-includes in (gtk) so that it does not need to be c-included in
every subpackage.  This assumes compile-system is used, and that
gtk.scm/bin/com is loaded before subpackages are compiled.

diff --git a/src/gtk/compile.scm b/src/gtk/compile.scm
index bd6aba49c05c0fd043f188eecef6cae330a2e1b6..8b095feed2e610a042af4d3cafef9c3a1aa8683a 100644 (file)
--- a/src/gtk/compile.scm
+++ b/src/gtk/compile.scm
@@ -26,9 +26,4 @@
                  ("main"                               "gtk-const.bin")
                  ("gtk-ev"     "gtk.ext" "pango.ext"   "gtk-const.bin")
                  ("fix-demo"   "gtk.ext" "pango.ext")
-                 ("swat"       "gtk.ext" "pango.ext"))
-               ;;
-               ;; Compile-time imports that needn't (shouldn't) exist
-               ;; at run-time.
-               'imports
-               '(((gtk keys) (ffi) find-c-includes c-enum-constant-values)))
\ No newline at end of file
+                 ("swat"       "gtk.ext" "pango.ext")))
\ No newline at end of file

diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm
index 5c3ac65f3e0cd8772f4902dae007c96660c421cf..cbc1d496a9cd4fc3ecb612377daea04d0f5f3e54 100644 (file)
--- a/src/gtk/fix-layout.scm
+++ b/src/gtk/fix-layout.scm
@@ -24,8 +24,6 @@ USA.
 ;;;; <fix-layout>: A fixnum-centric canvas.
 ;;; package: (gtk fix-layout)
 
-(c-include "gtk")
-
 (define-class (<fix-layout> (constructor () (width height)))
     (<scm-widget>)
 

diff --git a/src/gtk/gobject.scm b/src/gtk/gobject.scm
index 971b2daef7b81a76642eab5f8989d4c483ec63b2..edbeb3f216b7326cd4f38d66c4d6f5e96634f639 100644 (file)
--- a/src/gtk/gobject.scm
+++ b/src/gtk/gobject.scm
@@ -24,8 +24,6 @@ USA.
 ;;;; GObjects
 ;;; package: (gtk gobject)
 
-(c-include "gtk")
-
 (define-class <gobject> ()
 
   ;; The address of the toolkit object.  A null alien if the GObject

diff --git a/src/gtk/gtk-ev.scm b/src/gtk/gtk-ev.scm
index 177b567f26ae2a978c310b3ae8c0d05177abbc6f..1fbe35899baa1a8888e8d116747bcab217bb619c 100644 (file)
--- a/src/gtk/gtk-ev.scm
+++ b/src/gtk/gtk-ev.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-Copyright (C) 2007, 2008, 2009  Matthew Birkholz
+Copyright (C) 2007, 2008, 2009, 2011  Matthew Birkholz
 
 This file is part of MIT/GNU Scheme.
 
@@ -24,8 +24,6 @@ USA.
 ;;;; An event viewer, a translation of Havoc Pennington's GtkEv example.
 ;;; package: (gtk event-viewer)
 
-(c-include "gtk")
-
 (define (make-gtk-event-viewer-demo)
   (let ((window (gtk-window-new 'toplevel))
        (gtk-ev (make-gtk-event-viewer)))

diff --git a/src/gtk/gtk-object.scm b/src/gtk/gtk-object.scm
index f7cde673a70a3d0b1c513e481f4c07844e345239..e1b62849d3ff11f3fe4815146d81b53bfe9d214d 100644 (file)
--- a/src/gtk/gtk-object.scm
+++ b/src/gtk/gtk-object.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-Copyright (C) 2007, 2008, 2009, 2010  Matthew Birkholz
+Copyright (C) 2007, 2008, 2009, 2010, 2011  Matthew Birkholz
 
 This file is part of MIT/GNU Scheme.
 
@@ -24,8 +24,6 @@ USA.
 ;;;; GtkObjects/GtkWidgets/GtkContainers
 ;;; package: (gtk gtk-object)
 
-(c-include "gtk")
-
 (define-class <gtk-object> (<gobject>)
   (destroyed? define standard initial-value #f))
 

diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg
index 9a5fdd76af0994e92cf68783b4ef4be8bbdf551b..b5416a63ecf1c99ec4470cc643dc045e27be4f8d 100644 (file)
--- a/src/gtk/gtk.pkg
+++ b/src/gtk/gtk.pkg
@@ -89,7 +89,7 @@ USA.
          <gtk-widget> gtk-widget? guarantee-gtk-widget
          gtk-widget-parent
          gtk-widget-realized?
-         gtk-widget-drawable? gtk-widget-has-focus? 
+         gtk-widget-drawable? gtk-widget-has-focus?
          gtk-widget-grab-focus
          gtk-widget-show
          gtk-widget-show-all
@@ -236,9 +236,7 @@ USA.
   (export (gtk)
          gdk-key-state->char-bits
          gdk-keyval->name)
-  ;; Needed (only) at compile-time.
-  ;; Positively NOT needed at run-time.
-  #;(import (ffi) 
+  (import (ffi)
          find-c-includes
          c-enum-constant-values))
 
@@ -250,6 +248,8 @@ USA.
          stop-gtk-thread)
   (import (gtk gobject)
          run-gc-cleanups)
+  (import (gtk main)
+         run-gtk)
   (import (runtime primitive-io)
          select-registry-handle))
 

diff --git a/src/gtk/gtk.scm b/src/gtk/gtk.scm
index 2ef3620a58520eb188df8c271b8d1184c6e0d315..80de6a54f83d2b3c2aa989d53d6d126f6c94996a 100644 (file)
--- a/src/gtk/gtk.scm
+++ b/src/gtk/gtk.scm
@@ -24,6 +24,8 @@ USA.
 ;;;; Core utilities.
 ;;; package: (gtk)
 
+(define c-includes (load-c-includes "gtk"))
+
 (define-syntax define-integrable-operator
   (er-macro-transformer
    (lambda (form rename compare)

diff --git a/src/gtk/keys.scm b/src/gtk/keys.scm
index c1d460687257dccbe6a0d8c12ac0afcdaf0975df..b24ffbf345c7d941bb1d3539dec5372c79af6873 100644 (file)
--- a/src/gtk/keys.scm
+++ b/src/gtk/keys.scm
@@ -24,8 +24,6 @@ USA.
 ;;;; Gtk Keys
 ;;; Package: (gtk keys)
 
-(c-include "gtk")
-
 (define (gdk-key-state->char-bits modifier-state)
   (fix:+
    (if (bit? modifier-state (C-enum "GDK_CONTROL_MASK")) char-bit:control 0)

diff --git a/src/gtk/main.scm b/src/gtk/main.scm
index 82848c6c6eaaf09155945ee96494d08b1414fe7d..a796a801b41caf480ce8da3e0189d698c4cba134 100644 (file)
--- a/src/gtk/main.scm
+++ b/src/gtk/main.scm
@@ -24,8 +24,6 @@ USA.
 ;;;; Main Loop Hack
 ;;; package: (gtk main)
 
-(c-include "gtk")
-
 (define (gtk-start)
   ;; Called from gtk/make.scm, from a (load-option 'Gtk).
   (set! hook/subprocess-wait nonblocking/subprocess-wait)
@@ -83,6 +81,9 @@ USA.
              (create-gtk-thread)
              (cdr new-args)))))))
 
+(define (run-gtk select-registry-handle time)
+  (C-call "run_gtk" select-registry-handle time))
+
 (define (stop-gtk)
   ;; Sortof does the opposite of gtk-start.
   (without-interrupts

diff --git a/src/gtk/make.scm b/src/gtk/make.scm
index 4514aaa05f28668831756662088fce1abf39fdb8..8bc32f2fd7caf0285cbdd98e3503201d0b627a18 100644 (file)
--- a/src/gtk/make.scm
+++ b/src/gtk/make.scm
@@ -3,6 +3,7 @@
 Load the Gtk option. |#
 
 (load-option 'SOS)
+(load-option 'FFI) ;; (ffi) package referenced in gtk.pkg!
 (with-loader-base-uri (system-library-uri "gtk/")
   (lambda ()
     (load-package-set "gtk")))

diff --git a/src/gtk/pango.scm b/src/gtk/pango.scm
index 50e18131d509f47e2e5df3b28c32a0ea3b1e2954..5be39e7efa25afd8ac8029648919a74f94b466c7 100644 (file)
--- a/src/gtk/pango.scm
+++ b/src/gtk/pango.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-Copyright (C) 2009, 2010  Matthew Birkholz
+Copyright (C) 2009, 2010, 2011  Matthew Birkholz
 
 This file is part of MIT/GNU Scheme.
 
@@ -24,8 +24,6 @@ USA.
 ;;;; Pango interface.
 ;;; package: (gtk pango)
 
-(c-include "gtk")
-
 (define-class (<pango-layout> (constructor ()))
     (<gobject>))
 

diff --git a/src/gtk/scm-widget.scm b/src/gtk/scm-widget.scm
index 3311d974fb78991d48f9eb5f588f45252c18df87..a49635df77c2326b32d648a444170d8bdcc3eaaf 100644 (file)
--- a/src/gtk/scm-widget.scm
+++ b/src/gtk/scm-widget.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-Copyright (C) 2007, 2008, 2009, 2010  Matthew Birkholz
+Copyright (C) 2007, 2008, 2009, 2010, 2011  Matthew Birkholz
 
 This file is part of MIT/GNU Scheme.
 
@@ -24,8 +24,6 @@ USA.
 ;;;; A <gtk-widget> representing a ScmWidget.
 ;;; package: (gtk widget)
 
-(c-include "gtk")
-
 (define-class <scm-widget> (<gtk-widget>))
 
 (define-guarantee scm-widget "a <scm-widget>")

diff --git a/src/gtk/thread.scm b/src/gtk/thread.scm
index b492f7bc2e44a10f4c7f3be94bf1f173b67242f4..c3dabca334d2216d164b2e9d005bb6c4ec925e45 100644 (file)
--- a/src/gtk/thread.scm
+++ b/src/gtk/thread.scm
@@ -25,8 +25,6 @@ USA.
 ;;; package: (gtk thread)
 ;;; parent: (runtime thread)
 
-(c-include "gtk")
-
 (define gtk-thread #f)
 
 ;; Number of GCs between applications of trigger-secondary-gc-daemons!
@@ -69,9 +67,7 @@ USA.
                                     (or next-scheduled-timeout
                                         (no-threads-nor-timers)))))
                       (%trace ";run-gtk until "time"\n")
-                      (C-call "run_gtk"
-                              (select-registry-handle io-registry)
-                              time)
+                      (run-gtk (select-registry-handle io-registry) time)
                       (%trace ";run-gtk done at "(real-time-clock)"\n"))
                     (maybe-signal-io-thread-events)))
                  (yield-current-thread)