X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/93ccaef0c60868bb1a6e0747387ce34c0172b53e..26b263541b56cf79f2c249950c5eadb87ce28b68:/libguile/options.c diff --git a/libguile/options.c b/libguile/options.c index 9262d34fa..0e083143c 100644 --- a/libguile/options.c +++ b/libguile/options.c @@ -1,26 +1,29 @@ -/* Copyright (C) 1995,1996,1998,2000,2001 Free Software Foundation +/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008, 2009, 2010 Free Software Foundation * * 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. + * modify it under the terms of the GNU Lesser General Public License + * as published by the Free Software Foundation; either version 3 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 + * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA */ +#ifdef HAVE_CONFIG_H +# include +#endif #include "libguile/_scm.h" #include "libguile/mallocs.h" #include "libguile/strings.h" -#include "libguile/lang.h" #include "libguile/options.h" @@ -92,15 +95,14 @@ SCM_SYMBOL (scm_no_sym, "no"); static SCM protected_objects = SCM_EOL; - -/* Return a list of the current option setting. The format of an option - * setting is described in the above documentation. */ +/* Return a list of the current option setting. The format of an + * option setting is described in the above documentation. */ static SCM -get_option_setting (const scm_t_option options[], unsigned int n) +get_option_setting (const scm_t_option options[]) { unsigned int i; SCM ls = SCM_EOL; - for (i = 0; i != n; ++i) + for (i = 0; options[i].name; ++i) { switch (options[i].type) { @@ -109,7 +111,7 @@ get_option_setting (const scm_t_option options[], unsigned int n) ls = scm_cons (SCM_PACK (options[i].name), ls); break; case SCM_OPTION_INTEGER: - ls = scm_cons (SCM_I_MAKINUM (options[i].val), ls); + ls = scm_cons (scm_from_unsigned_integer (options[i].val), ls); ls = scm_cons (SCM_PACK (options[i].name), ls); break; case SCM_OPTION_SCM: @@ -124,21 +126,21 @@ get_option_setting (const scm_t_option options[], unsigned int n) /* Return a list of sublists, where each sublist contains option name, value * and documentation string. */ static SCM -get_documented_option_setting (const scm_t_option options[], unsigned int n) +get_documented_option_setting (const scm_t_option options[]) { SCM ans = SCM_EOL; unsigned int i; - for (i = 0; i != n; ++i) + for (i = 0; options[i].name; ++i) { - SCM ls = scm_cons (scm_str2string (options[i].doc), SCM_EOL); + SCM ls = scm_cons (scm_from_locale_string (options[i].doc), SCM_EOL); switch (options[i].type) { case SCM_OPTION_BOOLEAN: ls = scm_cons (options[i].val ? scm_yes_sym : scm_no_sym, ls); break; case SCM_OPTION_INTEGER: - ls = scm_cons (SCM_I_MAKINUM (options[i].val), ls); + ls = scm_cons (scm_from_unsigned_integer (options[i].val), ls); break; case SCM_OPTION_SCM: ls = scm_cons (SCM_PACK (options[i].val), ls); @@ -146,25 +148,40 @@ get_documented_option_setting (const scm_t_option options[], unsigned int n) ls = scm_cons (SCM_PACK (options[i].name), ls); ans = scm_cons (ls, ans); } - return ans; + return scm_reverse_x (ans, SCM_UNDEFINED); } +static int +options_length (scm_t_option options[]) +{ + unsigned int i = 0; + for (; options[i].name != NULL; ++i) + ; + + return i; +} + /* Alters options according to the given option setting 'args'. The value of * args is known to be a list, but it is not known whether the list is a well * formed option setting, i. e. if for every non-boolean option a value is * given. For this reason, the function applies all changes to a copy of the * original setting in memory. Only if 'args' was successfully processed, - * the new setting will overwrite the old one. */ + * the new setting will overwrite the old one. + * + * If DRY_RUN is set, don't change anything. This is useful for trying out an option + * before entering a critical section. + */ static void -change_option_setting (SCM args, scm_t_option options[], unsigned int n, const char *s) +change_option_setting (SCM args, scm_t_option options[], const char *s, + int dry_run) { unsigned int i; SCM locally_protected_args = args; - SCM malloc_obj = scm_malloc_obj (n * sizeof (scm_t_bits)); + SCM malloc_obj = scm_malloc_obj (options_length (options) * sizeof (scm_t_bits)); scm_t_bits *flags = (scm_t_bits *) SCM_MALLOCDATA (malloc_obj); - for (i = 0; i != n; ++i) + for (i = 0; options[i].name; ++i) { if (options[i].type == SCM_OPTION_BOOLEAN) flags[i] = 0; @@ -177,9 +194,9 @@ change_option_setting (SCM args, scm_t_option options[], unsigned int n, const c SCM name = SCM_CAR (args); int found = 0; - for (i = 0; i != n && !found; ++i) + for (i = 0; options[i].name && !found; ++i) { - if (SCM_EQ_P (name, SCM_PACK (options[i].name))) + if (scm_is_eq (name, SCM_PACK (options[i].name))) { switch (options[i].type) { @@ -188,14 +205,11 @@ change_option_setting (SCM args, scm_t_option options[], unsigned int n, const c break; case SCM_OPTION_INTEGER: args = SCM_CDR (args); - SCM_ASSERT (SCM_CONSP (args), args, SCM_ARG1, s); - SCM_ASSERT (SCM_INUMP (SCM_CAR (args)), args, SCM_ARG1, s); - flags[i] = SCM_INUM (SCM_CAR (args)); + flags[i] = scm_to_size_t (scm_car (args)); break; case SCM_OPTION_SCM: args = SCM_CDR (args); - SCM_ASSERT (SCM_CONSP (args), args, SCM_ARG1, s); - flags[i] = SCM_UNPACK (SCM_CAR (args)); + flags[i] = SCM_UNPACK (scm_car (args)); break; } found = 1; @@ -208,7 +222,10 @@ change_option_setting (SCM args, scm_t_option options[], unsigned int n, const c args = SCM_CDR (args); } - for (i = 0; i != n; ++i) + if (dry_run) + return; + + for (i = 0; options[i].name; ++i) { if (options[i].type == SCM_OPTION_SCM) { @@ -227,36 +244,42 @@ change_option_setting (SCM args, scm_t_option options[], unsigned int n, const c SCM -scm_options (SCM args, scm_t_option options[], unsigned int n, const char *s) +scm_options (SCM args, scm_t_option options[], const char *s) +{ + return scm_options_try (args, options, s, 0); +} + +SCM +scm_options_try (SCM args, scm_t_option options[], const char *s, + int dry_run) { if (SCM_UNBNDP (args)) - return get_option_setting (options, n); - else if (!SCM_NULL_OR_NIL_P (args) && !SCM_CONSP (args)) + return get_option_setting (options); + else if (!SCM_NULL_OR_NIL_P (args) && !scm_is_pair (args)) /* Dirk:FIXME:: This criterion should be improved. IMO it is better to * demand that args is #t if documentation should be shown than to say * that every argument except a list will print out documentation. */ - return get_documented_option_setting (options, n); + return get_documented_option_setting (options); else { SCM old_setting; SCM_ASSERT (scm_is_true (scm_list_p (args)), args, 1, s); - old_setting = get_option_setting (options, n); - change_option_setting (args, options, n, s); + old_setting = get_option_setting (options); + change_option_setting (args, options, s, dry_run); return old_setting; } } void -scm_init_opts (SCM (*func) (SCM), scm_t_option options[], unsigned int n) +scm_init_opts (SCM (*func) (SCM), scm_t_option options[]) { unsigned int i; - for (i = 0; i != n; ++i) + for (i = 0; options[i].name; ++i) { - SCM name = scm_str2symbol (options[i].name); + SCM name = scm_from_locale_symbol (options[i].name); options[i].name = (char *) SCM_UNPACK (name); - scm_permanent_object (name); } func (SCM_UNDEFINED); }