Commit | Line | Data |
---|---|---|
dbb605f5 | 1 | /* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008 Free Software Foundation |
1a413ab9 | 2 | * |
73be1d9e | 3 | * This library is free software; you can redistribute it and/or |
53befeb7 NJ |
4 | * modify it under the terms of the GNU Lesser General Public License |
5 | * as published by the Free Software Foundation; either version 3 of | |
6 | * the License, or (at your option) any later version. | |
1a413ab9 | 7 | * |
53befeb7 NJ |
8 | * This library is distributed in the hope that it will be useful, but |
9 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
73be1d9e MV |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
11 | * Lesser General Public License for more details. | |
1a413ab9 | 12 | * |
73be1d9e MV |
13 | * You should have received a copy of the GNU Lesser General Public |
14 | * License along with this library; if not, write to the Free Software | |
53befeb7 NJ |
15 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
16 | * 02110-1301 USA | |
73be1d9e | 17 | */ |
6e8d25a6 | 18 | |
1a413ab9 | 19 | \f |
dbb605f5 LC |
20 | #ifdef HAVE_CONFIG_H |
21 | # include <config.h> | |
22 | #endif | |
1a413ab9 | 23 | |
a0599745 | 24 | #include "libguile/_scm.h" |
11d49f54 | 25 | #include "libguile/mallocs.h" |
a0599745 | 26 | #include "libguile/strings.h" |
c96d76b8 | 27 | #include "libguile/lang.h" |
1a413ab9 | 28 | |
a0599745 | 29 | #include "libguile/options.h" |
1a413ab9 MD |
30 | \f |
31 | ||
32 | /* {Run-time options} | |
33 | * | |
34 | * This is the basic interface for low-level configuration of the | |
35 | * Guile library. It is used for configuring the reader, evaluator, | |
36 | * printer and debugger. | |
cbff1d89 MD |
37 | * |
38 | * Motivation: | |
39 | * | |
40 | * 1. Altering option settings can have side effects. | |
41 | * 2. Option values can be stored in native format. | |
42 | * (Important for efficiency in, e. g., the evaluator.) | |
43 | * 3. Doesn't use up name space. | |
44 | * 4. Options can be naturally grouped => ease of use. | |
1a413ab9 MD |
45 | */ |
46 | ||
cbff1d89 MD |
47 | /* scm_options is the core of all options interface procedures. |
48 | * | |
49 | * Some definitions: | |
50 | * | |
51 | * Run time options in Guile are arranged in groups. Each group | |
52 | * affects a certain aspect of the behaviour of the library. | |
53 | * | |
54 | * An "options interface procedure" manages one group of options. It | |
55 | * can be used to check or set options, or to get documentation for | |
56 | * all options of a group. The options interface procedure is not | |
57 | * intended to be called directly by the user. The user should | |
58 | * instead call | |
59 | * | |
60 | * (<group>-options) | |
61 | * (<group>-options 'help) | |
62 | * (<group>-options 'full) | |
63 | * | |
64 | * to display current option settings (The second version also | |
65 | * displays documentation. The third version also displays | |
66 | * information about programmer's options.), and | |
67 | * | |
68 | * (<group>-enable '<option-symbol>) | |
69 | * (<group>-disable '<option-symbol>) | |
70 | * (<group>-set! <option-symbol> <value>) | |
71 | * (<group>-options <option setting>) | |
72 | * | |
73 | * to alter the state of an option (The last version sets all | |
74 | * options according to <option setting>.) where <group> is the name | |
75 | * of the option group. | |
76 | * | |
77 | * An "option setting" represents the state of all low-level options | |
78 | * managed by one options interface procedure. It is a list of | |
79 | * single symbols and symbols followed by a value. | |
80 | * | |
81 | * For boolean options, the presence of the symbol of that option in | |
82 | * the option setting indicates a true value. If the symbol isn't a | |
a0fcb308 | 83 | * member of the option setting this represents a false value. |
cbff1d89 | 84 | * |
a0fcb308 | 85 | * Other options are represented by a symbol followed by the value. |
cbff1d89 MD |
86 | * |
87 | * If scm_options is called without arguments, the current option | |
88 | * setting is returned. If the argument is an option setting, options | |
89 | * are altered and the old setting is returned. If the argument isn't | |
90 | * a list, a list of sublists is returned, where each sublist contains | |
91 | * option name, value and documentation string. | |
92 | */ | |
93 | ||
94 | SCM_SYMBOL (scm_yes_sym, "yes"); | |
95 | SCM_SYMBOL (scm_no_sym, "no"); | |
96 | ||
11d49f54 | 97 | static SCM protected_objects = SCM_EOL; |
1cc91f1b | 98 | |
e11e83f3 MV |
99 | /* Return a list of the current option setting. The format of an |
100 | * option setting is described in the above documentation. */ | |
11d49f54 | 101 | static SCM |
62560650 | 102 | get_option_setting (const scm_t_option options[]) |
11d49f54 DH |
103 | { |
104 | unsigned int i; | |
105 | SCM ls = SCM_EOL; | |
62560650 | 106 | for (i = 0; options[i].name; ++i) |
11d49f54 DH |
107 | { |
108 | switch (options[i].type) | |
109 | { | |
110 | case SCM_OPTION_BOOLEAN: | |
111 | if (options[i].val) | |
112 | ls = scm_cons (SCM_PACK (options[i].name), ls); | |
113 | break; | |
114 | case SCM_OPTION_INTEGER: | |
e11e83f3 | 115 | ls = scm_cons (scm_from_unsigned_integer (options[i].val), ls); |
11d49f54 DH |
116 | ls = scm_cons (SCM_PACK (options[i].name), ls); |
117 | break; | |
118 | case SCM_OPTION_SCM: | |
119 | ls = scm_cons (SCM_PACK (options[i].val), ls); | |
120 | ls = scm_cons (SCM_PACK (options[i].name), ls); | |
121 | } | |
122 | } | |
123 | return ls; | |
124 | } | |
125 | ||
126 | ||
127 | /* Return a list of sublists, where each sublist contains option name, value | |
128 | * and documentation string. */ | |
129 | static SCM | |
62560650 | 130 | get_documented_option_setting (const scm_t_option options[]) |
1a413ab9 | 131 | { |
11d49f54 DH |
132 | SCM ans = SCM_EOL; |
133 | unsigned int i; | |
134 | ||
62560650 | 135 | for (i = 0; options[i].name; ++i) |
1a413ab9 | 136 | { |
cc95e00a | 137 | SCM ls = scm_cons (scm_from_locale_string (options[i].doc), SCM_EOL); |
cbff1d89 MD |
138 | switch (options[i].type) |
139 | { | |
140 | case SCM_OPTION_BOOLEAN: | |
11d49f54 | 141 | ls = scm_cons (options[i].val ? scm_yes_sym : scm_no_sym, ls); |
cbff1d89 MD |
142 | break; |
143 | case SCM_OPTION_INTEGER: | |
e11e83f3 | 144 | ls = scm_cons (scm_from_unsigned_integer (options[i].val), ls); |
cbff1d89 MD |
145 | break; |
146 | case SCM_OPTION_SCM: | |
11d49f54 | 147 | ls = scm_cons (SCM_PACK (options[i].val), ls); |
cbff1d89 | 148 | } |
11d49f54 DH |
149 | ls = scm_cons (SCM_PACK (options[i].name), ls); |
150 | ans = scm_cons (ls, ans); | |
151 | } | |
152 | return ans; | |
153 | } | |
154 | ||
155 | ||
62560650 HWN |
156 | static int |
157 | options_length (scm_t_option options[]) | |
158 | { | |
159 | unsigned int i = 0; | |
160 | for (; options[i].name != NULL; ++i) | |
161 | ; | |
162 | ||
163 | return i; | |
164 | } | |
165 | ||
11d49f54 DH |
166 | /* Alters options according to the given option setting 'args'. The value of |
167 | * args is known to be a list, but it is not known whether the list is a well | |
168 | * formed option setting, i. e. if for every non-boolean option a value is | |
169 | * given. For this reason, the function applies all changes to a copy of the | |
170 | * original setting in memory. Only if 'args' was successfully processed, | |
03347a97 HWN |
171 | * the new setting will overwrite the old one. |
172 | * | |
173 | * If DRY_RUN is set, don't change anything. This is useful for trying out an option | |
174 | * before entering a critical section. | |
175 | */ | |
11d49f54 | 176 | static void |
03347a97 HWN |
177 | change_option_setting (SCM args, scm_t_option options[], const char *s, |
178 | int dry_run) | |
11d49f54 DH |
179 | { |
180 | unsigned int i; | |
181 | SCM locally_protected_args = args; | |
62560650 | 182 | SCM malloc_obj = scm_malloc_obj (options_length (options) * sizeof (scm_t_bits)); |
11d49f54 DH |
183 | scm_t_bits *flags = (scm_t_bits *) SCM_MALLOCDATA (malloc_obj); |
184 | ||
62560650 | 185 | for (i = 0; options[i].name; ++i) |
11d49f54 DH |
186 | { |
187 | if (options[i].type == SCM_OPTION_BOOLEAN) | |
188 | flags[i] = 0; | |
189 | else | |
190 | flags[i] = options[i].val; | |
cbff1d89 | 191 | } |
11d49f54 | 192 | |
c96d76b8 | 193 | while (!SCM_NULL_OR_NIL_P (args)) |
cbff1d89 | 194 | { |
11d49f54 DH |
195 | SCM name = SCM_CAR (args); |
196 | int found = 0; | |
197 | ||
62560650 | 198 | for (i = 0; options[i].name && !found; ++i) |
1a413ab9 | 199 | { |
bc36d050 | 200 | if (scm_is_eq (name, SCM_PACK (options[i].name))) |
11d49f54 | 201 | { |
1a413ab9 MD |
202 | switch (options[i].type) |
203 | { | |
204 | case SCM_OPTION_BOOLEAN: | |
205 | flags[i] = 1; | |
11d49f54 | 206 | break; |
1a413ab9 | 207 | case SCM_OPTION_INTEGER: |
11d49f54 | 208 | args = SCM_CDR (args); |
a2902ecb | 209 | flags[i] = scm_to_size_t (scm_car (args)); |
11d49f54 | 210 | break; |
cbff1d89 | 211 | case SCM_OPTION_SCM: |
11d49f54 | 212 | args = SCM_CDR (args); |
a2902ecb | 213 | flags[i] = SCM_UNPACK (scm_car (args)); |
11d49f54 | 214 | break; |
1a413ab9 | 215 | } |
11d49f54 DH |
216 | found = 1; |
217 | } | |
1a413ab9 | 218 | } |
11d49f54 DH |
219 | |
220 | if (!found) | |
221 | scm_misc_error (s, "Unknown option name: ~S", scm_list_1 (name)); | |
222 | ||
223 | args = SCM_CDR (args); | |
224 | } | |
225 | ||
03347a97 HWN |
226 | if (dry_run) |
227 | return; | |
228 | ||
62560650 | 229 | for (i = 0; options[i].name; ++i) |
11d49f54 DH |
230 | { |
231 | if (options[i].type == SCM_OPTION_SCM) | |
263a691f | 232 | { |
11d49f54 DH |
233 | SCM old = SCM_PACK (options[i].val); |
234 | SCM new = SCM_PACK (flags[i]); | |
235 | if (!SCM_IMP (old)) | |
236 | protected_objects = scm_delq1_x (old, protected_objects); | |
237 | if (!SCM_IMP (new)) | |
238 | protected_objects = scm_cons (new, protected_objects); | |
263a691f | 239 | } |
11d49f54 DH |
240 | options[i].val = flags[i]; |
241 | } | |
242 | ||
243 | scm_remember_upto_here_2 (locally_protected_args, malloc_obj); | |
244 | } | |
245 | ||
246 | ||
247 | SCM | |
62560650 | 248 | scm_options (SCM args, scm_t_option options[], const char *s) |
03347a97 HWN |
249 | { |
250 | return scm_options_try (args, options, s, 0); | |
251 | } | |
252 | ||
253 | SCM | |
254 | scm_options_try (SCM args, scm_t_option options[], const char *s, | |
255 | int dry_run) | |
11d49f54 DH |
256 | { |
257 | if (SCM_UNBNDP (args)) | |
62560650 | 258 | return get_option_setting (options); |
d2e53ed6 | 259 | else if (!SCM_NULL_OR_NIL_P (args) && !scm_is_pair (args)) |
11d49f54 DH |
260 | /* Dirk:FIXME:: This criterion should be improved. IMO it is better to |
261 | * demand that args is #t if documentation should be shown than to say | |
262 | * that every argument except a list will print out documentation. */ | |
62560650 | 263 | return get_documented_option_setting (options); |
11d49f54 DH |
264 | else |
265 | { | |
266 | SCM old_setting; | |
7888309b | 267 | SCM_ASSERT (scm_is_true (scm_list_p (args)), args, 1, s); |
62560650 | 268 | old_setting = get_option_setting (options); |
03347a97 | 269 | change_option_setting (args, options, s, dry_run); |
11d49f54 | 270 | return old_setting; |
1a413ab9 | 271 | } |
1a413ab9 MD |
272 | } |
273 | ||
1cc91f1b | 274 | |
1a413ab9 | 275 | void |
62560650 | 276 | scm_init_opts (SCM (*func) (SCM), scm_t_option options[]) |
1a413ab9 | 277 | { |
11d49f54 | 278 | unsigned int i; |
1a413ab9 | 279 | |
62560650 | 280 | for (i = 0; options[i].name; ++i) |
cbff1d89 | 281 | { |
cc95e00a | 282 | SCM name = scm_from_locale_symbol (options[i].name); |
11d49f54 | 283 | options[i].name = (char *) SCM_UNPACK (name); |
85db4a2c | 284 | scm_permanent_object (name); |
cbff1d89 | 285 | } |
1a413ab9 MD |
286 | func (SCM_UNDEFINED); |
287 | } | |
288 | ||
1cc91f1b | 289 | |
1a413ab9 MD |
290 | void |
291 | scm_init_options () | |
1a413ab9 | 292 | { |
11d49f54 DH |
293 | scm_gc_register_root (&protected_objects); |
294 | ||
a0599745 | 295 | #include "libguile/options.x" |
1a413ab9 | 296 | } |
89e00824 ML |
297 | |
298 | /* | |
299 | Local Variables: | |
300 | c-file-style: "gnu" | |
301 | End: | |
302 | */ |