Copy example files to doc/ffi/ directory to avoid relative paths,

which aren't working on my machine.

diff --git a/doc/ffi/Makefile.in b/doc/ffi/Makefile.in
index fdca4e10f9ba24a947bcf271c417a24fae4ce735..b239f72bda1abc6bf1bd40b9cbfe951927f26fe2 100644 (file)
--- a/doc/ffi/Makefile.in
+++ b/doc/ffi/Makefile.in
@@ -5,7 +5,7 @@ srcdir = @srcdir@
 top_srcdir = @top_srcdir@
 VPATH = @srcdir@
 
-SOURCES = ffi.texinfo ../../src/ffi/prhello.cdecl ../../src/ffi/prhello.scm
+SOURCES = ffi.texinfo prhello.cdecl prhello.scm
 TEXINFO_ROOT = ffi
 TARGET_ROOT = mit-scheme-ffi
 

diff --git a/doc/ffi/ffi.texinfo b/doc/ffi/ffi.texinfo
index 2ca2066dc7cadd060d07070744127143419befa5..f292e54f89a9def65443f02ccdc788f20efcad72 100644 (file)
--- a/doc/ffi/ffi.texinfo
+++ b/doc/ffi/ffi.texinfo
@@ -730,12 +730,12 @@ Schemely treat, its @code{delete_event} callback is a Scheme procedure
 closed over a binding of @code{counter} that is used to implement some
 impertinent behavior.
 @example
-@verbatiminclude ../../src/ffi/prhello.scm
+@verbatiminclude prhello.scm
 @end example
 
 Here are the C declarations.
 @example
-@verbatiminclude ../../src/ffi/prhello.cdecl
+@verbatiminclude prhello.cdecl
 @end example
 
 To run the example:

diff --git a/doc/ffi/prhello.cdecl b/doc/ffi/prhello.cdecl
new file mode 100644 (file)
index 0000000..91a85df
--- /dev/null
+++ b/doc/ffi/prhello.cdecl
@@ -0,0 +1,85 @@
+#| -*-Scheme-*-
+
+C declarations for prhello.scm. |#
+
+(typedef gint int)
+(typedef guint uint)
+(typedef gchar char)
+(typedef gboolean gint)
+(typedef gpointer (* mumble))
+
+(extern void
+       gtk_init
+       (argc (* int))
+       (argv (* (* (* char)))))
+
+(extern (* GtkWidget)
+       gtk_window_new
+       (type GtkWindowType))
+
+(typedef GtkWindowType
+        (enum
+         (GTK_WINDOW_TOPLEVEL)
+         (GTK_WINDOW_POPUP)))
+
+(extern (* GtkWidget)
+       gtk_button_new)
+
+(extern (* GtkWidget)
+       gtk_label_new
+       (str (* (const char))))
+
+(extern void
+       gtk_container_add
+       (container (* GtkContainer))
+       (widget    (* GtkWidget)))
+
+(extern void
+       gtk_window_set_title
+       (window (* GtkWindow))
+       (title  (* (const gchar))))
+
+(extern void
+       gtk_container_set_border_width
+       (container (* GtkContainer))
+       (border_width guint))
+
+(extern void
+       gtk_widget_show_all
+       (widget (* GtkWidget)))
+
+(extern void
+       g_signal_connect
+       (object (* GtkObject))
+       (name (* gchar))
+       (CALLBACK GtkSignalFunc)
+       (ID gpointer))
+
+(typedef GtkSignalFunc (* mumble))
+
+(callback gboolean
+         delete_event
+         (window (* GtkWidget))
+         (event (* GdkEventAny))
+         (ID gpointer))
+
+(callback void
+         clicked
+         (widget (* GtkWidget))
+         (ID gpointer))
+
+(extern void
+       gtk_widget_destroy
+       (widget (* GtkWidget)))
+
+(extern (* (const gchar))
+       gtk_label_get_text
+       (label (* GtkLabel)))
+
+(extern void
+       gtk_label_set_text
+       (label (* GtkLabel))
+       (str (* (const char))))
+
+(extern void gtk_main)
+(extern void gtk_main_quit)
\ No newline at end of file

diff --git a/doc/ffi/prhello.scm b/doc/ffi/prhello.scm
new file mode 100644 (file)
index 0000000..25caeff
--- /dev/null
+++ b/doc/ffi/prhello.scm
@@ -0,0 +1,55 @@
+#| -*-Scheme-*-
+
+This is Havoc Pennington's Hello World example from GGAD, in the raw
+FFI.  Note that no arrangements have been made to de-register the
+callbacks. |#
+
+(declare (usual-integrations))
+
+(C-include "prhello")
+
+(define (hello)
+  (C-call "gtk_init" 0 null-alien)
+  (let ((window (let ((alien (make-alien '|GtkWidget|)))
+                 (C-call "gtk_window_new" alien
+                         (C-enum "GTK_WINDOW_TOPLEVEL"))
+                 (if (alien-null? alien) (error "Could not create window."))
+                 alien))
+       (button (let ((alien (make-alien '|GtkWidget|)))
+                 (C-call "gtk_button_new" alien)
+                 (if (alien-null? alien) (error "Could not create button."))
+                 alien))
+       (label (let ((alien (make-alien '|GtkWidget|)))
+                (C-call "gtk_label_new" alien "Hello, World!")
+                (if (alien-null? alien) (error "Could not create label."))
+                alien)))
+    (C-call "gtk_container_add" button label)
+    (C-call "gtk_container_add" window button)
+    (C-call "gtk_window_set_title" window "Hello")
+    (C-call "gtk_container_set_border_width" button 10)
+    (let ((counter 0))
+      (C-call "g_signal_connect" window "delete_event"
+             (C-callback "delete_event")       ;trampoline
+             (C-callback                       ;callback ID
+              (lambda (w e)
+                (outf-console ";Delete me "(- 2 counter)" times.\n")
+                (set! counter (1+ counter))
+                ;; Three or more is the charm.
+                (if (> counter 2)
+                    (begin
+                      (C-call "gtk_main_quit")
+                      0)
+                    1))))
+      (C-call "g_signal_connect" button "clicked"
+             (C-callback "clicked")    ;trampoline
+             (C-callback                       ;callback ID
+              (lambda (w)
+                (let ((gstring (make-alien '(* |gchar|))))
+                  (C-call "gtk_label_get_text" gstring label)
+                  (let ((text (c-peek-cstring gstring)))
+                    (C-call "gtk_label_set_text" label
+                            (list->string (reverse! (string->list text))))))
+                unspecific))))
+    (C-call "gtk_widget_show_all" window)
+    (C-call "gtk_main")
+    window))
\ No newline at end of file