libguile/script.c

   1 /* Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   2  * This library is free software; you can redistribute it and/or
   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.
   6  *
   7  * This library is distributed in the hope that it will be useful, but
   8  * WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  10  * Lesser General Public License for more details.
  11  *
  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
  14  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  15  * 02110-1301 USA
  16  */
  17
  18 /* "script.c" argv tricks for `#!' scripts.
  19    Authors: Aubrey Jaffer and Jim Blandy */
  20
  21 #ifdef HAVE_CONFIG_H
  22 #  include <config.h>
  23 #endif
  24
  25 #include <stdlib.h>
  26 #include <stdio.h>
  27 #include <errno.h>
  28 #include <ctype.h>
  29
  30 #include <version-etc.h>
  31
  32 #include "libguile/_scm.h"
  33 #include "libguile/eval.h"
  34 #include "libguile/feature.h"
  35 #include "libguile/load.h"
  36 #include "libguile/private-gc.h" /* scm_getenv_int */
  37 #include "libguile/read.h"
  38 #include "libguile/script.h"
  39 #include "libguile/strings.h"
  40 #include "libguile/strports.h"
  41 #include "libguile/validate.h"
  42 #include "libguile/version.h"
  43 #include "libguile/vm.h"
  44
  45 #ifdef HAVE_STRING_H
  46 #include <string.h>
  47 #endif
  48
  49 #ifdef HAVE_UNISTD_H
  50 #include <unistd.h>             /* for X_OK define */
  51 #endif
  52
  53 #ifdef HAVE_IO_H
  54 #include <io.h>
  55 #endif
  56
  57 /* Concatentate str2 onto str1 at position n and return concatenated
  58    string if file exists; 0 otherwise. */
  59
  60 static char *
  61 scm_cat_path (char *str1, const char *str2, long n)
  62 {
  63   if (!n)
  64     n = strlen (str2);
  65   if (str1)
  66     {
  67       size_t len = strlen (str1);
  68       str1 = (char *) realloc (str1, (size_t) (len + n + 1));
  69       if (!str1)
  70         return 0L;
  71       strncat (str1 + len, str2, n);
  72       return str1;
  73     }
  74   str1 = (char *) scm_malloc ((size_t) (n + 1));
  75   if (!str1)
  76     return 0L;
  77   str1[0] = 0;
  78   strncat (str1, str2, n);
  79   return str1;
  80 }
  81
  82 #if 0
  83 static char *
  84 scm_try_path (char *path)
  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
 101 static char *
 102 scm_sep_init_try (char *path, const char *sep, const char *initname)
 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
 128 char *
 129 scm_find_executable (const char *name)
 130 {
 131   char tbuf[MAXPATHLEN];
 132   int i = 0, c;
 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)
 144         switch (c = fgetc (f))
 145           {
 146           case /*WHITE_SPACES */ ' ':
 147           case '\t':
 148           case '\r':
 149           case '\f':
 150           case EOF:
 151             tbuf[i] = 0;
 152             fclose (f);
 153             return scm_cat_path (0L, tbuf, 0L);
 154           default:
 155             tbuf[i++] = c;
 156             break;
 157           }
 158     }
 159   fclose (f);
 160   return scm_cat_path (0L, name, 0L);
 161 }
 162
 163
 164 /* Read a \nnn-style escape.  We've just read the backslash.  */
 165 static int
 166 script_get_octal (FILE *f)
 167 #define FUNC_NAME "script_get_octal"
 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
 178         SCM_MISC_ERROR ("malformed script: bad octal backslash escape",
 179                         SCM_EOL);
 180     }
 181   return value;
 182 }
 183 #undef FUNC_NAME
 184
 185
 186 static int
 187 script_get_backslash (FILE *f)
 188 #define FUNC_NAME "script_get_backslash"
 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);
 212
 213     case EOF:
 214       SCM_MISC_ERROR ("malformed script: backslash followed by EOF", SCM_EOL);
 215       return 0; /* not reached? */
 216
 217     default:
 218       SCM_MISC_ERROR ("malformed script: bad backslash sequence", SCM_EOL);
 219       return 0; /* not reached? */
 220     }
 221 }
 222 #undef FUNC_NAME
 223
 224
 225 static char *
 226 script_read_arg (FILE *f)
 227 #define FUNC_NAME "script_read_arg"
 228 {
 229   size_t size = 7;
 230   char *buf = scm_malloc (size + 1);
 231   size_t len = 0;
 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);
 274           SCM_MISC_ERROR ("malformed script: TAB in meta-arguments", SCM_EOL);
 275           return 0; /* not reached? */
 276         }
 277     }
 278 }
 279 #undef FUNC_NAME
 280
 281
 282 static int
 283 script_meta_arg_P (char *arg)
 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
 302 char **
 303 scm_get_meta_args (int argc, char **argv)
 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;
 309   if (!(nargv = (char **) scm_malloc ((1 + nargc) * sizeof (char *))))
 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
 344 int
 345 scm_count_argv (char **argv)
 346 {
 347   int argc = 0;
 348   while (argv[argc])
 349     argc++;
 350   return argc;
 351 }
 352
 353
 354 /* For use in error messages.  */
 355 char *scm_usage_name = 0;
 356
 357 void
 358 scm_shell_usage (int fatal, char *message)
 359 {
 360   FILE  *fp = (fatal ? stderr : stdout);
 361
 362   if (message)
 363     fprintf (fp, "%s\n", message);
 364
 365   fprintf (fp,
 366            "Usage: %s [OPTION]... [FILE]...\n"
 367            "Evaluate Scheme code, interactively or from a script.\n"
 368            "\n"
 369            "  [-s] FILE      load Scheme source code from FILE, and exit\n"
 370            "  -c EXPR        evalute Scheme expression EXPR, and exit\n"
 371            "  --             stop scanning arguments; run interactively\n\n"
 372            "The above switches stop argument processing, and pass all\n"
 373            "remaining arguments as the value of (command-line).\n"
 374            "If FILE begins with `-' the -s switch is mandatory.\n"
 375            "\n"
 376            "  -L DIRECTORY   add DIRECTORY to the front of the module load path\n"
 377            "  -x EXTENSION   add EXTENSION to the front of the load extensions\n"
 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"
 382            "  --debug        start with debugging evaluator and backtraces\n"
 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"
 386            "  --autocompile  compile source files automatically\n"
 387            "  --no-autocompile  disable automatic source file compilation\n"
 388            "                 Default is to enable autocompilation of source\n"
 389            "                 files.\n"
 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"
 392            "  -q             inhibit loading of user init file\n"
 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"
 395            "  -h, --help     display this help and exit\n"
 396            "  -v, --version  display version information and exit\n"
 397            "  \\              read arguments from following script lines\n",
 398            scm_usage_name);
 399
 400   emit_bug_reporting_address ();
 401
 402   if (fatal)
 403     exit (fatal);
 404 }
 405
 406
 407 /* Some symbols used by the command-line compiler.  */
 408 SCM_SYMBOL (sym_load, "load");
 409 SCM_SYMBOL (sym_eval_string, "eval-string");
 410 SCM_SYMBOL (sym_command_line, "command-line");
 411 SCM_SYMBOL (sym_begin, "begin");
 412 SCM_SYMBOL (sym_load_user_init, "load-user-init");
 413 SCM_SYMBOL (sym_ice_9, "ice-9");
 414 SCM_SYMBOL (sym_top_repl, "top-repl");
 415 SCM_SYMBOL (sym_quit, "quit");
 416 SCM_SYMBOL (sym_use_srfis, "use-srfis");
 417 SCM_SYMBOL (sym_load_path, "%load-path");
 418 SCM_SYMBOL (sym_load_extensions, "%load-extensions");
 419 SCM_SYMBOL (sym_set_x, "set!");
 420 SCM_SYMBOL (sym_sys_load_should_autocompile, "%load-should-autocompile");
 421 SCM_SYMBOL (sym_cons, "cons");
 422 SCM_SYMBOL (sym_at, "@");
 423 SCM_SYMBOL (sym_atat, "@@");
 424 SCM_SYMBOL (sym_main, "main");
 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*
 433  */
 434
 435 static char guile[] = "guile";
 436
 437 static int
 438 all_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
 449 SCM
 450 scm_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 */
 459   SCM user_load_path = SCM_EOL; /* for -L switch */
 460   SCM user_extensions = SCM_EOL;/* for -x switch */
 461   int interactive = 1;          /* Should we go interactive when done? */
 462   int inhibit_user_init = 0;    /* Don't load user init file */
 463   int turn_on_debugging = 0;
 464   int dont_turn_on_debugging = 0;
 465
 466   int i;
 467   char *argv0 = guile;
 468
 469   if (argc > 0)
 470     {
 471       argv0 = argv[0];
 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)
 479     scm_usage_name = guile;
 480
 481   for (i = 1; i < argc; i++)
 482     {
 483       if ((! strcmp (argv[i], "-s")) || (argv[i][0] != '-')) /* load script */
 484         {
 485           if ((argv[i][0] == '-') && (++i >= argc))
 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.  */
 491           if (!scm_is_null (do_script))
 492             {
 493               SCM_SETCAR (do_script, scm_from_locale_string (argv[i]));
 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,
 499                                         scm_from_locale_string (argv[i]),
 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,
 513                                       scm_from_locale_string (argv[i]),
 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,
 531                                         scm_from_locale_string (argv[i]),
 532                                         SCM_EOL),
 533                              tail);
 534           else
 535             scm_shell_usage (1, "missing argument to `-l' switch");
 536         }
 537
 538       else if (! strcmp (argv[i], "-L")) /* add to %load-path */
 539         {
 540           if (++i < argc)
 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);
 548           else
 549             scm_shell_usage (1, "missing argument to `-L' switch");
 550         }
 551
 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
 566       else if (! strcmp (argv[i], "-e")) /* entry point */
 567         {
 568           if (++i < argc)
 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             }
 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.  */
 596           if (!scm_is_null (do_script))
 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
 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"))
 610         {
 611           dont_turn_on_debugging = 1;
 612           turn_on_debugging = 0;
 613         }
 614
 615       /* Do autocompile on/off now, because the form itself might need this
 616          decision. */
 617       else if (! strcmp (argv[i], "--autocompile"))
 618         scm_variable_set_x (scm_c_lookup ("%load-should-autocompile"),
 619                             SCM_BOOL_T);
 620
 621       else if (! strcmp (argv[i], "--no-autocompile"))
 622         scm_variable_set_x (scm_c_lookup ("%load-should-autocompile"),
 623                             SCM_BOOL_F);
 624
 625       else if (! strcmp (argv[i], "-q")) /* don't load user init */
 626         inhibit_user_init = 1;
 627
 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                 {
 640                   srfis = scm_cons (scm_from_long (num), srfis);
 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);
 657           tail = scm_cons (scm_list_2 (sym_use_srfis,
 658                                        scm_list_2 (scm_sym_quote, srfis)),
 659                            tail);
 660         }
 661
 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
 716       else if (! strcmp (argv[i], "-h")
 717                || ! strcmp (argv[i], "--help"))
 718         {
 719           scm_shell_usage (0, 0);
 720           exit (EXIT_SUCCESS);
 721         }
 722
 723       else if (! strcmp (argv[i], "-v")
 724                || ! strcmp (argv[i], "--version"))
 725         {
 726           /* Print version number.  */
 727           version_etc (stdout, scm_usage_name, PACKAGE_NAME, PACKAGE_VERSION,
 728                        /* XXX: Use gettext for the string below.  */
 729                        "the Guile developers", NULL);
 730           exit (EXIT_SUCCESS);
 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. */
 742   if (!scm_is_null (do_script))
 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.  */
 747   scm_set_program_arguments (argc ? argc - i : 0, argv + i, argv0);
 748
 749   /* Handle the `-e' switch, if it was specified.  */
 750   if (!scm_is_null (entry_point))
 751     tail = scm_cons (scm_cons2 (entry_point,
 752                                 scm_cons (sym_command_line, SCM_EOL),
 753                                 SCM_EOL),
 754                        tail);
 755
 756   /* If we didn't end with a -c or a -s, start the repl.  */
 757   if (interactive)
 758     {
 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);
 764     }
 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),
 770                        tail);
 771     }
 772
 773   /* After the following line, actions will be added to the front. */
 774   tail = scm_reverse_x (tail, SCM_UNDEFINED);
 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. */
 778   if(!scm_is_null(user_load_path))
 779     {
 780       tail = scm_append_x( scm_cons2(user_load_path, tail, SCM_EOL) );
 781     }
 782
 783   if (!scm_is_null (user_extensions))
 784     tail = scm_append_x (scm_cons2 (user_extensions, tail, SCM_EOL));
 785
 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
 793   /* If debugging was requested, or we are interactive and debugging
 794      was not explicitly turned off, use the debug engine. */
 795   if (turn_on_debugging || (interactive && !dont_turn_on_debugging))
 796     {
 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);
 799     }
 800
 801   {
 802     SCM val = scm_cons (sym_begin, tail);
 803
 804     /* Wrap the expression in a prompt. */
 805     val = scm_list_2 (scm_list_3 (scm_sym_at,
 806                                       scm_list_2 (scm_from_locale_symbol ("ice-9"),
 807                                                   scm_from_locale_symbol ("control")),
 808                                       scm_from_locale_symbol ("%")),
 809                       val);
 810
 811 #if 0
 812     scm_write (val, SCM_UNDEFINED);
 813     scm_newline (SCM_UNDEFINED);
 814 #endif
 815
 816     return val;
 817   }
 818 }
 819
 820
 821 void
 822 scm_shell (int argc, char **argv)
 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
 837   exit (scm_exit_status (scm_eval_x (scm_compile_shell_switches (argc, argv),
 838                                      scm_current_module ())));
 839 }
 840
 841
 842 void
 843 scm_init_script ()
 844 {
 845 #include "libguile/script.x"
 846 }
 847
 848 /*
 849   Local Variables:
 850   c-file-style: "gnu"
 851   End:
 852 */