*** empty log message ***

[bpt/guile.git] / libguile / options.c

diff --git a/libguile/options.c b/libguile/options.c
index d0aba0a..c5260e6 100644 (file)
--- a/libguile/options.c
+++ b/libguile/options.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995,1996 Mikael Djurfeldt
+/*     Copyright (C) 1995, 1996, 1998, 2000 Free Software Foundation
  * 
  * 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
@@ -12,7 +12,8 @@
  * 
  * 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
  *
  * As a special exception, the Free Software Foundation gives permission
  * for additional uses of the text contained in its release of GUILE.
@@ -39,14 +40,17 @@
  * If you do not wish that, delete this exception notice.
  *
  * The author can be reached at djurfeldt@nada.kth.se
- * Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN
- */
+ * Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN */
+
+/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
+   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
+
 \f
 
-#include <stdio.h>
-#include "_scm.h"
+#include "libguile/_scm.h"
+#include "libguile/strings.h"
 
-#include "options.h"
+#include "libguile/options.h"
 \f
 
 /* {Run-time options}
@@ -114,17 +118,14 @@
 SCM_SYMBOL (scm_yes_sym, "yes");
 SCM_SYMBOL (scm_no_sym, "no");
 
+static SCM protected_objects;
 
 SCM
-scm_options (new_mode, options, n, s)
-     SCM new_mode;
-     scm_option options[];
-     int n;
-     char *s;
+scm_options (SCM arg, scm_option options[], int n, const char *s)
 {
-  int i, docp = (!SCM_UNBNDP (new_mode)
-                && (SCM_IMP (new_mode) || SCM_NCONSP (new_mode)));
-  SCM ans = SCM_EOL, ls;
+  int i, docp = (!SCM_UNBNDP (arg) && !SCM_NULLP (arg) && !SCM_CONSP (arg));
+  /* Let `arg' GC protect the arguments */
+  SCM new_mode = arg, ans = SCM_EOL, ls;
   for (i = 0; i < n; ++i)
     {
       ls = docp ? scm_cons ((SCM) options[i].doc, SCM_EOL) : ans;
@@ -161,7 +162,7 @@ scm_options (new_mode, options, n, s)
          flags[i] = (unsigned long) options[i].val;
       while (SCM_NNULLP (new_mode))
        {
-         SCM_ASSERT (SCM_NIMP (new_mode) && SCM_CONSP (new_mode),
+         SCM_ASSERT (SCM_CONSP (new_mode),
                      new_mode,
                      SCM_ARG1,
                      s);
@@ -174,8 +175,7 @@ scm_options (new_mode, options, n, s)
                  goto cont;
                case SCM_OPTION_INTEGER:
                  new_mode = SCM_CDR (new_mode);
-                 SCM_ASSERT (SCM_NIMP (new_mode)
-                             && SCM_CONSP (new_mode)
+                 SCM_ASSERT (   SCM_CONSP (new_mode)
                              && SCM_INUMP (SCM_CAR (new_mode)),
                              new_mode,
                              SCM_ARG1,
@@ -184,17 +184,27 @@ scm_options (new_mode, options, n, s)
                  goto cont;
                case SCM_OPTION_SCM:
                  new_mode = SCM_CDR (new_mode);
-                 flags[i] = SCM_CAR (new_mode);
+                 flags[i] = SCM_UNPACK (SCM_CAR (new_mode));
                  goto cont;
                }
-#ifndef RECKLESS
+#ifndef SCM_RECKLESS
          scm_must_free ((char *) flags);
-         scm_wta (SCM_CAR (new_mode), "Unknown mode flag", s);
+         scm_misc_error (s, "Unknown mode flag: ~S", 
+                         SCM_LIST1 (SCM_CAR (new_mode)));
 #endif
        cont:
          new_mode = SCM_CDR (new_mode);
        }
-      for (i = 0; i < n; ++i) options[i].val = flags[i];
+      for (i = 0; i < n; ++i)
+       {
+         /* scm_option doesn't know if its a long or an SCM */
+         if (options[i].type == SCM_OPTION_SCM)
+           SCM_SETCDR (protected_objects,
+                       scm_cons (SCM_PACK(flags[i]),
+                                 scm_delq1_x (SCM_PACK(options[i].val),
+                                              SCM_CDR (protected_objects))));
+         options[i].val = flags[i];
+       }
       scm_must_free ((char *) flags);
     }
   return ans;
@@ -202,18 +212,24 @@ scm_options (new_mode, options, n, s)
 
 
 void
-scm_init_opts (func, options, n)
-     SCM (*func) (SCM);
-     scm_option options[];
-     int n;
+scm_init_opts (SCM (*func) (SCM), scm_option options[], int n)
 {
   int i;
 
   for (i = 0; i < n; ++i)
     {
-      options[i].name =        (char *) SCM_CAR (scm_sysintern0 (options[i].name));
-      options[i].doc = (char *) scm_permanent_object (scm_take0str
-                                                     (options[i].doc));
+      SCM name;
+      SCM doc;
+
+      name = scm_str2symbol (options[i].name);
+      options[i].name =        (char *) name;
+      scm_permanent_object (name);
+      doc = scm_take0str (options[i].doc);
+      options[i].doc = (char *) doc;
+      scm_permanent_object (doc);
+      if (options[i].type == SCM_OPTION_SCM)
+       SCM_SETCDR (protected_objects,
+                   scm_cons (SCM_PACK(options[i].val), SCM_CDR (protected_objects)));
     }
   func (SCM_UNDEFINED);
 }
@@ -222,5 +238,14 @@ scm_init_opts (func, options, n)
 void
 scm_init_options ()
 {
-#include "options.x"
+  protected_objects = scm_permanent_object (scm_cons (SCM_UNDEFINED, SCM_EOL));
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/options.x"
+#endif
 }
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/