fix <letrec> docs
[bpt/guile.git] / libguile / script.c
CommitLineData
32ce4058 1/* Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
73be1d9e 2 * This library is free software; you can redistribute it and/or
53befeb7
NJ
3 * modify it under the terms of the GNU Lesser General Public License
4 * as published by the Free Software Foundation; either version 3 of
5 * the License, or (at your option) any later version.
224c49f9 6 *
53befeb7
NJ
7 * This library is distributed in the hope that it will be useful, but
8 * WITHOUT ANY WARRANTY; without even the implied warranty of
73be1d9e
MV
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
10 * Lesser General Public License for more details.
224c49f9 11 *
73be1d9e
MV
12 * You should have received a copy of the GNU Lesser General Public
13 * License along with this library; if not, write to the Free Software
53befeb7
NJ
14 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
15 * 02110-1301 USA
73be1d9e 16 */
224c49f9
JB
17
18/* "script.c" argv tricks for `#!' scripts.
d3be4a7a 19 Authors: Aubrey Jaffer and Jim Blandy */
224c49f9 20
dbb605f5 21#ifdef HAVE_CONFIG_H
773ca93e
RB
22# include <config.h>
23#endif
6e8d25a6 24
224c49f9 25#include <stdio.h>
e6e2e95a 26#include <errno.h>
224c49f9 27#include <ctype.h>
e6e2e95a 28
4f02b98d
LC
29#include <version-etc.h>
30
a0599745 31#include "libguile/_scm.h"
89bc270d
HWN
32#include "libguile/eval.h"
33#include "libguile/feature.h"
a0599745 34#include "libguile/load.h"
ee001750 35#include "libguile/private-gc.h" /* scm_getenv_int */
89bc270d 36#include "libguile/read.h"
a0599745 37#include "libguile/script.h"
89bc270d
HWN
38#include "libguile/strings.h"
39#include "libguile/strports.h"
40#include "libguile/validate.h"
41#include "libguile/version.h"
224c49f9 42
bd9e24b3
GH
43#ifdef HAVE_STRING_H
44#include <string.h>
45#endif
46
d3be4a7a 47#ifdef HAVE_UNISTD_H
224c49f9 48#include <unistd.h> /* for X_OK define */
224c49f9
JB
49#endif
50
7beabedb
MG
51#ifdef HAVE_IO_H
52#include <io.h>
53#endif
54
224c49f9
JB
55/* Concatentate str2 onto str1 at position n and return concatenated
56 string if file exists; 0 otherwise. */
57
58static char *
6e8d25a6 59scm_cat_path (char *str1, const char *str2, long n)
224c49f9
JB
60{
61 if (!n)
62 n = strlen (str2);
63 if (str1)
64 {
1be6b49c
ML
65 size_t len = strlen (str1);
66 str1 = (char *) realloc (str1, (size_t) (len + n + 1));
224c49f9
JB
67 if (!str1)
68 return 0L;
69 strncat (str1 + len, str2, n);
70 return str1;
71 }
67329a9e 72 str1 = (char *) scm_malloc ((size_t) (n + 1));
224c49f9
JB
73 if (!str1)
74 return 0L;
75 str1[0] = 0;
76 strncat (str1, str2, n);
77 return str1;
78}
79
80#if 0
81static char *
6e8d25a6 82scm_try_path (char *path)
224c49f9
JB
83{
84 FILE *f;
85 /* fprintf(stderr, "Trying %s\n", path);fflush(stderr); */
86 if (!path)
87 return 0L;
88 SCM_SYSCALL (f = fopen (path, "r");
89 );
90 if (f)
91 {
92 fclose (f);
93 return path;
94 }
95 free (path);
96 return 0L;
97}
98
99static char *
6e8d25a6 100scm_sep_init_try (char *path, const char *sep, const char *initname)
224c49f9
JB
101{
102 if (path)
103 path = scm_cat_path (path, sep, 0L);
104 if (path)
105 path = scm_cat_path (path, initname, 0L);
106 return scm_try_path (path);
107}
108#endif
109
110#ifndef LINE_INCREMENTORS
111#define LINE_INCREMENTORS '\n'
112#ifdef MSDOS
113#define WHITE_SPACES ' ':case '\t':case '\r':case '\f':case 26
114#else
115#define WHITE_SPACES ' ':case '\t':case '\r':case '\f'
116#endif /* def MSDOS */
117#endif /* ndef LINE_INCREMENTORS */
118
119#ifndef MAXPATHLEN
120#define MAXPATHLEN 80
121#endif /* ndef MAXPATHLEN */
122#ifndef X_OK
123#define X_OK 1
124#endif /* ndef X_OK */
125
224c49f9 126char *
d3be4a7a 127scm_find_executable (const char *name)
224c49f9
JB
128{
129 char tbuf[MAXPATHLEN];
d9c36d2a 130 int i = 0, c;
224c49f9
JB
131 FILE *f;
132
133 /* fprintf(stderr, "s_f_e checking access %s ->%d\n", name, access(name, X_OK)); fflush(stderr); */
134 if (access (name, X_OK))
135 return 0L;
136 f = fopen (name, "r");
137 if (!f)
138 return 0L;
139 if ((fgetc (f) == '#') && (fgetc (f) == '!'))
140 {
141 while (1)
d9c36d2a 142 switch (c = fgetc (f))
224c49f9
JB
143 {
144 case /*WHITE_SPACES */ ' ':
145 case '\t':
146 case '\r':
147 case '\f':
148 case EOF:
d9c36d2a 149 tbuf[i] = 0;
224c49f9
JB
150 fclose (f);
151 return scm_cat_path (0L, tbuf, 0L);
d9c36d2a
MV
152 default:
153 tbuf[i++] = c;
154 break;
224c49f9
JB
155 }
156 }
157 fclose (f);
158 return scm_cat_path (0L, name, 0L);
159}
224c49f9 160
224c49f9
JB
161
162/* Read a \nnn-style escape. We've just read the backslash. */
163static int
6e8d25a6 164script_get_octal (FILE *f)
db4b4ca6 165#define FUNC_NAME "script_get_octal"
224c49f9
JB
166{
167 int i;
168 int value = 0;
169
170 for (i = 0; i < 3; i++)
171 {
172 int c = getc (f);
173 if ('0' <= c && c <= '7')
174 value = (value * 8) + (c - '0');
175 else
db4b4ca6
DH
176 SCM_MISC_ERROR ("malformed script: bad octal backslash escape",
177 SCM_EOL);
224c49f9
JB
178 }
179 return value;
180}
db4b4ca6 181#undef FUNC_NAME
224c49f9
JB
182
183
184static int
6e8d25a6 185script_get_backslash (FILE *f)
db4b4ca6 186#define FUNC_NAME "script_get_backslash"
224c49f9
JB
187{
188 int c = getc (f);
189
190 switch (c)
191 {
192 case 'a': return '\a';
193 case 'b': return '\b';
194 case 'f': return '\f';
195 case 'n': return '\n';
196 case 'r': return '\r';
197 case 't': return '\t';
198 case 'v': return '\v';
199
200 case '\\':
201 case ' ':
202 case '\t':
203 case '\n':
204 return c;
205
206 case '0': case '1': case '2': case '3':
207 case '4': case '5': case '6': case '7':
208 ungetc (c, f);
209 return script_get_octal (f);
db4b4ca6 210
224c49f9 211 case EOF:
db4b4ca6 212 SCM_MISC_ERROR ("malformed script: backslash followed by EOF", SCM_EOL);
224c49f9
JB
213 return 0; /* not reached? */
214
215 default:
db4b4ca6 216 SCM_MISC_ERROR ("malformed script: bad backslash sequence", SCM_EOL);
224c49f9
JB
217 return 0; /* not reached? */
218 }
219}
db4b4ca6 220#undef FUNC_NAME
224c49f9
JB
221
222
223static char *
6e8d25a6 224script_read_arg (FILE *f)
db4b4ca6 225#define FUNC_NAME "script_read_arg"
224c49f9 226{
1be6b49c 227 size_t size = 7;
67329a9e 228 char *buf = scm_malloc (size + 1);
1be6b49c 229 size_t len = 0;
224c49f9
JB
230
231 if (! buf)
232 return 0;
233
234 for (;;)
235 {
236 int c = getc (f);
237 switch (c)
238 {
239 case '\\':
240 c = script_get_backslash (f);
241 /* The above produces a new character to add to the argument.
242 Fall through. */
243 default:
244 if (len >= size)
245 {
246 size = (size + 1) * 2;
247 buf = realloc (buf, size);
248 if (! buf)
249 return 0;
250 }
251 buf[len++] = c;
252 break;
253
254 case '\n':
255 /* This may terminate an arg now, but it will terminate the
256 entire list next time through. */
257 ungetc ('\n', f);
258 case EOF:
259 if (len == 0)
260 {
261 free (buf);
262 return 0;
263 }
264 /* Otherwise, those characters terminate the argument; fall
265 through. */
266 case ' ':
267 buf[len] = '\0';
268 return buf;
269
270 case '\t':
271 free (buf);
db4b4ca6 272 SCM_MISC_ERROR ("malformed script: TAB in meta-arguments", SCM_EOL);
224c49f9
JB
273 return 0; /* not reached? */
274 }
275 }
276}
db4b4ca6 277#undef FUNC_NAME
224c49f9
JB
278
279
280static int
6e8d25a6 281script_meta_arg_P (char *arg)
224c49f9
JB
282{
283 if ('\\' != arg[0])
284 return 0L;
285#ifdef MSDOS
286 return !arg[1];
287#else
288 switch (arg[1])
289 {
290 case 0:
291 case '%':
292 case WHITE_SPACES:
293 return !0;
294 default:
295 return 0L;
296 }
297#endif
298}
299
300char **
6e8d25a6 301scm_get_meta_args (int argc, char **argv)
224c49f9
JB
302{
303 int nargc = argc, argi = 1, nargi = 1;
304 char *narg, **nargv;
305 if (!(argc > 2 && script_meta_arg_P (argv[1])))
306 return 0L;
67329a9e 307 if (!(nargv = (char **) scm_malloc ((1 + nargc) * sizeof (char *))))
224c49f9
JB
308 return 0L;
309 nargv[0] = argv[0];
310 while (((argi + 1) < argc) && (script_meta_arg_P (argv[argi])))
311 {
312 FILE *f = fopen (argv[++argi], "r");
313 if (f)
314 {
315 nargc--; /* to compensate for replacement of '\\' */
316 while (1)
317 switch (getc (f))
318 {
319 case EOF:
320 return 0L;
321 default:
322 continue;
323 case '\n':
324 goto found_args;
325 }
326 found_args:
327 while ((narg = script_read_arg (f)))
328 if (!(nargv = (char **) realloc (nargv,
329 (1 + ++nargc) * sizeof (char *))))
330 return 0L;
331 else
332 nargv[nargi++] = narg;
333 fclose (f);
334 nargv[nargi++] = argv[argi++];
335 }
336 }
337 while (argi <= argc)
338 nargv[nargi++] = argv[argi++];
339 return nargv;
340}
341
342int
6e8d25a6 343scm_count_argv (char **argv)
224c49f9
JB
344{
345 int argc = 0;
346 while (argv[argc])
347 argc++;
348 return argc;
349}
350
351
352/* For use in error messages. */
353char *scm_usage_name = 0;
354
355void
356scm_shell_usage (int fatal, char *message)
357{
48dc9f34
KR
358 FILE *fp = (fatal ? stderr : stdout);
359
224c49f9 360 if (message)
48dc9f34 361 fprintf (fp, "%s\n", message);
224c49f9 362
4f02b98d
LC
363 fprintf (fp,
364 "Usage: %s [OPTION]... [FILE]...\n"
224c49f9
JB
365 "Evaluate Scheme code, interactively or from a script.\n"
366 "\n"
defdc4b4 367 " [-s] FILE load Scheme source code from FILE, and exit\n"
224c49f9 368 " -c EXPR evalute Scheme expression EXPR, and exit\n"
4f02b98d 369 " -- stop scanning arguments; run interactively\n\n"
224c49f9
JB
370 "The above switches stop argument processing, and pass all\n"
371 "remaining arguments as the value of (command-line).\n"
defdc4b4 372 "If FILE begins with `-' the -s switch is mandatory.\n"
224c49f9 373 "\n"
caa29067 374 " -L DIRECTORY add DIRECTORY to the front of the module load path\n"
224c49f9
JB
375 " -l FILE load Scheme source code from FILE\n"
376 " -e FUNCTION after reading script, apply FUNCTION to\n"
377 " command line arguments\n"
378 " -ds do -s script at this point\n"
d150e491 379 " --debug start with debugging evaluator and backtraces\n"
3682a51a
MV
380 " --no-debug start with normal evaluator\n"
381 " Default is to enable debugging for interactive\n"
382 " use, but not for `-s' and `-c'.\n"
ee001750
AW
383 " --autocompile compile source files automatically\n"
384 " --no-autocompile disable automatic source file compilation\n"
385 " Default is to enable autocompilation of source\n"
386 " files.\n"
97c524bd 387 " -q inhibit loading of user init file\n"
39cde5c5
MG
388 " --use-srfi=LS load SRFI modules for the SRFIs in LS,\n"
389 " which is a list of numbers like \"2,13,14\"\n"
224c49f9
JB
390 " -h, --help display this help and exit\n"
391 " -v, --version display version information and exit\n"
4f02b98d 392 " \\ read arguments from following script lines\n",
224c49f9
JB
393 scm_usage_name);
394
4f02b98d
LC
395 emit_bug_reporting_address ();
396
224c49f9 397 if (fatal)
8e568309 398 exit (fatal);
224c49f9
JB
399}
400
401
402/* Some symbols used by the command-line compiler. */
403SCM_SYMBOL (sym_load, "load");
404SCM_SYMBOL (sym_eval_string, "eval-string");
405SCM_SYMBOL (sym_command_line, "command-line");
406SCM_SYMBOL (sym_begin, "begin");
3682a51a 407SCM_SYMBOL (sym_turn_on_debugging, "turn-on-debugging");
224c49f9 408SCM_SYMBOL (sym_load_user_init, "load-user-init");
ff87b2bd 409SCM_SYMBOL (sym_ice_9, "ice-9");
224c49f9
JB
410SCM_SYMBOL (sym_top_repl, "top-repl");
411SCM_SYMBOL (sym_quit, "quit");
39cde5c5 412SCM_SYMBOL (sym_use_srfis, "use-srfis");
caa29067
MV
413SCM_SYMBOL (sym_load_path, "%load-path");
414SCM_SYMBOL (sym_set_x, "set!");
ee001750 415SCM_SYMBOL (sym_sys_load_should_autocompile, "%load-should-autocompile");
caa29067 416SCM_SYMBOL (sym_cons, "cons");
39e707a1
MV
417SCM_SYMBOL (sym_at, "@");
418SCM_SYMBOL (sym_atat, "@@");
419SCM_SYMBOL (sym_main, "main");
224c49f9
JB
420
421/* Given an array of command-line switches, return a Scheme expression
422 to carry out the actions specified by the switches.
423
424 If you told me this should have been written in Scheme, I'd
425 probably agree. I'd say I didn't feel comfortable doing that in
426 the present system. You'd say, well, fix the system so you are
427 comfortable doing that. I'd agree again. *shrug*
ac16426b 428 */
224c49f9 429
1abb11b6
MD
430static char guile[] = "guile";
431
39e707a1
MV
432static int
433all_symbols (SCM list)
434{
435 while (scm_is_pair (list))
436 {
437 if (!scm_is_symbol (SCM_CAR (list)))
438 return 0;
439 list = SCM_CDR (list);
440 }
441 return 1;
442}
443
224c49f9
JB
444SCM
445scm_compile_shell_switches (int argc, char **argv)
446{
447 SCM tail = SCM_EOL; /* We accumulate the list backwards,
448 and then reverse! it before we
449 return it. */
450 SCM do_script = SCM_EOL; /* The element of the list containing
451 the "load" command, in case we get
452 the "-ds" switch. */
453 SCM entry_point = SCM_EOL; /* for -e switch */
caa29067 454 SCM user_load_path = SCM_EOL; /* for -L switch */
224c49f9 455 int interactive = 1; /* Should we go interactive when done? */
97c524bd 456 int inhibit_user_init = 0; /* Don't load user init file */
3682a51a
MV
457 int turn_on_debugging = 0;
458 int dont_turn_on_debugging = 0;
459
224c49f9 460 int i;
1abb11b6 461 char *argv0 = guile;
224c49f9
JB
462
463 if (argc > 0)
464 {
d0e32dd5 465 argv0 = argv[0];
224c49f9
JB
466 scm_usage_name = strrchr (argv[0], '/');
467 if (! scm_usage_name)
468 scm_usage_name = argv[0];
469 else
470 scm_usage_name++;
471 }
472 if (! scm_usage_name)
1abb11b6 473 scm_usage_name = guile;
224c49f9
JB
474
475 for (i = 1; i < argc; i++)
476 {
defdc4b4 477 if ((! strcmp (argv[i], "-s")) || (argv[i][0] != '-')) /* load script */
224c49f9 478 {
defdc4b4 479 if ((argv[i][0] == '-') && (++i >= argc))
224c49f9
JB
480 scm_shell_usage (1, "missing argument to `-s' switch");
481
482 /* If we specified the -ds option, do_script points to the
483 cdr of an expression like (load #f); we replace the car
484 (i.e., the #f) with the script name. */
d2e53ed6 485 if (!scm_is_null (do_script))
224c49f9 486 {
cc95e00a 487 SCM_SETCAR (do_script, scm_from_locale_string (argv[i]));
224c49f9
JB
488 do_script = SCM_EOL;
489 }
490 else
491 /* Construct an application of LOAD to the script name. */
492 tail = scm_cons (scm_cons2 (sym_load,
cc95e00a 493 scm_from_locale_string (argv[i]),
224c49f9
JB
494 SCM_EOL),
495 tail);
496 argv0 = argv[i];
497 i++;
498 interactive = 0;
499 break;
500 }
501
502 else if (! strcmp (argv[i], "-c")) /* evaluate expr */
503 {
504 if (++i >= argc)
505 scm_shell_usage (1, "missing argument to `-c' switch");
506 tail = scm_cons (scm_cons2 (sym_eval_string,
cc95e00a 507 scm_from_locale_string (argv[i]),
224c49f9
JB
508 SCM_EOL),
509 tail);
510 i++;
511 interactive = 0;
512 break;
513 }
514
515 else if (! strcmp (argv[i], "--")) /* end args; go interactive */
516 {
517 i++;
518 break;
519 }
520
521 else if (! strcmp (argv[i], "-l")) /* load a file */
522 {
523 if (++i < argc)
524 tail = scm_cons (scm_cons2 (sym_load,
cc95e00a 525 scm_from_locale_string (argv[i]),
224c49f9
JB
526 SCM_EOL),
527 tail);
528 else
529 scm_shell_usage (1, "missing argument to `-l' switch");
530 }
531
caa29067
MV
532 else if (! strcmp (argv[i], "-L")) /* add to %load-path */
533 {
534 if (++i < argc)
7311b3e8
MV
535 user_load_path =
536 scm_cons (scm_list_3 (sym_set_x,
537 sym_load_path,
538 scm_list_3 (sym_cons,
539 scm_from_locale_string (argv[i]),
540 sym_load_path)),
541 user_load_path);
caa29067
MV
542 else
543 scm_shell_usage (1, "missing argument to `-L' switch");
544 }
545
224c49f9
JB
546 else if (! strcmp (argv[i], "-e")) /* entry point */
547 {
548 if (++i < argc)
39e707a1
MV
549 {
550 SCM port
551 = scm_open_input_string (scm_from_locale_string (argv[i]));
552 SCM arg1 = scm_read (port);
553 SCM arg2 = scm_read (port);
554
555 /* Recognize syntax of certain versions of Guile 1.4 and
556 transform to (@ MODULE-NAME FUNC).
557 */
558 if (scm_is_false (scm_eof_object_p (arg2)))
559 entry_point = scm_list_3 (sym_at, arg1, arg2);
560 else if (scm_is_pair (arg1)
561 && !(scm_is_eq (SCM_CAR (arg1), sym_at)
562 || scm_is_eq (SCM_CAR (arg1), sym_atat))
563 && all_symbols (arg1))
564 entry_point = scm_list_3 (sym_at, arg1, sym_main);
565 else
566 entry_point = arg1;
567 }
224c49f9
JB
568 else
569 scm_shell_usage (1, "missing argument to `-e' switch");
570 }
571
572 else if (! strcmp (argv[i], "-ds")) /* do script here */
573 {
574 /* We put a dummy "load" expression, and let the -s put the
575 filename in. */
d2e53ed6 576 if (!scm_is_null (do_script))
224c49f9
JB
577 scm_shell_usage (1, "the -ds switch may only be specified once");
578 do_script = scm_cons (SCM_BOOL_F, SCM_EOL);
579 tail = scm_cons (scm_cons (sym_load, do_script),
580 tail);
581 }
582
3682a51a
MV
583 else if (! strcmp (argv[i], "--debug"))
584 {
585 turn_on_debugging = 1;
586 dont_turn_on_debugging = 0;
587 }
588
589 else if (! strcmp (argv[i], "--no-debug"))
d150e491 590 {
3682a51a
MV
591 dont_turn_on_debugging = 1;
592 turn_on_debugging = 0;
d150e491
MD
593 }
594
6128f34c
AW
595 /* Do autocompile on/off now, because the form itself might need this
596 decision. */
ee001750 597 else if (! strcmp (argv[i], "--autocompile"))
6128f34c
AW
598 scm_variable_set_x (scm_c_lookup ("%load-should-autocompile"),
599 SCM_BOOL_T);
ee001750
AW
600
601 else if (! strcmp (argv[i], "--no-autocompile"))
6128f34c
AW
602 scm_variable_set_x (scm_c_lookup ("%load-should-autocompile"),
603 SCM_BOOL_F);
ee001750 604
97c524bd
MD
605 else if (! strcmp (argv[i], "-q")) /* don't load user init */
606 inhibit_user_init = 1;
607
39cde5c5
MG
608 else if (! strncmp (argv[i], "--use-srfi=", 11)) /* load SRFIs */
609 {
610 SCM srfis = SCM_EOL; /* List of requested SRFIs. */
611 char * p = argv[i] + 11;
612 while (*p)
613 {
614 long num;
615 char * end;
616
617 num = strtol (p, &end, 10);
618 if (end - p > 0)
619 {
b9bd8526 620 srfis = scm_cons (scm_from_long (num), srfis);
39cde5c5
MG
621 if (*end)
622 {
623 if (*end == ',')
624 p = end + 1;
625 else
626 scm_shell_usage (1, "invalid SRFI specification");
627 }
628 else
629 break;
630 }
631 else
632 scm_shell_usage (1, "invalid SRFI specification");
633 }
634 if (scm_ilength (srfis) <= 0)
635 scm_shell_usage (1, "invalid SRFI specification");
636 srfis = scm_reverse_x (srfis, SCM_UNDEFINED);
1afff620
KN
637 tail = scm_cons (scm_list_2 (sym_use_srfis,
638 scm_list_2 (scm_sym_quote, srfis)),
39cde5c5
MG
639 tail);
640 }
641
224c49f9
JB
642 else if (! strcmp (argv[i], "-h")
643 || ! strcmp (argv[i], "--help"))
644 {
645 scm_shell_usage (0, 0);
646 exit (0);
647 }
648
649 else if (! strcmp (argv[i], "-v")
650 || ! strcmp (argv[i], "--version"))
651 {
652 /* Print version number. */
4f02b98d
LC
653 version_etc (stdout, scm_usage_name, PACKAGE_NAME, PACKAGE_VERSION,
654 /* XXX: Use gettext for the string below. */
655 "the Guile developers", NULL);
224c49f9
JB
656 exit (0);
657 }
658
659 else
660 {
661 fprintf (stderr, "%s: Unrecognized switch `%s'\n",
662 scm_usage_name, argv[i]);
663 scm_shell_usage (1, 0);
664 }
665 }
666
667 /* Check to make sure the -ds got a -s. */
d2e53ed6 668 if (!scm_is_null (do_script))
224c49f9
JB
669 scm_shell_usage (1, "the `-ds' switch requires the use of `-s' as well");
670
671 /* Make any remaining arguments available to the
672 script/command/whatever. */
28795b1f 673 scm_set_program_arguments (argc ? argc - i : 0, argv + i, argv0);
224c49f9 674
224c49f9 675 /* Handle the `-e' switch, if it was specified. */
d2e53ed6 676 if (!scm_is_null (entry_point))
224c49f9
JB
677 tail = scm_cons (scm_cons2 (entry_point,
678 scm_cons (sym_command_line, SCM_EOL),
679 SCM_EOL),
680 tail);
681
97c524bd 682 /* If we didn't end with a -c or a -s, start the repl. */
224c49f9
JB
683 if (interactive)
684 {
ff87b2bd
AW
685 tail = scm_cons (scm_list_1 (scm_list_3
686 (sym_at,
687 scm_list_2 (sym_ice_9, sym_top_repl),
688 sym_top_repl)),
689 tail);
224c49f9 690 }
08fea088
GH
691 else
692 {
693 /* After doing all the other actions prescribed by the command line,
694 quit. */
695 tail = scm_cons (scm_cons (sym_quit, SCM_EOL),
6b8d19d3 696 tail);
08fea088 697 }
224c49f9 698
97c524bd
MD
699 /* After the following line, actions will be added to the front. */
700 tail = scm_reverse_x (tail, SCM_UNDEFINED);
caa29067
MV
701
702 /* add the user-specified load path here, so it won't be in effect
703 during the loading of the user's customization file. */
d2e53ed6 704 if(!scm_is_null(user_load_path))
caa29067
MV
705 {
706 tail = scm_append_x( scm_cons2(user_load_path, tail, SCM_EOL) );
707 }
97c524bd
MD
708
709 /* If we didn't end with a -c or a -s and didn't supply a -q, load
710 the user's customization file. */
711 if (interactive && !inhibit_user_init)
712 {
713 tail = scm_cons (scm_cons (sym_load_user_init, SCM_EOL), tail);
714 }
715
3682a51a 716 /* If debugging was requested, or we are interactive and debugging
480fa28d
NJ
717 was not explicitly turned off, turn on debugging. */
718 if (turn_on_debugging || (interactive && !dont_turn_on_debugging))
3682a51a
MV
719 {
720 tail = scm_cons (scm_cons (sym_turn_on_debugging, SCM_EOL), tail);
721 }
722
224c49f9 723 {
97c524bd 724 SCM val = scm_cons (sym_begin, tail);
224c49f9 725
32ce4058
AW
726 /* Wrap the expression in a prompt. */
727 val = scm_list_2 (scm_list_3 (scm_sym_at,
728 scm_list_2 (scm_from_locale_symbol ("ice-9"),
729 scm_from_locale_symbol ("control")),
730 scm_from_locale_symbol ("%")),
731 val);
732
53e82297 733#if 0
224c49f9
JB
734 scm_write (val, SCM_UNDEFINED);
735 scm_newline (SCM_UNDEFINED);
ebe2a6c1 736#endif
224c49f9
JB
737
738 return val;
739 }
740}
741
742
743void
6e8d25a6 744scm_shell (int argc, char **argv)
224c49f9
JB
745{
746 /* If present, add SCSH-style meta-arguments from the top of the
747 script file to the argument vector. See the SCSH manual: "The
748 meta argument" for more details. */
749 {
750 char **new_argv = scm_get_meta_args (argc, argv);
751
752 if (new_argv)
753 {
754 argv = new_argv;
755 argc = scm_count_argv (new_argv);
756 }
757 }
758
b3138544 759 exit (scm_exit_status (scm_eval_x (scm_compile_shell_switches (argc, argv),
deec8fc2 760 scm_current_module ())));
224c49f9
JB
761}
762
763
764void
765scm_init_script ()
766{
a0599745 767#include "libguile/script.x"
224c49f9 768}
89e00824
ML
769
770/*
771 Local Variables:
772 c-file-style: "gnu"
773 End:
774*/