libguile/script.c

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