Created this directory for the Guile 1.3 release. Thanks to Jay

Glascoe for suggesting that we provide a complete, buildable
example!
* ChangeLog, Makefile, README, image-type.c, image-type.h,
myguile: New files.

diff --git a/doc/example-smob/Makefile b/doc/example-smob/Makefile
new file mode 100644 (file)
index 0000000..b312c45
--- /dev/null
+++ b/doc/example-smob/Makefile
@@ -0,0 +1,12 @@
+CFLAGS=`guile-config compile`
+LDFLAGS=`guile-config link`
+
+O_FILES=image-type.o myguile.o
+
+all: myguile
+
+myguile: $(O_FILES)
+       $(CC) $(LDFLAGS) $(O_FILES) -o myguile
+
+clean:
+       -rm -rf myguile $(O_FILES)

diff --git a/doc/example-smob/README b/doc/example-smob/README
new file mode 100644 (file)
index 0000000..1380db1
--- /dev/null
+++ b/doc/example-smob/README
@@ -0,0 +1,6 @@
+This is the example code for the ``Defining New Types (Smobs)''
+chapter of the Guile manual.
+
+When you try to execute the code, if the system complains that it
+can't find libguile.so, you need to add the directory containing the
+installed Guile libraries to your LD_LIBRARY_PATH environment variable.

diff --git a/doc/example-smob/image-type.c b/doc/example-smob/image-type.c
new file mode 100644 (file)
index 0000000..083d5df
--- /dev/null
+++ b/doc/example-smob/image-type.c
@@ -0,0 +1,116 @@
+/* file "image-type.c" */
+
+#include <stdlib.h>
+#include <libguile.h>
+
+static long image_tag;
+
+struct image {
+  int width, height;
+  char *pixels;
+
+  /* The name of this image */
+  SCM name;
+
+  /* A function to call when this image is
+     modified, e.g., to update the screen,
+     or SCM_BOOL_F if no action necessary */
+  SCM update_func;
+};
+
+static SCM
+make_image (SCM name, SCM s_width, SCM s_height)
+{
+  struct image *image;
+  SCM image_smob;
+  int width, height;
+
+  SCM_ASSERT (SCM_NIMP (name) && SCM_STRINGP (name), name,
+             SCM_ARG1, "make-image");
+  SCM_ASSERT (SCM_INUMP (s_width),  s_width,  SCM_ARG2, "make-image");
+  SCM_ASSERT (SCM_INUMP (s_height), s_height, SCM_ARG3, "make-image");
+
+  width = SCM_INUM (s_width);
+  height = SCM_INUM (s_height);
+  
+  image = (struct image *) scm_must_malloc (sizeof (struct image), "image");
+  image->width = width;
+  image->height = height;
+  image->pixels = scm_must_malloc (width * height, "image pixels");
+  image->name = name;
+  image->update_func = SCM_BOOL_F;
+
+  SCM_NEWCELL (image_smob);
+  SCM_SETCDR (image_smob, image);
+  SCM_SETCAR (image_smob, image_tag);
+
+  return image_smob;
+}
+
+static SCM
+clear_image (SCM image_smob)
+{
+  int area;
+  struct image *image;
+
+  SCM_ASSERT ((SCM_NIMP (image_smob)
+              && SCM_CAR (image_smob) == image_tag),
+             image_smob, SCM_ARG1, "clear-image");
+
+  image = (struct image *) SCM_CDR (image_smob);
+  area = image->width * image->height;
+  memset (image->pixels, 0, area);
+
+  /* Invoke the image's update function.  */
+  if (image->update_func != SCM_BOOL_F)
+    scm_apply (image->update_func, SCM_EOL, SCM_EOL);
+
+  return SCM_UNSPECIFIED;
+}
+
+static SCM
+mark_image (SCM image_smob)
+{
+  struct image *image = (struct image *) SCM_CDR (image_smob);
+
+  scm_gc_mark (image->name);
+  return image->update_func;
+}
+
+static scm_sizet
+free_image (SCM image_smob)
+{
+  struct image *image = (struct image *) SCM_CDR (image_smob);
+  scm_sizet size = image->width * image->height + sizeof (struct image);
+
+  free (image->pixels);
+  free (image);
+
+  return size;
+}
+
+static int
+print_image (SCM image_smob, SCM port, scm_print_state *pstate)
+{
+  struct image *image = (struct image *) SCM_CDR (image_smob);
+
+  scm_puts ("#<image ", port);
+  scm_display (image->name, port);
+  scm_puts (">", port);
+
+  /* non-zero means success */
+  return 1;
+}
+
+static scm_smobfuns image_funs = {
+  mark_image, free_image, print_image, 0
+};
+
+void
+init_image_type ()
+{
+  image_tag = scm_newsmob (&image_funs);
+
+  scm_make_gsubr ("clear-image", 1, 0, 0, clear_image);
+  scm_make_gsubr ("make-image", 3, 0, 0, make_image);
+}

diff --git a/doc/example-smob/image-type.h b/doc/example-smob/image-type.h
new file mode 100644 (file)
index 0000000..e57b1c6
--- /dev/null
+++ b/doc/example-smob/image-type.h
@@ -0,0 +1,3 @@
+/* file "image-type.h" */
+
+void init_image_type(void);

diff --git a/doc/example-smob/myguile.c b/doc/example-smob/myguile.c
new file mode 100644 (file)
index 0000000..7234b98
--- /dev/null
+++ b/doc/example-smob/myguile.c
@@ -0,0 +1,17 @@
+#include <libguile.h>
+#include "image-type.h"
+
+static void
+inner_main (void *closure, int argc, char **argv)
+{
+  /* module initializations would go here */
+  init_image_type();
+  scm_shell (argc, argv);
+}
+
+int
+main (int argc, char **argv)
+{
+  scm_boot_guile (argc, argv, inner_main, 0);
+  return 0; /* never reached */
+}