libguile/options.c

   1 /*      Copyright (C) 1995,1996 Mikael Djurfeldt
   2  *
   3  * This program is free software; you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  16  *
  17  * As a special exception, the Free Software Foundation gives permission
  18  * for additional uses of the text contained in its release of GUILE.
  19  *
  20  * The exception is that, if you link the GUILE library with other files
  21  * to produce an executable, this does not by itself cause the
  22  * resulting executable to be covered by the GNU General Public License.
  23  * Your use of that executable is in no way restricted on account of
  24  * linking the GUILE library code into it.
  25  *
  26  * This exception does not however invalidate any other reasons why
  27  * the executable file might be covered by the GNU General Public License.
  28  *
  29  * This exception applies only to the code released by the
  30  * Free Software Foundation under the name GUILE.  If you copy
  31  * code from other Free Software Foundation releases into a copy of
  32  * GUILE, as the General Public License permits, the exception does
  33  * not apply to the code that you add in this way.  To avoid misleading
  34  * anyone as to the status of such modified files, you must delete
  35  * this exception notice from them.
  36  *
  37  * If you write modifications of your own for GUILE, it is your choice
  38  * whether to permit this exception to apply to your modifications.
  39  * If you do not wish that, delete this exception notice.
  40  *
  41  * The author can be reached at djurfeldt@nada.kth.se
  42  * Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN
  43  */
  44 \f
  45
  46 #include <stdio.h>
  47 #include "_scm.h"
  48
  49 #include "options.h"
  50 \f
  51
  52 /* {Run-time options}
  53  *
  54  * This is the basic interface for low-level configuration of the
  55  * Guile library.  It is used for configuring the reader, evaluator,
  56  * printer and debugger.
  57  *
  58  * Motivation:
  59  *
  60  * 1. Altering option settings can have side effects.
  61  * 2. Option values can be stored in native format.
  62  *    (Important for efficiency in, e. g., the evaluator.)
  63  * 3. Doesn't use up name space.
  64  * 4. Options can be naturally grouped => ease of use.
  65  */
  66
  67 /* scm_options is the core of all options interface procedures.
  68  *
  69  * Some definitions:
  70  *
  71  * Run time options in Guile are arranged in groups.  Each group
  72  * affects a certain aspect of the behaviour of the library.
  73  *
  74  * An "options interface procedure" manages one group of options.  It
  75  * can be used to check or set options, or to get documentation for
  76  * all options of a group.  The options interface procedure is not
  77  * intended to be called directly by the user.  The user should
  78  * instead call
  79  *
  80  *   (<group>-options)
  81  *   (<group>-options 'help)
  82  *   (<group>-options 'full)
  83  *
  84  * to display current option settings (The second version also
  85  * displays documentation.  The third version also displays
  86  * information about programmer's options.), and
  87  *
  88  *   (<group>-enable  '<option-symbol>)
  89  *   (<group>-disable '<option-symbol>)
  90  *   (<group>-set! <option-symbol> <value>)
  91  *   (<group>-options <option setting>)
  92  *
  93  * to alter the state of an option  (The last version sets all
  94  * options according to <option setting>.) where <group> is the name
  95  * of the option group.
  96  *
  97  * An "option setting" represents the state of all low-level options
  98  * managed by one options interface procedure.  It is a list of
  99  * single symbols and symbols followed by a value.
 100  *
 101  * For boolean options, the presence of the symbol of that option in
 102  * the option setting indicates a true value.  If the symbol isn't a
 103  * member of the option setting this represents a false value.
 104  *
 105  * Other options are represented by a symbol followed by the value.
 106  *
 107  * If scm_options is called without arguments, the current option
 108  * setting is returned.  If the argument is an option setting, options
 109  * are altered and the old setting is returned.  If the argument isn't
 110  * a list, a list of sublists is returned, where each sublist contains
 111  * option name, value and documentation string.
 112  */
 113
 114 SCM_SYMBOL (scm_yes_sym, "yes");
 115 SCM_SYMBOL (scm_no_sym, "no");
 116
 117
 118 SCM
 119 scm_options (new_mode, options, n, s)
 120      SCM new_mode;
 121      scm_option options[];
 122      int n;
 123      char *s;
 124 {
 125   int i, docp = (!SCM_UNBNDP (new_mode)
 126                  && (SCM_IMP (new_mode) || SCM_NCONSP (new_mode)));
 127   SCM ans = SCM_EOL, ls;
 128   for (i = 0; i < n; ++i)
 129     {
 130       ls = docp ? scm_cons ((SCM) options[i].doc, SCM_EOL) : ans;
 131       switch (options[i].type)
 132         {
 133         case SCM_OPTION_BOOLEAN:
 134           if (docp)
 135             ls = scm_cons ((int) options[i].val
 136                            ? scm_yes_sym
 137                            : scm_no_sym,
 138                            ls);
 139           break;
 140         case SCM_OPTION_INTEGER:
 141           ls = scm_cons (SCM_MAKINUM ((int) options[i].val), ls);
 142           break;
 143         case SCM_OPTION_SCM:
 144           ls = scm_cons ((SCM) options[i].val, ls);
 145         }
 146       if (!((options[i].type == SCM_OPTION_BOOLEAN)
 147             && !docp
 148             && ! (int) options[i].val))
 149         ls = scm_cons ((SCM) options[i].name, ls);
 150       ans = docp ? scm_cons (ls, ans) : ls;
 151     }
 152   if (!(SCM_UNBNDP (new_mode) || docp))
 153     {
 154       unsigned long *flags;
 155       flags = (unsigned long *) scm_must_malloc (n * sizeof (unsigned long),
 156                                                  "mode buffer");
 157       for (i = 0; i < n; ++i)
 158         if (options[i].type == SCM_OPTION_BOOLEAN)
 159           flags[i] = 0;
 160         else
 161           flags[i] = (unsigned long) options[i].val;
 162       while (SCM_NNULLP (new_mode))
 163         {
 164           SCM_ASSERT (SCM_NIMP (new_mode) && SCM_CONSP (new_mode),
 165                       new_mode,
 166                       SCM_ARG1,
 167                       s);
 168           for (i = 0; i < n; ++i)
 169             if (SCM_CAR (new_mode) == (SCM) options[i].name)
 170               switch (options[i].type)
 171                 {
 172                 case SCM_OPTION_BOOLEAN:
 173                   flags[i] = 1;
 174                   goto cont;
 175                 case SCM_OPTION_INTEGER:
 176                   new_mode = SCM_CDR (new_mode);
 177                   SCM_ASSERT (SCM_NIMP (new_mode)
 178                               && SCM_CONSP (new_mode)
 179                               && SCM_INUMP (SCM_CAR (new_mode)),
 180                               new_mode,
 181                               SCM_ARG1,
 182                               s);
 183                   flags[i] = (unsigned long) SCM_INUM (SCM_CAR (new_mode));
 184                   goto cont;
 185                 case SCM_OPTION_SCM:
 186                   new_mode = SCM_CDR (new_mode);
 187                   flags[i] = SCM_CAR (new_mode);
 188                   goto cont;
 189                 }
 190 #ifndef RECKLESS
 191           scm_must_free ((char *) flags);
 192           scm_wta (SCM_CAR (new_mode), "Unknown mode flag", s);
 193 #endif
 194         cont:
 195           new_mode = SCM_CDR (new_mode);
 196         }
 197       for (i = 0; i < n; ++i) options[i].val = flags[i];
 198       scm_must_free ((char *) flags);
 199     }
 200   return ans;
 201 }
 202
 203
 204 void
 205 scm_init_opts (func, options, n)
 206      SCM (*func) (SCM);
 207      scm_option options[];
 208      int n;
 209 {
 210   int i;
 211
 212   for (i = 0; i < n; ++i)
 213     {
 214       options[i].name = (char *) SCM_CAR (scm_sysintern0 (options[i].name));
 215       options[i].doc = (char *) scm_permanent_object (scm_take0str
 216                                                       (options[i].doc));
 217     }
 218   func (SCM_UNDEFINED);
 219 }
 220
 221
 222 void
 223 scm_init_options ()
 224 {
 225 #include "options.x"
 226 }