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