code:
2008-01-22  Neil Jerram  <neil@ossau.uklinux.net>

	* compat/compat.h: Update copyright statement to LGPL.

2002-11-17  Mikael Djurfeldt  <mdj@linnaeus>

	* README: Added description of compat.

	* compat/acconfig.h, compat/acinclude.m4, compat.h, configure.in:
	New files.

2001-07-24  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>

	All examples are now built and tested on `make installcheck'
	rather than `make check'.

2001-07-19  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>

	* box-dynamic-module/Makefile.am, box-dynamic/Makefile.am,
	box-module/Makefile.am, box/Makefile.am: Use $(top_srcdir) to get
	at GUILE_LOAD_PATH, and $(top_builddir) for the guile and
	guile-config programs and for the link paths.  Add check.test to
	EXTRA_DIST.

	* box-dynamic-module/Makefile.am, box-dynamic/Makefile.am,
	box-module/Makefile.am, box/Makefile.am: Add -L../../qt to LIBS.

2001-07-19  Rob Browning  <rlb@defaultvalue.org>

	* box-module/.cvsignore: add .deps

	* box/.cvsignore: add .deps.

2001-07-17  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>

	* box-module/Makefile.am (TESTS): New variable.
	Create `box' on `make all'.

	* box-module/check.test, box-dynamic-module/check.test,
	* box-dynamic/check.test: New files.

	* box-dynamic/Makefile.am (libbox): Create box library on `make
	all'.
	(TESTS): New variable.

	* box/Makefile.am (TESTS): New variable.
	Create `box' program on `make all', use freshly built Guile for
	building.

	* box/check.test: New file.

	* modules/check.test, safe/check.test, scripts/check.test: Set
	GUILE_LOAD_PATH to make the tests run without installed Guile.

2001-07-16  Thien-Thi Nguyen  <ttn@revel.glug.org>

	* scripts/check.test: Add check for guile interpreter.
	Fix bug: Use `$guile' everywhere.  Thanks to Martin Grabmueller.

2001-07-16  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>

	* modules/check.test, safe/check.test: New files.

	* modules/Makefile.am (TESTS), safe/Makefile.am (TESTS): New
	variables.

2001-07-14  Thien-Thi Nguyen  <ttn@revel.glug.org>

	* scripts/check.test: New file.

	* Makefile.am (TESTS): New var.

2001-07-14  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>

	* modules/main: Use :renamer for specifying renaming procedure.

2001-07-10  Thien-Thi Nguyen  <ttn@revel.glug.org>

	* scripts/hello (display-version, display-help): Fix comment; nfc.

2001-07-09  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>

	* box-dynamic/README: Corrected sample session.

	* box-module/box.c, box-dynamic-module/box.c, box-dynamic/box.c
	* box/box.c: scm_bits_t -> scm_t_bits.

2001-06-18  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>

	* box-dynamic-module/README: Use a better example for box-map, as
	suggested by Thomas Wawrzinek.

2001-06-14  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>

	* scripts/README, scripts/hello.scm, safe/untrusted.scm,
	safe/evil.scm, safe/README, modules/README, modules/main,
	modules/module-0.scm, modules/module-1.scm, modules/module-2.scm:
	Minor cleanup.

	* README: Added intro stuff, restructured a bit.

	* box-dynamic/README, box-module/README, box/README: Cleanup and
	restructuring.

	* box-dynamic-module/box-mixed.scm: New file, demonstrating usage
	of extension library functionality, but without exporting
	procedures from the library.

	Thanks to Thomas Wawrzinek for the idea and example code!

	* box-dynamic-module/box-module.scm: Add comments, export
	make-box, box-ref, box-set!.

	* box-dynamic-module/README: Integrate new module (box-mixed),
	restructure and cleanup a bit.

2001-06-06  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>

	* box-dynamic-module/box-module.scm: New file.

2001-06-05  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>

	* box-dynamic-module: New directory, implements the box type in a
	shared library and places the definitions in a C-only module.

	Thanks to Thomas Wawrzinek for this, too!

	* box-dynamic/box.c, box/box.c, box-dynamic-module/box.c,
	box-module/box.c (mark_box): Fixed typo in comment.

2001-06-01  Rob Browning  <rlb@cs.utexas.edu>

	* .cvsignore: here and in all subdirectories listing Makefile and
	Makefile.in.

2001-05-31  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>

	* box-dynamic: New directory, implements the box type in a shared
	library (aka extension)

	Thanks to Thomas Wawrzinek for patching box.c into an extension!

2001-05-30  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>

	* box-module: New directory, similar to box, but defines the
	primitives in a module (box-module) instead of defining them
	globally.

	* safe: New directory, explaining some aspects of using safe
	environments for evaluation.

2001-05-29  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>

	* New directory for Guile example code.


code:
## Process this file with Automake to create Makefile.in
##
##   Copyright (C) 2001, 2006, 2008, 2009 Free Software Foundation, Inc.
##
##   This file is part of GUILE.
##
##   GUILE 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, or
##   (at your option) any later version.
##
##   GUILE 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 GUILE; see the file COPYING.  If not, write
##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
##   Floor, Boston, MA 02110-1301 USA

EXTRA_DIST = README ChangeLog-2008 check.test				\
									\
 scripts/README scripts/simple-hello.scm scripts/hello			\
 scripts/fact								\
									\
 box/README box/box.c							\
									\
 box-module/README box-module/box.c					\
									\
 box-dynamic/README box-dynamic/box.c					\
									\
 box-dynamic-module/README box-dynamic-module/box.c			\
 box-dynamic-module/box-module.scm box-dynamic-module/box-mixed.scm	\
									\
 modules/README modules/module-0.scm modules/module-1.scm		\
 modules/module-2.scm modules/main					\
									\
 safe/README safe/safe safe/untrusted.scm safe/evil.scm

AM_CFLAGS = `$(bindir)/guile-config compile`
AM_LIBS   = `$(bindir)/guile-config link`

box/box: box/box.o
	-$(MKDIR_P) box
	$(CC) $< $(AM_LIBS) -o $@

box/box.o: box/box.c
	-$(MKDIR_P) box
	$(CC) $(AM_CFLAGS) -c $< -o $@

box-module/box: box-module/box.o
	-$(MKDIR_P) box-module
	$(CC) $< $(AM_LIBS) -o $@

box-module/box.o: box-module/box.c
	-$(MKDIR_P) box-module
	$(CC) $(AM_CFLAGS) -c $< -o $@

libbox.la: box-dynamic/box.lo
	$(top_builddir)/libtool --mode=link $(CC) $< $(AM_LIBS) -rpath $(libdir) -o $@

box-dynamic/box.lo: box-dynamic/box.c
	-$(MKDIR_P) box-dynamic
	$(top_builddir)/libtool --mode=compile $(CC) $(AM_CFLAGS) -c $< -o $@

libbox-module.la: box-dynamic-module/box.lo
	$(top_builddir)/libtool --mode=link $(CC) $< $(AM_LIBS) -rpath $(libdir) -o $@

box-dynamic-module/box.lo: box-dynamic-module/box.c
	-$(MKDIR_P) box-dynamic-module
	$(top_builddir)/libtool --mode=compile $(CC) $(AM_CFLAGS) -c $< -o $@

installcheck: box/box box-module/box libbox.la libbox-module.la
	LD_LIBRARY_PATH="$(libdir):$$LD_LIBRARY_PATH"		\
	  LTDL_LIBRARY_PATH="$(builddir):$$LTDL_LIBRARY_PATH"	\
	  GUILE_LOAD_PATH="$(abs_top_srcdir):$$GUILE_LOAD_PATH"	\
	  PATH="$(bindir):$$PATH"				\
	  srcdir="$(srcdir)"					\
	  $(srcdir)/check.test

CLEANFILES =					\
  box/box box/box.o				\
  box-module/box box-module/box.o

clean-local:
	$(top_builddir)/libtool --mode=clean rm -f	\
	  box-dynamic/box.lo libbox.la			\
	  box-dynamic-module/box.lo libbox-module.la

license: unknown


code:
							       -*- outline -*-

* Overview

This directory contains examples illustrating various aspects of Guile
programming.

If you plan writing Scheme programs, have a look at the `scripts'
directory.  To learn more about Guile modules, check out the `modules'
directory, and maybe the `box-module' and `box-dynamic-module'
directories, if you are into C programming or shared libraries,
respectively.  The `safe' directory contains examples for evaluation
Scheme code in controlled environments (sandboxing).  The directories
`box', `box-module', `box-dynamic' and `box-dynamic-module' are
interesting if you plan writing Guile extensions.

See the README files in the subdirectories for details.

* Included Examples

scripts             Examples for writing simple scripts in Guile Scheme.

box		    Example for extending Guile with a new data type.

box-module	    Similar to `box', but defines new procedures in a
		    named module.
box-dynamic	    Implements the box type in a dynamically loadable
		    library.
box-dynamic-module  Combination of `box-module' and `box-dynamic':
		    Implements the `box' type in a shared library and
		    defines the procedures in a Guile module.

modules		    Examples for writing and using Guile modules.

safe		    Examples for creating and using safe environments.

compat		    autoconf code for making a Guile extension
		    compatible with older versions of Guile.

path: examples/README


code:
							       -*- outline -*-

* Overview

This directory includes an example program for extending Guile with a
new (and even useful) data type, putting it into a shared library, so it
can be called from an unmodified guile interpreter. Further, the shared
library defines a new guile module.

* Build Instructions

To build the example, simply type

  make libbox-module

in this directory.

* The Box Data Type

A box is simply an object for storing one other object in.  It can be
used for passing parameters by reference, for example.  You simply
store an object into a box, pass it to another procedure which can
store a new object into it and thus return a value via the box.

** Usage

Box objects are created with `make-box', set with `box-set!' and
examined with `box-ref'.  Note that these procedures are placed in a
module called (box-module) and can thus only be accessed after using
this module.  See the following example session for usage details.

** The Module (box-module)

Extend your LD_LIBRARY_PATH variable (or equivalent) to include . and
.libs and make sure that your current working directory is the one
this file is contained in.

$ guile
guile> (use-modules (box-module))
guile> (define b (make-box))
guile> b
#<box #f>
guile> (box-set! b '(list of values))
guile> b
#<box (list of values)>
guile> (box-ref b)
(list of values)
guile> (quit)
$

** The Module (box-mixed)

The following example uses the module (box-mixed), also included in
this directory.  It uses the shared library libbox-module like the
module (box-module) above, but does not export the procedures from
that module.  It only implements some procedures for dealing with box
objects.

$ guile
guile> (use-modules (box-mixed))
guile> (define bl  (make-box-list 1 2 3))
guile> bl
(#<box 1> #<box 2> #<box 3>)
guile> (box-map 1+ bl)
(#<box 2> #<box 3> #<box 4>)
guile> (quit)
$

If you like this example so much that you want to have it available
for normal usage, install the dynamic libraries in the .libs directory
to the directory $(prefix)/lib and the scheme file `box-module.scm' in
a directory in your GUILE_LOAD_PATH.

path: examples/box-dynamic-module/README


code:
;;; examples/box-dynamic-module/box-mixed.scm -- Scheme module using some
;;;   functionality from the shared library libbox-module, but do not
;;;   export procedures from the module.

;;; Commentary:

;;; This is the Scheme module box-mixed.  It uses some functionality
;;; from the shared library libbox-module, but does not export it.

;;; Code:

;;; Author: Thomas Wawrzinek
;;; Date: 2001-06-08
;;; Changed: 2001-06-14 by martin, some commenting, cleanup and integration.

(define-module (box-mixed))

;; First, load the library.
;;
(load-extension "libbox-module" "scm_init_box")

;; Create a list of boxes, each containing one element from ARGS.
;;
(define (make-box-list . args)
  (map (lambda (el)
	 (let ((b (make-box)))
	   (box-set! b el) b))
       args))

;; Map the procedure FUNC over all elements of LST, which must be a
;; list of boxes.  The result is a list of freshly allocated boxes,
;; each containing the result of an application of FUNC.
(define (box-map func lst)
  (map (lambda (el)
	 (let ((b (make-box)))
	   (box-set! b (func (box-ref el)))
	   b))
       lst))

;; Export the procedures, so that they can be used by others.
;;
(export make-box-list box-map)

;;; End of file.


code:
;;; examples/box-dynamic-module/box-module.scm -- Scheme module exporting
;;;   some functionality from the shared library libbox-module.

;;; Commentary:

;;; This is the Scheme part of the dynamic library module (box-module).
;;; When you do a (use-modules (box-module)) in this directory,
;;; this file gets loaded and will load the compiled extension.

;;; Code:

;;; Author: Martin Grabmueller
;;; Date: 2001-06-06

(define-module (box-module))

;; First, load the library.
;;
(load-extension "libbox-module" "scm_init_box")

;; Then export the procedures which should be visible to module users.
;;
(export make-box box-ref box-set!)

;;; End of file.


code:
/* examples/box-dynamic-module/box.c
 *
 *	Copyright (C) 1998,2001, 2006 Free Software Foundation, Inc.
 *
 * This program 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, or (at your option)
 * any later version.
 *
 * This program 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 this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 * Boston, MA 02110-1301 USA
 */

/* Include all needed declarations.  */
#include <libguile.h>

/* The type code for the newly created smob type will be stored into
   this variable.  It has the prefix `scm_tc16_' to make it usable
   with the SCM_VALIDATE_SMOB macro below.  */
static scm_t_bits scm_tc16_box;

/* This function is responsible for marking all SCM objects included
   in the smob.  */
static SCM
mark_box (SCM b)
{
  /* Since we have only one SCM object to protect, we simply return it
     and the caller will mark it.  */
  return SCM_CELL_OBJECT_1 (b);
}

/* Print a textual represenation of the smob to a given port.  */
static int
print_box (SCM b, SCM port, scm_print_state *pstate)
{
  SCM value = SCM_CELL_OBJECT_1 (b);

  scm_puts ("#<box ", port);
  scm_write (value, port);
  scm_puts (">", port);

  /* Non-zero means success.  */
  return 1;
}

/* This defines the primitve `make-box', which returns a new smob of
   type `box', initialized to `#f'.  */
static SCM
#define FUNC_NAME "make-box"
make_box (void)
{
  /* This macro creates the new objects, stores the value `#f' into it
     and returns it to the caller.  */
  SCM_RETURN_NEWSMOB (scm_tc16_box, SCM_BOOL_F);
}
#undef FUNC_NAME

/* This is the primitive `box-ref' which returns the object stored in
   the box.  */
static SCM
box_ref (SCM b)
#define FUNC_NAME "box-ref"
{
  /* First, we have to ensure that the user really gave us a box
     objects.  The macro SCM_VALIDATE_SMOB will do all what is needed.
     The parameters are interpreted as follows:

     1: The position of the checked variable in the parameter list.
     b: The passed parameter.
     box: Concatenated with the fixed prefix scm_tc16_, names the type
          code for the expected smob type.  */
  SCM_VALIDATE_SMOB (1, b, box);

  /* Fetch the object from the box and return it.  */
  return SCM_CELL_OBJECT_1 (b);
}
#undef FUNC_NAME

/* Primitive which stores an arbitrary value into a box.  */
static SCM
box_set_x (SCM b, SCM value)
#define FUNC_NAME "box-set!"
{
  SCM_VALIDATE_SMOB (1, b, box);

  /* Set the cell number 1 of the smob to the given value.  */
  SCM_SET_CELL_OBJECT_1 (b, value);

  /* When this constant is returned, the REPL will not print the
     returned value.  All procedures in Guile which are documented as
     returning `and unspecified value' actually return this value.  */
  return SCM_UNSPECIFIED;
}
#undef FUNC_NAME

/* This is the function which must be given to `load-extension' as the
   second argument.  In this example, the Scheme file box-module.scm
   (or box-mixed.scm) is responsible for doing the load-extension
   call.  The Scheme modules are also responsible for placing the
   procedure definitions in the correct module. */
void
scm_init_box ()
{
  scm_tc16_box = scm_make_smob_type ("box", 0);
  scm_set_smob_mark (scm_tc16_box, mark_box);
  scm_set_smob_print (scm_tc16_box, print_box);

  scm_c_define_gsubr ("make-box", 0, 0, 0, make_box);
  scm_c_define_gsubr ("box-set!", 2, 0, 0, box_set_x);
  scm_c_define_gsubr ("box-ref", 1, 0, 0, box_ref);
}

/* End of file.  */


code:
							       -*- outline -*-

* Overview

This directory includes an example program for extending Guile with a
new (and even useful) data type, putting it into a shared library, so it
can be called from an unmodified guile interpreter.

* Build Instructions

To build the example, simply type

  make libbox

in this directory.

* The Box Data Type

A box is simply an object for storing one other object in.  It can be
used for passing parameters by reference, for example.  You simply
store an object into a box, pass it to another procedure which can
store a new object into it and thus return a value via the box.

** Usage

Box objects are created with `make-box', set with `box-set!' and
examined with `box-ref'.  Note that these procedures are placed in a
module called (box-module) and can thus only be accessed after using
this module.  See the following example session for usage details:

Extend your LD_LIBRARY_PATH variable (or equivalent) to include . and
.libs

** Example Session

$ guile
guile> (load-extension "libbox" "scm_init_box")
guile> (define b (make-box))
guile> b
#<box #f>
guile> (box-set! b '(list of values))
guile> b
#<box (list of values)>
guile> (box-ref b)
(list of values)
guile> (quit)
$

* Module Installation

If you like this example so much that you want to have it available
for normal usage, install the dynamic libraries in the .libs directory
to the directory $(prefix)/lib

path: examples/box-dynamic/README


code:
/* examples/box-dynamic/box.c
 *
 *	Copyright (C) 1998,2001, 2006 Free Software Foundation, Inc.
 *
 * This program 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, or (at your option)
 * any later version.
 *
 * This program 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 this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 * Boston, MA 02110-1301 USA
 */

/* Include all needed declarations.  */
#include <libguile.h>

/* The type code for the newly created smob type will be stored into
   this variable.  It has the prefix `scm_tc16_' to make it usable
   with the SCM_VALIDATE_SMOB macro below.  */
static scm_t_bits scm_tc16_box;

/* This function is responsible for marking all SCM objects included
   in the smob.  */
static SCM
mark_box (SCM b)
{
  /* Since we have only one SCM object to protect, we simply return it
     and the caller will mark it.  */
  return SCM_CELL_OBJECT_1 (b);
}

/* Print a textual represenation of the smob to a given port.  */
static int
print_box (SCM b, SCM port, scm_print_state *pstate)
{
  SCM value = SCM_CELL_OBJECT_1 (b);

  scm_puts ("#<box ", port);
  scm_write (value, port);
  scm_puts (">", port);

  /* Non-zero means success.  */
  return 1;
}

/* This defines the primitve `make-box', which returns a new smob of
   type `box', initialized to `#f'.  */
static SCM
#define FUNC_NAME "make-box"
make_box (void)
{
  /* This macro creates the new objects, stores the value `#f' into it
     and returns it to the caller.  */
  SCM_RETURN_NEWSMOB (scm_tc16_box, SCM_BOOL_F);
}
#undef FUNC_NAME

/* This is the primitive `box-ref' which returns the object stored in
   the box.  */
static SCM
box_ref (SCM b)
#define FUNC_NAME "box-ref"
{
  /* First, we have to ensure that the user really gave us a box
     objects.  The macro SCM_VALIDATE_SMOB will do all what is needed.
     The parameters are interpreted as follows:

     1: The position of the checked variable in the parameter list.
     b: The passed parameter.
     box: Concatenated with the fixed prefix scm_tc16_, names the type
          code for the expected smob type.  */
  SCM_VALIDATE_SMOB (1, b, box);

  /* Fetch the object from the box and return it.  */
  return SCM_CELL_OBJECT_1 (b);
}
#undef FUNC_NAME

/* Primitive which stores an arbitrary value into a box.  */
static SCM
box_set_x (SCM b, SCM value)
#define FUNC_NAME "box-set!"
{
  SCM_VALIDATE_SMOB (1, b, box);

  /* Set the cell number 1 of the smob to the given value.  */
  SCM_SET_CELL_OBJECT_1 (b, value);

  /* When this constant is returned, the REPL will not print the
     returned value.  All procedures in Guile which are documented as
     returning `and unspecified value' actually return this value.  */
  return SCM_UNSPECIFIED;
}
#undef FUNC_NAME

/* Create and initialize the new smob type, and register the
   primitives with the interpreter library.

   To be called with (load-extension "libbox" "scm_init_box")
   from a script.
*/
void
scm_init_box ()
{
  scm_tc16_box = scm_make_smob_type ("box", 0);
  scm_set_smob_mark (scm_tc16_box, mark_box);
  scm_set_smob_print (scm_tc16_box, print_box);

  scm_c_define_gsubr ("make-box", 0, 0, 0, make_box);
  scm_c_define_gsubr ("box-set!", 2, 0, 0, box_set_x);
  scm_c_define_gsubr ("box-ref", 1, 0, 0, box_ref);
}

/* End of file.  */


code:
							       -*- outline -*-

* Overview

This directory includes an example program for extending Guile with a
new (and even useful) data type.

The `box' program created by this example is nearly identical to the
one produced in directory ../box, with one (important) difference: The
interpreter in this directory will place all defined primitive
procedures in a module called (box-module).  That means that this
module must be used before the primitives can be accessed.

* Build Instructions

To build the example, simply type

  make box

in this directory.

The resulting `box' program is a Guile interpreter which has one
additional data type called `box'.

* The Box Data Type

A box is simply an object for storing one other object in.  It can be
used for passing parameters by reference, for example.  You simply
store an object into a box, pass it to another procedure which can
store a new object into it and thus return a value via the box.

** Usage

Box objects are created with `make-box', set with `box-set!' and
examined with `box-ref'.  Note that these procedures are placed in a
module called (box-module) and can thus only be accessed after using
this module.  See the following example session for usage details:

** Example Session

$ ./box
guile> (use-modules (box-module))
guile> (define b (make-box))
guile> b
#<box #f>
guile> (box-set! b '(list of values))
guile> b
#<box (list of values)>
guile> (box-ref b)
(list of values)
guile> (quit)
$

path: examples/box-module/README


code:
/* examples/box-module/box.c
 *
 *	Copyright (C) 1998,2001, 2006 Free Software Foundation, Inc.
 *
 * This program 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, or (at your option)
 * any later version.
 *
 * This program 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 this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 * Boston, MA 02110-1301 USA
 */

/* Include all needed declarations.  */
#include <libguile.h>

/* The type code for the newly created smob type will be stored into
   this variable.  It has the prefix `scm_tc16_' to make it usable
   with the SCM_VALIDATE_SMOB macro below.  */
static scm_t_bits scm_tc16_box;

/* This function is responsible for marking all SCM objects included
   in the smob.  */
static SCM
mark_box (SCM b)
{
  /* Since we have only one SCM object to protect, we simply return it
     and the caller will mark it.  */
  return SCM_CELL_OBJECT_1 (b);
}

/* Print a textual represenation of the smob to a given port.  */
static int
print_box (SCM b, SCM port, scm_print_state *pstate)
{
  SCM value = SCM_CELL_OBJECT_1 (b);

  scm_puts ("#<box ", port);
  scm_write (value, port);
  scm_puts (">", port);

  /* Non-zero means success.  */
  return 1;
}

/* This defines the primitve `make-box', which returns a new smob of
   type `box', initialized to `#f'.  */
static SCM
#define FUNC_NAME "make-box"
make_box (void)
{
  /* This macro creates the new objects, stores the value `#f' into it
     and returns it to the caller.  */
  SCM_RETURN_NEWSMOB (scm_tc16_box, SCM_BOOL_F);
}
#undef FUNC_NAME

/* This is the primitive `box-ref' which returns the object stored in
   the box.  */
static SCM
box_ref (SCM b)
#define FUNC_NAME "box-ref"
{
  /* First, we have to ensure that the user really gave us a box
     objects.  The macro SCM_VALIDATE_SMOB will do all what is needed.
     The parameters are interpreted as follows:

     1: The position of the checked variable in the parameter list.
     b: The passed parameter.
     box: Concatenated with the fixed prefix scm_tc16_, names the type
          code for the expected smob type.  */
  SCM_VALIDATE_SMOB (1, b, box);

  /* Fetch the object from the box and return it.  */
  return SCM_CELL_OBJECT_1 (b);
}
#undef FUNC_NAME

/* Primitive which stores an arbitrary value into a box.  */
static SCM
box_set_x (SCM b, SCM value)
#define FUNC_NAME "box-set!"
{
  SCM_VALIDATE_SMOB (1, b, box);

  /* Set the cell number 1 of the smob to the given value.  */
  SCM_SET_CELL_OBJECT_1 (b, value);

  /* When this constant is returned, the REPL will not print the
     returned value.  All procedures in Guile which are documented as
     returning `and unspecified value' actually return this value.  */
  return SCM_UNSPECIFIED;
}
#undef FUNC_NAME

/* Create and initialize the new smob type, and register the
   primitives withe the interpreter library.

   This function must be declared a bit different from the example in
   the ../box directory, because it will be called by
   `scm_c_define_module', called from below.  */
static void
init_box_type (void * unused)
{
  scm_tc16_box = scm_make_smob_type ("box", 0);
  scm_set_smob_mark (scm_tc16_box, mark_box);
  scm_set_smob_print (scm_tc16_box, print_box);

  scm_c_define_gsubr ("make-box", 0, 0, 0, make_box);
  scm_c_define_gsubr ("box-set!", 2, 0, 0, box_set_x);
  scm_c_define_gsubr ("box-ref", 1, 0, 0, box_ref);

  /* This is new too: Since the procedures are now in a module, we
     have to explicitly export them before they can be used.  */
  scm_c_export ("make-box", "box-set!", "box-ref", NULL);
}

/* This is the function which gets called by scm_boot_guile after the
   Guile library is completely initialized.  */
static void
inner_main (void *closure, int argc, char **argv)
{
  /* Unlike the example in ../box, init_box_type is not called
     directly, but by scm_c_define_module, which will create a module
     named (box-module) and make this module current while called
     init_box_type, thus placing the definitions into that module.  */
  scm_c_define_module ("box-module", init_box_type, NULL);

  /* ... then we start a shell, in which the box data type can be
     used (after using the module (box-module)).  */
  scm_shell (argc, argv);
}

/* Main program.  */
int
main (int argc, char **argv)
{
  /* Initialize Guile, then call `inner_main' with the arguments 0,
     argc and argv.  */
  scm_boot_guile (argc, argv, inner_main, 0);
  return 0; /* Never reached.  */
}

/* End of file.  */


code:
							       -*- outline -*-

* Overview

This directory includes an example program for extending Guile with a
new (and even useful) data type.

* Build Instructions

To build the example, simply type

  make box

in this directory.

The resulting `box' program is a Guile interpreter which has one
additional data type called `box'.

* The Box Data Type

A box is simply an object for storing one other object in.  It can be
used for passing parameters by reference, for example.  You simply
store an object into a box, pass it to another procedure which can
store a new object into it and thus return a value via the box.

** Usage

Box objects are created with `make-box', set with `box-set!' and
examined with `box-ref'.  See the following example session for usage
details:

** Example Session

$ ./box
guile> (define b (make-box))
guile> b
#<box #f>
guile> (box-set! b '(list of values))
guile> b
#<box (list of values)>
guile> (box-ref b)
(list of values)
guile> (quit)
$

path: examples/box/README


code:
/* examples/box/box.c
 *
 *	Copyright (C) 1998,2001, 2006 Free Software Foundation, Inc.
 *
 * This program 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, or (at your option)
 * any later version.
 *
 * This program 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 this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 * Boston, MA 02110-1301 USA
 */

/* Include all needed declarations.  */
#include <libguile.h>

/* The type code for the newly created smob type will be stored into
   this variable.  It has the prefix `scm_tc16_' to make it usable
   with the SCM_VALIDATE_SMOB macro below.  */
static scm_t_bits scm_tc16_box;

/* This function is responsible for marking all SCM objects included
   in the smob.  */
static SCM
mark_box (SCM b)
{
  /* Since we have only one SCM object to protect, we simply return it
     and the caller will mark it.  */
  return SCM_CELL_OBJECT_1 (b);
}

/* Print a textual represenation of the smob to a given port.  */
static int
print_box (SCM b, SCM port, scm_print_state *pstate)
{
  SCM value = SCM_CELL_OBJECT_1 (b);

  scm_puts ("#<box ", port);
  scm_write (value, port);
  scm_puts (">", port);

  /* Non-zero means success.  */
  return 1;
}

/* This defines the primitve `make-box', which returns a new smob of
   type `box', initialized to `#f'.  */
static SCM
#define FUNC_NAME "make-box"
make_box (void)
{
  /* This macro creates the new objects, stores the value `#f' into it
     and returns it to the caller.  */
  SCM_RETURN_NEWSMOB (scm_tc16_box, SCM_BOOL_F);
}
#undef FUNC_NAME

/* This is the primitive `box-ref' which returns the object stored in
   the box.  */
static SCM
box_ref (SCM b)
#define FUNC_NAME "box-ref"
{
  /* First, we have to ensure that the user really gave us a box
     objects.  The macro SCM_VALIDATE_SMOB will do all what is needed.
     The parameters are interpreted as follows:

     1: The position of the checked variable in the parameter list.
     b: The passed parameter.
     box: Concatenated with the fixed prefix scm_tc16_, names the type
          code for the expected smob type.  */
  SCM_VALIDATE_SMOB (1, b, box);

  /* Fetch the object from the box and return it.  */
  return SCM_CELL_OBJECT_1 (b);
}
#undef FUNC_NAME

/* Primitive which stores an arbitrary value into a box.  */
static SCM
box_set_x (SCM b, SCM value)
#define FUNC_NAME "box-set!"
{
  SCM_VALIDATE_SMOB (1, b, box);

  /* Set the cell number 1 of the smob to the given value.  */
  SCM_SET_CELL_OBJECT_1 (b, value);

  /* When this constant is returned, the REPL will not print the
     returned value.  All procedures in Guile which are documented as
     returning `and unspecified value' actually return this value.  */
  return SCM_UNSPECIFIED;
}
#undef FUNC_NAME

/* Create and initialize the new smob type, and register the
   primitives withe the interpreter library.  */
static void
init_box_type (void)
{
  scm_tc16_box = scm_make_smob_type ("box", 0);
  scm_set_smob_mark (scm_tc16_box, mark_box);
  scm_set_smob_print (scm_tc16_box, print_box);

  scm_c_define_gsubr ("make-box", 0, 0, 0, make_box);
  scm_c_define_gsubr ("box-set!", 2, 0, 0, box_set_x);
  scm_c_define_gsubr ("box-ref", 1, 0, 0, box_ref);
}

/* This is the function which gets called by scm_boot_guile after the
   Guile library is completely initialized.  */
static void
inner_main (void *closure, int argc, char **argv)
{
  /* First, we create our data type... */
  init_box_type ();
  /* ... then we start a shell, in which the box data type can be
     used.  */
  scm_shell (argc, argv);
}

/* Main program.  */
int
main (int argc, char **argv)
{
  /* Initialize Guile, then call `inner_main' with the arguments 0,
     argc and argv.  */
  scm_boot_guile (argc, argv, inner_main, 0);
  return 0; /* Never reached.  */
}

/* End of file.  */


code:
#!/bin/sh

# must be run from this directory
guile=${GUILE-../libguile/guile}
if [ -x $guile ] ; then
    :
else
    echo could not find guile interpreter.
    echo '(are you running this script from' `dirname $0` '?)'
    echo GUILE env var: ${GUILE-not set}
    exit 1
fi

if test "X$srcdir" = X; then
    srcdir=.
fi

set -e

#
# simple-hello.scm
#
$guile -s $srcdir/scripts/simple-hello.scm > TMP
cat <<EOF | diff -u - TMP
Hello, World!
EOF
rm -f TMP

#
# hello
#
$guile -s $srcdir/scripts/hello > TMP
echo "Hello, World!" | diff -u - TMP
rm -f TMP

$guile -s $srcdir/scripts/hello --version > TMP
echo "hello 0.0.1" | diff -u - TMP
rm -f TMP

$guile -s $srcdir/scripts/hello --help > TMP
cat <<EOF | diff -u - TMP
Usage: hello [options...]
  --help, -h           Show this usage information
  --version, -v        Show version information
EOF
rm -f TMP

#
# fact
#
case `$guile -s $srcdir/scripts/fact 5` in 120) ;; *) echo $0: error: fact 5 ;; esac

#
# ./box/box test #1
#
./box/box -c '(let ((b (make-box))) (display b) (newline))' > TMP
cat <<EOF | diff -u - TMP
#<box #f>
EOF
rm -f TMP

#
# ./box/box test #2
#
./box/box -c '(let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline))' > TMP
cat <<EOF | diff -u - TMP
#<box #f>
#<box 1>
EOF
rm -f TMP

#
# ./box/box test #3
#
./box/box -c '(let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline) (display (box-ref b)) (newline))' > TMP
cat <<EOF | diff -u - TMP
#<box #f>
#<box 1>
1
EOF
rm -f TMP

#
# ./box-module/box test #1
#
./box-module/box -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline)))' > TMP
cat <<EOF | diff -u - TMP
#<box #f>
EOF
rm -f TMP

#
# ./box-module/box test #2
#
./box-module/box -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline)))' > TMP
cat <<EOF | diff -u - TMP
#<box #f>
#<box 1>
EOF
rm -f TMP

#
# ./box-module/box test #3
#
./box-module/box -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline) (display (box-ref b)) (newline)))' > TMP
cat <<EOF | diff -u - TMP
#<box #f>
#<box 1>
1
EOF
rm -f TMP

#
# ./box-dynamic/box test #1
#
$guile -c '(begin (load-extension "libbox" "scm_init_box") (let ((b (make-box))) (display b) (newline)))' > TMP
cat <<EOF | diff -u - TMP
#<box #f>
EOF
rm -f TMP

#
# ./box-dynamic/box test #2
#
$guile -c '(begin (load-extension "libbox" "scm_init_box") (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline)))' > TMP
cat <<EOF | diff -u - TMP
#<box #f>
#<box 1>
EOF
rm -f TMP

#
# ./box-dynamic/box test #3
#
$guile -c '(begin (load-extension "libbox" "scm_init_box") (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline) (display (box-ref b)) (newline)))' > TMP
cat <<EOF | diff -u - TMP
#<box #f>
#<box 1>
1
EOF
rm -f TMP

#
# ./box-dynamic-module/box test #1
#
$guile -L $srcdir/box-dynamic-module \
  -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline)))' > TMP
cat <<EOF | diff -u - TMP
#<box #f>
EOF
rm -f TMP

#
# ./box-dynamic-module/box test #2
#
$guile -L $srcdir/box-dynamic-module \
  -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline)))' > TMP
cat <<EOF | diff -u - TMP
#<box #f>
#<box 1>
EOF
rm -f TMP

#
# ./box-dynamic-module/box test #3
#
$guile -L $srcdir/box-dynamic-module \
  -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline) (display (box-ref b)) (newline)))' > TMP
cat <<EOF | diff -u - TMP
#<box #f>
#<box 1>
1
EOF
rm -f TMP

#
# ./box-dynamic-module/box test #4
#
$guile -L $srcdir/box-dynamic-module \
  -c '(begin (use-modules (box-mixed)) (let ((b (make-box-list 1 2 3))) (display b) (newline) (display (box-map 1+ b)) (newline)))' > TMP
cat <<EOF | diff -u - TMP
(#<box 1> #<box 2> #<box 3>)
(#<box 2> #<box 3> #<box 4>)
EOF
rm -f TMP

#
# ./main test
#
$guile -L $srcdir/modules -s $srcdir/modules/main > TMP
cat <<EOF | diff -u - TMP
module-0 foo
module-0 bar
module-1 foo
module-1 bar
module-2 braz
module-2 braz
module-2 foo
EOF
rm -f TMP

#
# ./safe untrusted.scm
#
$guile -s $srcdir/safe/safe $srcdir/safe/untrusted.scm > TMP
cat <<EOF | diff -u - TMP
1
1
2
6
24
120
720
5040
40320
362880
3628800
EOF
rm -f TMP

#
# ./safe evil.scm
#
$guile -s $srcdir/safe/safe $srcdir/safe/evil.scm > TMP
cat <<EOF | diff -u - TMP
** Exception: (unbound-variable #f "Unbound variable: ~S" (open-input-file) #f)
EOF
rm -f TMP

# check.test ends here


code:
AC_DEFUN([GUILE_COMPAT],
 [guile_compat_save_CFLAGS="$CFLAGS"
  guile_compat_save_LIBS="$LIBS"
  CFLAGS="$GUILE_CFLAGS"
  LIBS="$GUILE_LDFLAGS"
  AC_CHECK_FUNCS([scm_c_define_module scm_c_read_string scm_gc_protect_object scm_list_1 scm_c_register_extension scm_make_real scm_num2double scm_c_define_gsubr])
  AC_MSG_CHECKING(for scm_t_bits)
  AC_CACHE_VAL(ac_cv_have_scm_t_bits,
               [AC_TRY_COMPILE([#include <libguile.h>],
                               [scm_t_bits a;],
                               ac_cv_have_scm_t_bits=yes,
                               ac_cv_have_scm_t_bits=no)])
  AC_MSG_RESULT($ac_cv_have_scm_t_bits)
  if test $ac_cv_have_scm_t_bits = yes; then
    AC_DEFINE(HAVE_SCM_T_BITS)
  fi
  LIBS="$guile_compat_save_LIBS"
  CFLAGS="$guile_compat_save_CFLAGS"])


code:
/* classes: h_files */

#ifndef COMPATH
#define COMPATH
/*	Copyright (C) 2001, 2002, 2006, 2008 Free Software Foundation, Inc.
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2.1 of the License, or (at your option) any later version.
 *
 * This library 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
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 */

#ifndef SCM_GC8MARKP
#  define SCM_GC8MARKP(X) SCM_GC_MARK_P(X)
#  define SCM_SETGC8MARK(X) SCM_SET_GC_MARK(X)
#endif

#ifndef SCM_GC_MARK_P
#  define SCM_GC_MARK_P(X) SCM_GCMARKP(X)
#  define SCM_SET_GC_MARK(X) SCM_SETGCMARK(X)
#endif

#ifndef SCM_ARRAY_FLAG_CONTIGUOUS
#  define SCM_ARRAY_FLAG_CONTIGUOUS SCM_ARRAY_CONTIGUOUS
#endif

#ifndef HAVE_SCM_T_BITS
typedef scm_bits_t scm_t_bits;
typedef scm_array scm_t_array;
typedef scm_array_dim scm_t_array_dim;
typedef scm_mutex_t scm_t_mutex;
typedef scm_cond_t scm_t_cond;
typedef scm_key_t scm_t_key;
typedef scm_catch_body_t scm_t_catch_body;
typedef scm_catch_handler_t scm_t_catch_handler;
typedef scm_rstate scm_t_rstate;
typedef scm_port scm_t_port;
typedef scm_fport scm_t_fport;
#endif

#ifndef SCM_VALIDATE_DOUBLE_COPY
#define SCM_VALIDATE_DOUBLE_COPY SCM_VALIDATE_NUMBER_COPY
#endif

#ifndef HAVE_SCM_C_DEFINE_MODULE
#define scm_c_define_module(NAME,INIT,DATA) \
  scm_make_module (scm_read_0str ("(" NAME ")"))
#endif

#ifndef SCM_MAKE_CHAR
#define SCM_MAKE_CHAR SCM_MAKICHR
#define SCM_CHAR SCM_ICHR
#define SCM_CHARP SCM_ICHRP
#endif

#ifndef SCM_ROSTRINGP
#define SCM_ROSTRINGP(x) (SCM_STRINGP (x) || SCM_SYMBOLP (x))
#define SCM_RWSTRINGP(x) SCM_STRINGP (x)
#define SCM_ROCHARS(x) \
  (SCM_STRINGP (x) ? SCM_STRING_CHARS (x) : SCM_SYMBOL_CHARS (x))
#define SCM_ROLENGTH(x) \
  (SCM_STRINGP (x) ? SCM_STRING_LENGTH (x) : SCM_SYMBOL_LENGTH (x))
#endif

#ifndef SCM_STRING_COERCE_0TERMINATION_X
#ifdef SCM_COERCE_SUBSTR
#define SCM_STRING_COERCE_0TERMINATION_X SCM_COERCE_SUBSTR
#else
#define SCM_STRING_COERCE_0TERMINATION_X(x) (x)
#endif
#endif

#ifndef HAVE_SCM_C_READ_STRING
#define scm_c_read_string scm_read_0str
#define scm_c_eval_string scm_eval_0str
#define scm_str2symbol(X) SCM_CAR (scm_intern0 (X))
#define scm_mem2string(X, Y) scm_makfromstr ((X), (Y), 0)
#endif

#ifndef HAVE_SCM_MAKE_REAL
#define scm_make_real(X) scm_makdbl ((X), 0.0)
#endif

#ifdef HAVE_SCM_NUM2DOUBLE
#define scm_real2double scm_num2double
#define SCM_REAL2DOUBLE SCM_NUM2DOUBLE
#else
#define scm_real2double(X, POS, WHERE) scm_num2dbl ((X), (WHERE))
#define SCM_REAL2DOUBLE(X, POS) scm_num2dbl ((X), FUNC_NAME)
#endif

#ifndef SCM_VALIDATE_DOUBLE_DEF_COPY
#define SCM_VALIDATE_DOUBLE_DEF_COPY SCM_VALIDATE_NUMBER_DEF_COPY
#endif

#ifndef HAVE_SCM_GC_PROTECT_OBJECT
#define scm_gc_protect_object scm_protect_object
#endif

#ifndef HAVE_SCM_C_DEFINE_GSUBR
#define scm_c_define_gsubr scm_make_gsubr
#endif

#ifndef SCM_STRING_CHARS
#define SCM_STRING_CHARS SCM_CHARS
#define SCM_STRING_UCHARS SCM_UCHARS
#define SCM_STRING_LENGTH SCM_LENGTH
#endif

#ifndef SCM_SUBSTRP
#define SCM_SUBSTRP(X) 0
#endif

#ifndef SCM_VECTOR_LENGTH
#define SCM_VECTOR_LENGTH SCM_LENGTH
#define SCM_UVECTOR_LENGTH SCM_LENGTH
#endif

#ifndef SCM_SET_VECTOR_LENGTH
#define SCM_SET_VECTOR_LENGTH SCM_SETLENGTH
#define SCM_SET_UVECTOR_LENGTH SCM_SETLENGTH
#endif

#ifndef SCM_VECTOR_BASE
#define SCM_VECTOR_BASE SCM_CHARS
#define SCM_UVECTOR_BASE SCM_CHARS
#endif

#ifndef SCM_SET_VECTOR_BASE
#define SCM_SET_VECTOR_BASE SCM_SETCHARS
#define SCM_SET_UVECTOR_BASE SCM_SETCHARS
#endif

#ifndef SCM_UVECTOR_MAX_LENGTH
#define SCM_UVECTOR_MAX_LENGTH SCM_LENGTH_MAX
#endif

#ifndef HAVE_SCM_LIST_1
#define scm_list_1 SCM_LIST1
#define scm_list_2 SCM_LIST2
#define scm_list_3 SCM_LIST3
#define scm_list_4 SCM_LIST4
#define scm_list_5 SCM_LIST5
#define scm_list_n scm_listify
#endif

#ifndef SCM_SYMBOL_CHARS
#define SCM_SYMBOL_CHARS SCM_CHARS
#endif

#endif /* COMPATH */


code:
### BEGIN compatibility checks ###

AC_CHECK_FUNCS(scm_c_define_module scm_c_read_string scm_gc_protect_object scm_list_1)

AC_MSG_CHECKING(for scm_t_bits)
AC_CACHE_VAL(ac_cv_have_scm_t_bits,
[AC_TRY_COMPILE([#include <libguile.h>],
[scm_t_bits a;],
ac_cv_have_scm_t_bits=yes, ac_cv_have_scm_t_bits=no)])
AC_MSG_RESULT($ac_cv_have_scm_t_bits)
if test $ac_cv_have_scm_t_bits = yes; then
  AC_DEFINE(HAVE_SCM_T_BITS)
fi

### END compatibility checks ###


code:
							       -*- outline -*-

* Overview

This directory includes examples which show how to write and use Guile
modules in Scheme programs.

The descriptions below assume that you have a working copy of Guile
installed and available with the standard installation prefix
`/usr/local'.

* Included Examples

** main

  The main program, which uses the modules described below to perform
  some actions.  Module usage and selective importing as well as
  renaming is demonstrated here.n

  $ ./main

  or

  guile -s main

** module-0.scm, module-1.scm, module-2.scm

  Two modules which export several procedure, some of which have the
  same names (so that renaming/selection is required for proper
  importing).

path: examples/modules/README


code:
#! /usr/local/bin/guile -s
!#
;;; examples/modules/main -- Module system demo.

;;; Commentary:

;;; The main demo program for the modules subdirectory.
;;;
;;; This program shows how all the new fancy module import features
;;; are to be used.

;;; Author: Martin Grabmueller
;;; Date: 2001-05-29

;;; Code:

(define-module (main)
  ;; The module 0 is imported completely.
  ;;
  :use-module (module-0)

  ;; Module 1 is imported completely, too, but the procedure names are
  ;; prefixed with the module name.
  ;;
  :use-module ((module-1) :renamer (symbol-prefix-proc 'module-1:))

  ;; From module 2, only the procedure `braz' is imported, so that the
  ;; procedures `foo' and `bar' also exported by that module don't
  ;; clash with the definitions of module 0.
  ;;
  :use-module ((module-2) :select (braz))

  ;; Import the bindings from module 2 again, now renaming them by
  ;; explicitly mentioning the original and new names.
  ;;
  :use-module ((module-2) :select ((braz . m-2:braz) (foo . m-2:foo))))

;;
;; Now call the various imported procedures.
;;

(foo)
(bar)
(module-1:foo)
(module-1:bar)
(braz)
(m-2:braz)
(m-2:foo)

;; Local variables:
;; mode: scheme
;; End:

path: examples/modules/main


code:
;;; examples/modules/module-0.scm -- Module system demo.

;;; Commentary:

;;; Module 0 of the module demo program.

;;; Author: Martin Grabmueller
;;; Date: 2001-05-29

;;; Code:

(define-module (module-0))

(export foo bar)

(define (foo)
  (display "module-0 foo")
  (newline))

(define (bar)
  (display "module-0 bar")
  (newline))

;;; End of file.


code:
;;; examples/modules/module-1.scm -- Module system demo.

;;; Commentary:

;;; Module 1 of the module demo program.

;;; Author: Martin Grabmueller
;;; Date: 2001-05-29

;;; Code:

(define-module (module-1))

(export foo bar)

(define (foo)
  (display "module-1 foo")
  (newline))

(define (bar)
  (display "module-1 bar")
  (newline))

;;; End of file.


code:
;;; examples/modules/module-2.scm -- Module system demo.

;;; Commentary:

;;; Module 2 of the module demo program.

;;; Author: Martin Grabmueller
;;; Date: 2001-05-29

;;; Code:

(define-module (module-2))

(export foo bar braz)

(define (foo)
  (display "module-2 foo")
  (newline))

(define (bar)
  (display "module-2 bar")
  (newline))

(define (braz)
  (display "module-2 braz")
  (newline))

;;; End of file.


code:
							       -*- outline -*-

* Overview

This directory includes examples which show how to create and use safe
environments for safe (sand-boxed) execution of Scheme programs.

*Note* that the files in this directory are only suitable for
 demonstration purposes, if you have to implement safe evaluation
 mechanisms in important environments, you will have to do more than
 shown here -- for example disabling input/output operations.

The descriptions below assume that you have a working copy of Guile
installed and available with the standard installation prefix
`/usr/local'.

* Included Examples

** safe

  The main program, which executes the Scheme code in a file given on
  the command line in a safe environment.  The following command will
  do that with the file `untrusted.scm' (see below.)

  $ ./safe untrusted.scm

  or

  guile -s safe untrusted.scm

** untrusted.scm

  This file contains some Scheme code, which will be executed in a
  safe environment by the `safe' script.

** evil.scm

  This file also contains Scheme code, but it tries to do evil things.
  Evaluating this with the `safe' script will abort on those evil
  actions.

path: examples/safe/README


code:
;;; examples/safe/evil.scm -- Evil Scheme file to be run in a safe
;;; environment.

;;; Commentary:

;;; This is an example file to be evaluated by the `safe' program in
;;; this directory.  This program, unlike the `untrusted.scm' (which
;;; is untrusted, but a really nice fellow though), tries to do evil
;;; things and will thus break in a safe environment.
;;;
;;; *Note* that the files in this directory are only suitable for
;;; demonstration purposes, if you have to implement safe evaluation
;;; mechanisms in important environments, you will have to do more
;;; than shown here -- for example disabling input/output operations.

;;; Author: Martin Grabmueller
;;; Date: 2001-05-30

;;; Code:

(define passwd (open-input-file "/etc/passwd"))

(let lp ((ch (read-char passwd)))
  (if (not (eof-object? ch))
    (lp (read-char passwd))))

;;; End of file.


code:
#! /usr/local/bin/guile -s
!#
;;; examples/safe/safe -- Example for safe (sand-boxed) evaluation.

;;; Commentary:

;;; This is a demo program for evaluating arbitrary (untrusted) Scheme
;;; code in a controlled, safe environment.  Evaluation in safe
;;; environments restricts the evaluated code's access to some given
;;; primitives, which are considered `safe', that means which cannot
;;; do any harm to the world outside of Guile (creating/deleting files
;;; etc.)
;;;
;;; *Note* that the files in this directory are only suitable for
;;; demonstration purposes, if you have to implement safe evaluation
;;; mechanisms in important environments, you will have to do more
;;; than shown here -- for example disabling input/output operations.

;;; Author: Martin Grabmueller
;;; Date: 2001-05-30

;;; Code:

;; Safe module creation is implemented in this module:
;;
(use-modules (ice-9 safe))

;; This is the main program.  It expects one parameter in the format
;; returned by (command-line) and expects that exactly one file name
;; is passed in this list (after the script name, which is passed as
;; the 0th parameter.)
;;
;; The given file is opened for reading, one expression after the
;; other is read and evaluated in a safe environment.  All exceptions
;; caused by this evaluation are caught and printed out.
;;
(define (main cmd-line)

  ;; Internal definition of the procedure which prints usage
  ;; information.
  ;;
  (define (display-help)
    (display "Usage: safe FILENAME")
    (newline)
    (quit 1))

  ;; Check that we received exactly one command line argument after
  ;; the script name
  ;;
  (if (not (= (length cmd-line) 2))
    (display-help)
    (let ((port (open-input-file (cadr cmd-line)))

	  ;; Create the safe module.
	  (safe-module (make-safe-module)))

      ;; Read one expression a time.
      (let lp ((expr (read port)))
	;; End of file? -> Return.
	(if (eof-object? expr)
	  #t
	  (catch #t
	    (lambda ()
	      ;; Evaluate the expression in the safe environment.
	      (eval expr safe-module)
	      ;; ... and read the next expression if no error occured.
	      (lp (read port)))

	    ;; Handle exceptions.  This procedure will be called when an
	    ;; error occurs while evaluating the expression.  It just
	    ;; prints out a message telling so and returns from the
	    ;; evaluation loop, thus terminating the program.
	    ;;
	    (lambda args
	      (display "** Exception: ")
	      (write args)
	      (newline))))))))

;; Start the main program.
;;
(main (command-line))

;; Local variables:
;; mode: scheme
;; End:

path: examples/safe/safe


code:
;;; examples/safe/untrusted.scm -- Scheme file to be run in a safe
;;; environment.

;;; Commentary:

;;; This is an example file to be evaluated by the `safe' program in
;;; this directory.
;;;
;;; *Note* that the files in this directory are only suitable for
;;; demonstration purposes, if you have to implement safe evaluation
;;; mechanisms in important environments, you will have to do more
;;; than shown here -- for example disabling input/output operations.

;;; Author: Martin Grabmueller
;;; Date: 2001-05-30

;;; Code:

;; fact -- the everlasting factorial function...
;;
(define (fact n)
  (if (< n 2)
    1
    (* n (fact (- n 1)))))

;; Display the factorial of 0..9 to the terminal.
;;
(do ((x 0 (+ x 1)))
    ((= x 11))
  (display (fact x))
  (newline))

;;; End of file.


code:
							       -*- outline -*-

* Overview

This directory includes examples which show how to write scripts using
Guile.

The descriptions below assume that you have a working copy of Guile
installed and available with the standard installation prefix
`/usr/local'.

* Included Examples

** simple-hello.scm

  The simplest "Hello World!" program for Guile. Run it like this:

  $ guile -s simple-hello.scm

** hello

  An advanced version of the script above, with command line handling
  for the important options --help and --version.  Run it like this:

  ./hello

  or

  guile -s hello

** fact

  Command-line factorial calculator.  Run it like this:

  ./fact 5

  to calculate the factorial of 5.

path: examples/scripts/README


code:
#! /usr/local/bin/guile -s
!#
;;; Commentary:

;;; This is a command-line factorial calculator.  Run like this:
;;;
;;; ./fact 5
;;;
;;; to calculate the factorial of 5

;;; Author: Martin Grabmueller
;;; Date: 2001-05-29

;;; Code:

(use-modules (ice-9 getopt-long))

;; This is the grammar for the command line synopsis we expect.
;;
(define command-synopsis
  '((version (single-char #\v) (value #f))
    (help    (single-char #\h) (value #f))))

;; Display version information and exit.
;;
(define (display-version)
  (display "fact 0.0.1\n"))

;; Display the usage help message and exit.
;;
(define (display-help)
  (display "Usage: fact [options...] number\n")
  (display "  --help, -h           Show this usage information\n")
  (display "  --version, -v        Show version information\n"))

;; Interpret options, if --help or --version was given, print out the
;; requested information and exit.  Otherwise, calculate the factorial
;; of the argument.
;;
(define (main options)
  (let ((help-wanted (option-ref options 'help #f))
	(version-wanted (option-ref options 'version #f))
	(args (option-ref options '() '())))
    (cond
      ((or version-wanted help-wanted)
       (if version-wanted
	 (display-version))
       (if help-wanted
	 (display-help)))
      ((not (= (length args) 1))
       (display-help))
      (else
       (display (fact (string->number (car args))))
       (newline)))))

;; Calculate the factorial of n.
;;
(define (fact n)
  (if (< n 2)
    1
    (* n (fact (- n 1)))))

;; Call the main program with parsed command line options.
;;
(main (getopt-long (command-line) command-synopsis))

;; Local variables:
;; mode: scheme
;; End:

path: examples/scripts/fact


code:
#! /usr/local/bin/guile -s
!#
;;; Commentary:

;;; This is the famous Hello-World-program, written for Guile.  It is a
;;; little bit enhanced in that it understands the command line options
;;; `--help' (-h) and `--version' (-v), which print a short usage
;;; decription or version information, respectively.

;;; Author: Martin Grabmueller
;;; Date: 2001-05-29

;;; Code:

(use-modules (ice-9 getopt-long))

;; This is the grammar for the command line synopsis we expect.
;;
(define command-synopsis
  '((version (single-char #\v) (value #f))
    (help    (single-char #\h) (value #f))))

;; Display version information.
;;
(define (display-version)
  (display "hello 0.0.1\n"))

;; Display the usage help message.
;;
(define (display-help)
  (display "Usage: hello [options...]\n")
  (display "  --help, -h           Show this usage information\n")
  (display "  --version, -v        Show version information\n"))

;; Interpret options, if --help or --version was given, print out the
;; requested information and exit.  Otherwise, print the famous
;; message.
;;
(define (main options)
  (let ((help-wanted (option-ref options 'help #f))
	(version-wanted (option-ref options 'version #f)))
    (if (or version-wanted help-wanted)
	(begin
	  (if version-wanted
	      (display-version))
	  (if help-wanted
	      (display-help)))
	(begin
	  (display "Hello, World!") (newline)))))

;; Call the main program with parsed command line options.
;;
(main (getopt-long (command-line) command-synopsis))

;; Local variables:
;; mode: scheme
;; End:

path: examples/scripts/hello


code:
;;; Commentary:

;;; This is the famous Hello-World-program, written for Guile.
;;;
;;; For an advanced version, see the script `hello' in the same
;;; directory.

;;; Author: Martin Grabmueller
;;; Date: 2001-05-29

;;; Code:

(display "Hello, World!")
(newline)

;;; End of file.


code:
prefix=@prefix@
exec_prefix=@exec_prefix@
libdir=@libdir@
includedir=@includedir@
datarootdir=@datarootdir@
datadir=@datadir@

sitedir=@sitedir@
libguileinterface=@LIBGUILE_INTERFACE@

Name: GNU Guile
Description: GNU's Ubiquitous Intelligent Language for Extension
Version: @GUILE_VERSION@
Libs: -L${libdir} -lguile @GUILE_LIBS@
Cflags: -I${includedir} @GUILE_CFLAGS@


code:
2008-06-02  Ludovic Courtès  <ludo@gnu.org>

	* guile-config.in (build-link): Show `-L' before `-lguile'.
	Reported by Peter O'Gorman <pogma@thewrittenword.com>.

2008-01-22  Neil Jerram  <neil@ossau.uklinux.net>

	* COPYING: Removed.

2007-01-04  Kevin Ryde  <user42@zip.com.au>

	* Makefile.am (guile-config): Use "|" as the sed delimiter, for the
	benefit of DOS systems where $(bindir) might include a drive letter
	like "c:".  Reported by Cesar Strauss.

2006-09-19  Rob Browning  <rlb@defaultvalue.org>

	* guile-config.in (build-link): Restore the removal of "/usr/lib"
	(in addition to "/usr/lib/" from any -L arguments).

2005-02-10  Mikael Djurfeldt  <djurfeldt@nada.kth.se>

	* guile-config.in (build-link): Replaced -lguile-ltdl with -lltdl.

2004-10-08  Han-Wen Nienhuys  <hanwen@xs4all.nl>

	* guile-config.in: remove display-separated.
	(build-link): cleanup.
	(build-compile): remove space between -I and path.

2004-09-24  Marius Vollmer  <mvo@zagadka.de>

	* guile-config.in (build-link, build-compile): Include CFLAGS in
	output.  This is needed to get "-pthread" into the builds, for
	example.

	* Makefile.am (EXTRA_DIST): Removed qthreads.m4.

2003-04-05  Marius Vollmer  <mvo@zagadka.de>

	* Changed license terms to the plain LGPL thru-out.

2002-10-14  Marius Vollmer  <marius.vollmer@uni-dortmund.de>

	* guile-config.in (build-link): Include "-lguile-ltdl" in link
	flags.

2002-07-17  Marius Vollmer  <mvo@zagadka.ping.de>

	* qthreads.m4: Added configuration for ARM.

2002-04-26  Marius Vollmer  <mvo@zagadka.ping.de>

	* Makefile.am (EXTRA_DIST): Added qthreads.m4.
	* qthreads.m4: Moved here from top directory.

2002-03-12  Rob Browning  <rlb@defaultvalue.org>

	* guile-config.in (build-link): don't output -L/usr/lib.
	(build-compile): don't output -I/usr/include.

2002-03-03  Neil Jerram  <neil@ossau.uklinux.net>

	* guile.m4 (GUILE_PROGS): In docstring, change `are' to `is'.

2002-01-02  Thien-Thi Nguyen  <ttn@glug.org>

	* guile.m4: Rewrite comments in texi.

	(GUILE_FLAGS): Rewrite.
	Thanks to Alexandre Duret-Lutz.

2001-12-28  Thien-Thi Nguyen  <ttn@glug.org>

	* guile.m4 (GUILE_PROGS, GUILE_SITE_DIR, GUILE_CHECK,
	GUILE_MODULE_EXPORTS, GUILE_MODULE_REQUIRED_EXPORTS): New macros.

	(GUILE_MODULE_CHECK): Renamed from AC_GUILE_MODULE_CHECK.
	Rewritten to expect `description' as a present-tense verb phrase.

	(GUILE_MODULE_AVAILABLE, GUILE_MODULE_REQUIRED): Renamed likewise.

2001-12-28  Thien-Thi Nguyen  <ttn@glug.org>

	* guile.m4: Update copyright.
	Add index in header comments.

	(AC_GUILE_MODULE_CHECK, AC_GUILE_MODULE_AVAILABLE,
	AC_GUILE_MODULE_REQUIRED): New macros.

2001-07-18  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>

	* guile-config.in, Makefile.am: Updated copyright notice.

2001-05-28  Gary Houston  <ghouston@arglist.com>

	* Makefile.am: let guile-config depend on libguile/libpath.h,
	so that it will be rebuilt if configure --prefix changes.

2001-03-07  Mikael Djurfeldt  <mdj@linnaeus.mit.edu>

	* guile-config.in (build-link): Really reverted the change of
	2001-03-05.

2001-03-06  Dirk Herrmann  <D.Herrmann@tu-bs.de>

	* guile-config.in (build-link): Reverted the previous patch.

2001-03-05  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>

	* guile-config.in (build-link): Fixed duplicate binding bug
	reported by Ralf Mattes.

2000-11-28  Dirk Herrmann  <D.Herrmann@tu-bs.de>

	* guile-config.in (build-link):  Use substring instead of
	make-shared-substring.

2000-11-01  Dirk Herrmann  <D.Herrmann@tu-bs.de>

	* guile-config.in (display-line-port):  Make sure all output is
	sent to the given port.  Thanks to I. N. Golubev for the patch.

2000-01-12  Marius Vollmer  <mvo@zagadka.ping.de>

	* Makefile.am (EXTRA_DIST): Added "guile.m4".

1999-10-05  Jim Blandy  <jimb@savonarola.red-bean.com>

	* guile.m4: Moved here from top-level directory; see the ChangeLog
	entry there.
	* Makefile.am (aclocaldir, aclocal_DATA): New variables, ensuring
	that guile.m4 gets installed.

	* Makefile.in: Deleted from CVS repository.  Run the autogen.sh
	script to create generated files like this one.

1999-09-11  Jim Blandy  <jimb@savonarola.red-bean.com>

	* Makefile.in: Regenerated.

1998-07-29  Marius Vollmer  <mvo@zagadka.ping.de>

	* guile-config.in (build-link): Correct non-RnRS usage of internal
	defines.

1999-04-17  Jim Blandy  <jimb@savonarola.red-bean.com>

	* Makefile.in: Regenerated.

1998-10-19  Jim Blandy  <jimb@zwingli.cygnus.com>

	* COPYING: New file.
	* Makefile.in: Regenerated.

1998-10-09  Jim Blandy  <jimb@zwingli.cygnus.com>

	* guile-config.in: Add copyright notice.

1998-10-07  Jim Blandy  <jimb@zwingli.cygnus.com>

	* guile-config.in (build-link): It isn't.  Revert the change.

	* guile-config.in (build-link): Include a -R flag in the output
	from link.  Not sure if this is the right thing to do.

1998-10-05  Jim Blandy  <jimb@zwingli.cygnus.com>

	* guile-config.in (build-compile, help-compile, usage-compile):
	New functions to implement new subcommand.

	* guile-config.in: Redo the help system, so that each subcommand
	defines its own usage text, as well as its help text.

	* guile-config.in (build-link): Include a -L option in the output
	from `guile-config link', indicating where libguile was installed.
	(Thanks to Greg Troxel.)

1998-10-03  Jim Blandy  <jimb@zwingli.cygnus.com>

	* guile-config.in: Don't import ice-9 regex; that's not available
	on all systems.  Maybe someday we'll have our own...
	(set-program-name!): Use basename.
	(build-link): Use basename and stock string functions, instead of
	string-match.
	(Bug report from Greg Troxel --- thanks!)

	* Directory renamed to guile-config from build.
	* guile-config.in: Renamed from build-guile.in, for consistency
 	with the analogous script for GTK, called gtk-config.
	* Makefile.am, .cvsignore: References to `build-guile' replaced
	with `guile-config'.

1998-07-29  Jim Blandy  <jimb@zwingli.cygnus.com>

	* Makefile.in: Regenerated using the last public version of
	automake, not the hacked Cygnus version.

1998-07-28  Jim Blandy  <jimb@zwingli.cygnus.com>

	* Makefile.in: Regenerated, after removing Totoro kludge.

1998-07-26  Jim Blandy  <jimb@zwingli.cygnus.com>

	* Makefile.in: Rebuilt, for config changes in parent dir.

1998-01-05  Tim Pierce  <twp@skepsis.com>

	* .cvsignore: New file.

Mon Oct  6 11:45:59 1997  Jim Blandy  <jimb@totoro.red-bean.com>

	* build-guile.in: Try to return an appropriate exit status.

	* build-guile.in: Rearranged to use a table of subcommands, and
 	include per-subcommand help.

	* build-guile.in: New "info" subcommand, for easy access to Guile
 	build variables.

Mon Sep 29 23:53:14 1997  Jim Blandy  <jimb@totoro.red-bean.com>

	* Makefile.in: Regenerated with automake 1.2c.

Sat Sep 27 23:15:26 1997  Jim Blandy  <jimb@totoro.red-bean.com>

	* New directory --- the build-guile command, intended to help
	people build Guile-based applications.
	* Makefile.am, Makefile.in, build-guile.in: New files.


code:
## Process this file with Automake to create Makefile.in
## Jim Blandy <jimb@red-bean.com> --- September 1997
##
##  	Copyright (C) 1998, 1999, 2001, 2006, 2007, 2008 Free Software Foundation, Inc.
##
##   This file is part of GUILE.
##
##   GUILE 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, or
##   (at your option) any later version.
##
##   GUILE 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 GUILE; see the file COPYING.  If not, write
##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
##   Floor, Boston, MA 02110-1301 USA

bin_SCRIPTS=guile-config
CLEANFILES=guile-config
EXTRA_DIST=guile-config.in guile.m4 ChangeLog-2008

## FIXME: in the future there will be direct automake support for
## doing this.  When that happens, switch over.
aclocaldir = $(datadir)/aclocal
aclocal_DATA = guile.m4

## We use @-...-@ as the substitution brackets here, instead of the
## usual @...@, so autoconf doesn't go and substitute the values
## directly into the left-hand sides of the sed substitutions.  *sigh*
guile-config: guile-config.in ${top_builddir}/libguile/libpath.h
	rm -f guile-config.tmp
	sed < ${srcdir}/guile-config.in > guile-config.tmp \
	    -e 's|@-bindir-@|${bindir}|' \
	    -e s:@-GUILE_VERSION-@:${GUILE_VERSION}:
	chmod +x guile-config.tmp
	mv guile-config.tmp guile-config

## Get rid of any copies of the configuration script under the old
## name, so people don't end up running ancient copies of it.
install-exec-local:
	rm -f ${bindir}/build-guile


code:
#!@-bindir-@/guile \
-e main -s
!#
;;;; guile-config --- utility for linking programs with Guile
;;;; Jim Blandy <jim@red-bean.com> --- September 1997
;;;;
;;;; 	Copyright (C) 1998, 2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 2.1 of the License, or (at your option) any later version.
;;;;
;;;; This library 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
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

;;; TODO:
;;; * Add some plausible structure for returning the right exit status,
;;;   just something that encourages people to do the correct thing.
;;; * Implement the static library support.  This requires that
;;;   some portion of the module system be done.

(use-modules (ice-9 string-fun))

;;;; main function, command-line processing

;;; The script's entry point.
(define (main args)
  (set-program-name! (car args))
  (let ((args (cdr args)))
    (cond
     ((null? args) (show-help '())
		   (quit 1))
     ((assoc (car args) command-table)
      => (lambda (row)
	   (set! subcommand-name (car args))
	   ((cadr row) (cdr args))))
     (else (show-help '())
	   (quit 1)))))

(define program-name #f)
(define subcommand-name #f)
(define program-version "@-GUILE_VERSION-@")

;;; Given an executable path PATH, set program-name to something
;;; appropriate f or use in error messages (i.e., with leading
;;; directory names stripped).
(define (set-program-name! path)
  (set! program-name (basename path)))

(define (show-help args)
  (cond
   ((null? args) (show-help-overview))
   ((assoc (car args) command-table)
    => (lambda (row) ((caddr row))))
   (else
    (show-help-overview))))

(define (show-help-overview)
  (display-line-error "Usage: ")
  (for-each (lambda (row) ((cadddr row)))
	    command-table))

(define (usage-help)
  (let ((dle display-line-error)
	(p program-name))
    (dle "  " p " --help      - show usage info (this message)")
    (dle "  " p " --help SUBCOMMAND - show help for SUBCOMMAND")))

(define (show-version args)
  (display-line-error program-name " - Guile version " program-version))

(define (help-version)
  (let ((dle display-line-error))
    (dle "Usage: " program-name " --version")
    (dle "Show the version of this script.  This is also the version of")
    (dle "Guile this script was installed with.")))

(define (usage-version)
  (display-line-error
   "  " program-name " --version   - show installed script and Guile version"))

;;;; the "link" subcommand

;;; Write a set of linker flags to standard output to include the
;;; libraries that libguile needs to link against.
;;;
;;; In the long run, we want to derive these flags from Guile module
;;; declarations files that are installed along the load path.  For
;;; now, we're just going to reach into Guile's configuration info and
;;; hack it out.
(define (build-link args)

  ;; If PATH has the form FOO/libBAR.a, return the substring
  ;; BAR, otherwise return #f.
  (define (match-lib path)
    (let* ((base (basename path))
	   (len (string-length base)))
      (if (and (> len 5)
	       (string=? (substring base 0 3) "lib")
	       (string=? (substring base (- len 2)) ".a"))
	  (substring base 3 (- len 2))
	  #f)))

  (if (> (length args) 0)
      (error
       (string-append program-name
		      " link: arguments to subcommand not yet implemented")))

  (let ((libdir (get-build-info 'libdir))
        (other-flags
         (let loop ((libs
                     ;; Get the string of linker flags we used to build
                     ;; Guile, and break it up into a list.
                     (separate-fields-discarding-char #\space
                                                      (get-build-info 'LIBS)
                                                      list)))

           (cond
            ((null? libs) '())

            ;; Turn any "FOO/libBAR.a" elements into "-lBAR".
            ((match-lib (car libs))
             => (lambda (bar)
                  (cons (string-append "-l" bar)
                        (loop (cdr libs)))))

            ;; Remove any empty strings that may have seeped in there.
            ((string=? (car libs) "") (loop (cdr libs)))

            (else (cons (car libs) (loop (cdr libs))))))))

    ;; Include libguile itself in the list, along with the directory
    ;; it was installed in, but do *not* add /usr/lib since that may
    ;; prevent other programs from specifying non-/usr/lib versions
    ;; via their foo-config scripts.  If *any* app puts -L/usr/lib in
    ;; the output of its foo-config script then it may prevent the use
    ;; a non-/usr/lib install of anything that also has a /usr/lib
    ;; install. For now we hard-code /usr/lib, but later maybe we can
    ;; do something more dynamic (i.e. what do we need.

    ;; Display the flags, separated by spaces.
    (display (string-join
	      (list
	       (get-build-info 'CFLAGS)
               (if (or (string=? libdir "/usr/lib")
                       (string=? libdir "/usr/lib/"))
		   ""
		   (string-append "-L" (get-build-info 'libdir)))
               "-lguile -lltdl"
	       (string-join other-flags)

	       )))
    (newline)))

(define (help-link)
  (let ((dle display-line-error))
    (dle "Usage: " program-name " link")
    (dle "Print linker flags for building the `guile' executable.")
    (dle "Print the linker command-line flags necessary to link against")
    (dle "the Guile library, and any other libraries it requires.")))

(define (usage-link)
  (display-line-error
   "  " program-name " link        - print libraries to link with"))

;;;; The "compile" subcommand

(define (build-compile args)
  (if (> (length args) 0)
      (error
       (string-append program-name
		      " compile: no arguments expected")))

  ;; See gcc manual wrt fixincludes.  Search for "Use of
  ;; `-I/usr/include' may cause trouble."  For now we hard-code this.
  ;; Later maybe we can do something more dynamic.
  (display
   (string-append
    (if (not (string=? (get-build-info 'includedir) "/usr/include"))
	 (string-append "-I" (get-build-info 'includedir) " ")
	 " ")

    (get-build-info 'CFLAGS)
    "\n"
    )))

(define (help-compile)
  (let ((dle display-line-error))
    (dle "Usage: " program-name " compile")
    (dle "Print C compiler flags for compiling code that uses Guile.")
    (dle "This includes any `-I' flags needed to find Guile's header files.")))

(define (usage-compile)
  (display-line-error
   "  " program-name " compile     - print C compiler flags to compile with"))

;;;; The "info" subcommand

(define (build-info args)
  (cond
   ((null? args) (show-all-vars))
   ((null? (cdr args)) (show-var (car args)))
   (else (display-line-error "Usage: " program-name " info [VAR]")
	 (quit 2))))

(define (show-all-vars)
  (for-each (lambda (binding)
	      (display-line (car binding) " = " (cdr binding)))
	    %guile-build-info))

(define (show-var var)
  (display (get-build-info (string->symbol var)))
  (newline))

(define (help-info)
  (let ((d display-line-error))
    (d "Usage: " program-name " info [VAR]")
    (d "Display the value of the Makefile variable VAR used when Guile")
    (d "was built.  If VAR is omitted, display all Makefile variables.")
    (d "Use this command to find out where Guile was installed,")
    (d "where it will look for Scheme code at run-time, and so on.")))

(define (usage-info)
  (display-line-error
   "  " program-name " info [VAR]  - print Guile build directories"))

;;;; trivial utilities

(define (get-build-info name)
  (let ((val (assq name %guile-build-info)))
    (if (not (pair? val))
	(begin
	  (display-line-error
	   program-name " " subcommand-name ": no such build-info: " name)
	  (quit 2)))
    (cdr val)))

(define (display-line . args)
  (apply display-line-port (current-output-port) args))

(define (display-line-error . args)
  (apply display-line-port (current-error-port) args))

(define (display-line-port port . args)
  (for-each (lambda (arg) (display arg port))
	    args)
  (newline port))

;;;; the command table

;;; We define this down here, so Guile builds the list after all the
;;; functions have been defined.
(define command-table
  (list
   (list "--version" show-version help-version usage-version)
   (list "--help" show-help show-help-overview usage-help)
   (list "link" build-link help-link usage-link)
   (list "compile" build-compile help-compile usage-compile)
   (list "info" build-info help-info usage-info)))

;;; Local Variables:
;;; mode: scheme
;;; End:


code:
## Autoconf macros for working with Guile.
##
##   Copyright (C) 1998,2001, 2006 Free Software Foundation, Inc.
##
## This library is free software; you can redistribute it and/or
## modify it under the terms of the GNU Lesser General Public
## License as published by the Free Software Foundation; either
## version 2.1 of the License, or (at your option) any later version.
##
## This library 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
## Lesser General Public License for more details.
##
## You should have received a copy of the GNU Lesser General Public
## License along with this library; if not, write to the Free Software
## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

## Index
## -----
##
## GUILE_PROGS -- set paths to Guile interpreter, config and tool programs
## GUILE_FLAGS -- set flags for compiling and linking with Guile
## GUILE_SITE_DIR -- find path to Guile "site" directory
## GUILE_CHECK -- evaluate Guile Scheme code and capture the return value
## GUILE_MODULE_CHECK -- check feature of a Guile Scheme module
## GUILE_MODULE_AVAILABLE -- check availability of a Guile Scheme module
## GUILE_MODULE_REQUIRED -- fail if a Guile Scheme module is unavailable
## GUILE_MODULE_EXPORTS -- check if a module exports a variable
## GUILE_MODULE_REQUIRED_EXPORT -- fail if a module doesn't export a variable

## Code
## ----

## NOTE: Comments preceding an AC_DEFUN (starting from "Usage:") are massaged
## into doc/ref/autoconf-macros.texi (see Makefile.am in that directory).

# GUILE_PROGS -- set paths to Guile interpreter, config and tool programs
#
# Usage: GUILE_PROGS
#
# This macro looks for programs @code{guile}, @code{guile-config} and
# @code{guile-tools}, and sets variables @var{GUILE}, @var{GUILE_CONFIG} and
# @var{GUILE_TOOLS}, to their paths, respectively.  If either of the first two
# is not found, signal error.
#
# The variables are marked for substitution, as by @code{AC_SUBST}.
#
AC_DEFUN([GUILE_PROGS],
 [AC_PATH_PROG(GUILE,guile)
  if test "$GUILE" = "" ; then
      AC_MSG_ERROR([guile required but not found])
  fi
  AC_SUBST(GUILE)
  AC_PATH_PROG(GUILE_CONFIG,guile-config)
  if test "$GUILE_CONFIG" = "" ; then
      AC_MSG_ERROR([guile-config required but not found])
  fi
  AC_SUBST(GUILE_CONFIG)
  AC_PATH_PROG(GUILE_TOOLS,guile-tools)
  AC_SUBST(GUILE_TOOLS)
 ])

# GUILE_FLAGS -- set flags for compiling and linking with Guile
#
# Usage: GUILE_FLAGS
#
# This macro runs the @code{guile-config} script, installed with Guile, to
# find out where Guile's header files and libraries are installed.  It sets
# two variables, @var{GUILE_CFLAGS} and @var{GUILE_LDFLAGS}.
#
# @var{GUILE_CFLAGS}: flags to pass to a C or C++ compiler to build code that
# uses Guile header files.  This is almost always just a @code{-I} flag.
#
# @var{GUILE_LDFLAGS}: flags to pass to the linker to link a program against
# Guile.  This includes @code{-lguile} for the Guile library itself, any
# libraries that Guile itself requires (like -lqthreads), and so on.  It may
# also include a @code{-L} flag to tell the compiler where to find the
# libraries.
#
# The variables are marked for substitution, as by @code{AC_SUBST}.
#
AC_DEFUN([GUILE_FLAGS],
 [AC_REQUIRE([GUILE_PROGS])dnl
  AC_MSG_CHECKING([libguile compile flags])
  GUILE_CFLAGS="`$GUILE_CONFIG compile`"
  AC_MSG_RESULT([$GUILE_CFLAGS])
  AC_MSG_CHECKING([libguile link flags])
  GUILE_LDFLAGS="`$GUILE_CONFIG link`"
  AC_MSG_RESULT([$GUILE_LDFLAGS])
  AC_SUBST(GUILE_CFLAGS)
  AC_SUBST(GUILE_LDFLAGS)
 ])

# GUILE_SITE_DIR -- find path to Guile "site" directory
#
# Usage: GUILE_SITE_DIR
#
# This looks for Guile's "site" directory, usually something like
# PREFIX/share/guile/site, and sets var @var{GUILE_SITE} to the path.
# Note that the var name is different from the macro name.
#
# The variable is marked for substitution, as by @code{AC_SUBST}.
#
AC_DEFUN([GUILE_SITE_DIR],
 [AC_REQUIRE([GUILE_PROGS])dnl
  AC_MSG_CHECKING(for Guile site directory)
  GUILE_SITE=`[$GUILE_CONFIG] info pkgdatadir`/site
  AC_MSG_RESULT($GUILE_SITE)
  AC_SUBST(GUILE_SITE)
 ])

# GUILE_CHECK -- evaluate Guile Scheme code and capture the return value
#
# Usage: GUILE_CHECK_RETVAL(var,check)
#
# @var{var} is a shell variable name to be set to the return value.
# @var{check} is a Guile Scheme expression, evaluated with "$GUILE -c", and
#    returning either 0 or non-#f to indicate the check passed.
#    Non-0 number or #f indicates failure.
#    Avoid using the character "#" since that confuses autoconf.
#
AC_DEFUN([GUILE_CHECK],
 [AC_REQUIRE([GUILE_PROGS])
  $GUILE -c "$2" > /dev/null 2>&1
  $1=$?
 ])

# GUILE_MODULE_CHECK -- check feature of a Guile Scheme module
#
# Usage: GUILE_MODULE_CHECK(var,module,featuretest,description)
#
# @var{var} is a shell variable name to be set to "yes" or "no".
# @var{module} is a list of symbols, like: (ice-9 common-list).
# @var{featuretest} is an expression acceptable to GUILE_CHECK, q.v.
# @var{description} is a present-tense verb phrase (passed to AC_MSG_CHECKING).
#
AC_DEFUN([GUILE_MODULE_CHECK],
         [AC_MSG_CHECKING([if $2 $4])
	  GUILE_CHECK($1,(use-modules $2) (exit ((lambda () $3))))
	  if test "$$1" = "0" ; then $1=yes ; else $1=no ; fi
          AC_MSG_RESULT($$1)
         ])

# GUILE_MODULE_AVAILABLE -- check availability of a Guile Scheme module
#
# Usage: GUILE_MODULE_AVAILABLE(var,module)
#
# @var{var} is a shell variable name to be set to "yes" or "no".
# @var{module} is a list of symbols, like: (ice-9 common-list).
#
AC_DEFUN([GUILE_MODULE_AVAILABLE],
         [GUILE_MODULE_CHECK($1,$2,0,is available)
         ])

# GUILE_MODULE_REQUIRED -- fail if a Guile Scheme module is unavailable
#
# Usage: GUILE_MODULE_REQUIRED(symlist)
#
# @var{symlist} is a list of symbols, WITHOUT surrounding parens,
# like: ice-9 common-list.
#
AC_DEFUN([GUILE_MODULE_REQUIRED],
         [GUILE_MODULE_AVAILABLE(ac_guile_module_required, ($1))
          if test "$ac_guile_module_required" = "no" ; then
              AC_MSG_ERROR([required guile module not found: ($1)])
          fi
         ])

# GUILE_MODULE_EXPORTS -- check if a module exports a variable
#
# Usage: GUILE_MODULE_EXPORTS(var,module,modvar)
#
# @var{var} is a shell variable to be set to "yes" or "no".
# @var{module} is a list of symbols, like: (ice-9 common-list).
# @var{modvar} is the Guile Scheme variable to check.
#
AC_DEFUN([GUILE_MODULE_EXPORTS],
 [GUILE_MODULE_CHECK($1,$2,$3,exports `$3')
 ])

# GUILE_MODULE_REQUIRED_EXPORT -- fail if a module doesn't export a variable
#
# Usage: GUILE_MODULE_REQUIRED_EXPORT(module,modvar)
#
# @var{module} is a list of symbols, like: (ice-9 common-list).
# @var{modvar} is the Guile Scheme variable to check.
#
AC_DEFUN([GUILE_MODULE_REQUIRED_EXPORT],
 [GUILE_MODULE_EXPORTS(guile_module_required_export,$1,$2)
  if test "$guile_module_required_export" = "no" ; then
      AC_MSG_ERROR([module $1 does not export $2; required])
  fi
 ])

## guile.m4 ends here