From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 20 Mar 2011 09:26:07 +0000 (-0700)
Subject: Copy example files to doc/ffi/ directory to avoid relative paths,
X-Git-Tag: 20110426-Gtk~2^2~28
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2d1ce4d1ca096dd22057851a7c66b6b1f4ec3d84;p=mit-scheme.git

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 fdca4e10f..b239f72bd 100644
--- 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 2ca2066dc..f292e54f8 100644
--- 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
index 000000000..91a85df34
--- /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
index 000000000..25caeff5f
--- /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