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 <stdio.h>
  26 #include <errno.h>
  27 #include <ctype.h>
  28
  29 #include <version-etc.h>
  30
  31 #include "libguile/_scm.h"
  32 #include "libguile/eval.h"
  33 #include "libguile/feature.h"
  34 #include "libguile/load.h"
  35 #include "libguile/private-gc.h" /* scm_getenv_int */
  36 #include "libguile/read.h"
  37 #include "libguile/script.h"
  38 #include "libguile/strings.h"
  39 #include "libguile/strports.h"
  40 #include "libguile/validate.h"
  41 #include "libguile/version.h"
  42
  43 #ifdef HAVE_STRING_H
  44 #include <string.h>
  45 #endif
  46
  47 #ifdef HAVE_UNISTD_H
  48 #include <unistd.h>             /* for X_OK define */
  49 #endif
  50
  51 #ifdef HAVE_IO_H
  52 #include <io.h>
  53 #endif
  54
  55 /* Concatentate str2 onto str1 at position n and return concatenated
  56    string if file exists; 0 otherwise. */
  57
  58 static char *
  59 scm_cat_path (char *str1, const char *str2, long n)
  60 {
  61   if (!n)
  62     n = strlen (str2);
  63   if (str1)
  64     {
  65       size_t len = strlen (str1);
  66       str1 = (char *) realloc (str1, (size_t) (len + n + 1));
  67       if (!str1)
  68         return 0L;
  69       strncat (str1 + len, str2, n);
  70       return str1;
  71     }
  72   str1 = (char *) scm_malloc ((size_t) (n + 1));
  73   if (!str1)
  74     return 0L;
  75   str1[0] = 0;
  76   strncat (str1, str2, n);
  77   return str1;
  78 }
  79
  80 #if 0
  81 static char *
  82 scm_try_path (char *path)
  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
  99 static char *
 100 scm_sep_init_try (char *path, const char *sep, const char *initname)
 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
 126 char *
 127 scm_find_executable (const char *name)
 128 {
 129   char tbuf[MAXPATHLEN];
 130   int i = 0, c;
 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)
 142         switch (c = fgetc (f))
 143           {
 144           case /*WHITE_SPACES */ ' ':
 145           case '\t':
 146           case '\r':
 147           case '\f':
 148           case EOF:
 149             tbuf[i] = 0;
 150             fclose (f);
 151             return scm_cat_path (0L, tbuf, 0L);
 152           default:
 153             tbuf[i++] = c;
 154             break;
 155           }
 156     }
 157   fclose (f);
 158   return scm_cat_path (0L, name, 0L);
 159 }
 160
 161
 162 /* Read a \nnn-style escape.  We've just read the backslash.  */
 163 static int
 164 script_get_octal (FILE *f)
 165 #define FUNC_NAME "script_get_octal"
 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
 176         SCM_MISC_ERROR ("malformed script: bad octal backslash escape",
 177                         SCM_EOL);
 178     }
 179   return value;
 180 }
 181 #undef FUNC_NAME
 182
 183
 184 static int
 185 script_get_backslash (FILE *f)
 186 #define FUNC_NAME "script_get_backslash"
 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);
 210
 211     case EOF:
 212       SCM_MISC_ERROR ("malformed script: backslash followed by EOF", SCM_EOL);
 213       return 0; /* not reached? */
 214
 215     default:
 216       SCM_MISC_ERROR ("malformed script: bad backslash sequence", SCM_EOL);
 217       return 0; /* not reached? */
 218     }
 219 }
 220 #undef FUNC_NAME
 221
 222
 223 static char *
 224 script_read_arg (FILE *f)
 225 #define FUNC_NAME "script_read_arg"
 226 {
 227   size_t size = 7;
 228   char *buf = scm_malloc (size + 1);
 229   size_t len = 0;
 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);
 272           SCM_MISC_ERROR ("malformed script: TAB in meta-arguments", SCM_EOL);
 273           return 0; /* not reached? */
 274         }
 275     }
 276 }
 277 #undef FUNC_NAME
 278
 279
 280 static int
 281 script_meta_arg_P (char *arg)
 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
 300 char **
 301 scm_get_meta_args (int argc, char **argv)
 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;
 307   if (!(nargv = (char **) scm_malloc ((1 + nargc) * sizeof (char *))))
 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
 342 int
 343 scm_count_argv (char **argv)
 344 {
 345   int argc = 0;
 346   while (argv[argc])
 347     argc++;
 348   return argc;
 349 }
 350
 351
 352 /* For use in error messages.  */
 353 char *scm_usage_name = 0;
 354
 355 void
 356 scm_shell_usage (int fatal, char *message)
 357 {
 358   FILE  *fp = (fatal ? stderr : stdout);
 359
 360   if (message)
 361     fprintf (fp, "%s\n", message);
 362
 363   fprintf (fp,
 364            "Usage: %s [OPTION]... [FILE]...\n"
 365            "Evaluate Scheme code, interactively or from a script.\n"
 366            "\n"
 367            "  [-s] FILE      load Scheme source code from FILE, and exit\n"
 368            "  -c EXPR        evalute Scheme expression EXPR, and exit\n"
 369            "  --             stop scanning arguments; run interactively\n\n"
 370            "The above switches stop argument processing, and pass all\n"
 371            "remaining arguments as the value of (command-line).\n"
 372            "If FILE begins with `-' the -s switch is mandatory.\n"
 373            "\n"
 374            "  -L DIRECTORY   add DIRECTORY to the front of the module load path\n"
 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"
 379            "  --debug        start with debugging evaluator and backtraces\n"
 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"
 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"
 387            "  -q             inhibit loading of user init file\n"
 388            "  --emacs        enable Emacs protocol (experimental)\n"
 389            "  --use-srfi=LS  load SRFI modules for the SRFIs in LS,\n"
 390            "                 which is a list of numbers like \"2,13,14\"\n"
 391            "  -h, --help     display this help and exit\n"
 392            "  -v, --version  display version information and exit\n"
 393            "  \\              read arguments from following script lines\n",
 394            scm_usage_name);
 395
 396   emit_bug_reporting_address ();
 397
 398   if (fatal)
 399     exit (fatal);
 400 }
 401
 402
 403 /* Some symbols used by the command-line compiler.  */
 404 SCM_SYMBOL (sym_load, "load");
 405 SCM_SYMBOL (sym_eval_string, "eval-string");
 406 SCM_SYMBOL (sym_command_line, "command-line");
 407 SCM_SYMBOL (sym_begin, "begin");
 408 SCM_SYMBOL (sym_turn_on_debugging, "turn-on-debugging");
 409 SCM_SYMBOL (sym_load_user_init, "load-user-init");
 410 SCM_SYMBOL (sym_top_repl, "top-repl");
 411 SCM_SYMBOL (sym_quit, "quit");
 412 SCM_SYMBOL (sym_use_srfis, "use-srfis");
 413 SCM_SYMBOL (sym_load_path, "%load-path");
 414 SCM_SYMBOL (sym_set_x, "set!");
 415 SCM_SYMBOL (sym_sys_load_should_autocompile, "%load-should-autocompile");
 416 SCM_SYMBOL (sym_cons, "cons");
 417 SCM_SYMBOL (sym_at, "@");
 418 SCM_SYMBOL (sym_atat, "@@");
 419 SCM_SYMBOL (sym_main, "main");
 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*
 428  */
 429
 430 static char guile[] = "guile";
 431
 432 static int
 433 all_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
 444 SCM
 445 scm_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 */
 454   SCM user_load_path = SCM_EOL; /* for -L switch */
 455   int interactive = 1;          /* Should we go interactive when done? */
 456   int inhibit_user_init = 0;    /* Don't load user init file */
 457   int use_emacs_interface = 0;
 458   int turn_on_debugging = 0;
 459   int dont_turn_on_debugging = 0;
 460
 461   int i;
 462   char *argv0 = guile;
 463
 464   if (argc > 0)
 465     {
 466       argv0 = argv[0];
 467       scm_usage_name = strrchr (argv[0], '/');
 468       if (! scm_usage_name)
 469         scm_usage_name = argv[0];
 470       else
 471         scm_usage_name++;
 472     }
 473   if (! scm_usage_name)
 474     scm_usage_name = guile;
 475
 476   for (i = 1; i < argc; i++)
 477     {
 478       if ((! strcmp (argv[i], "-s")) || (argv[i][0] != '-')) /* load script */
 479         {
 480           if ((argv[i][0] == '-') && (++i >= argc))
 481             scm_shell_usage (1, "missing argument to `-s' switch");
 482
 483           /* If we specified the -ds option, do_script points to the
 484              cdr of an expression like (load #f); we replace the car
 485              (i.e., the #f) with the script name.  */
 486           if (!scm_is_null (do_script))
 487             {
 488               SCM_SETCAR (do_script, scm_from_locale_string (argv[i]));
 489               do_script = SCM_EOL;
 490             }
 491           else
 492             /* Construct an application of LOAD to the script name.  */
 493             tail = scm_cons (scm_cons2 (sym_load,
 494                                         scm_from_locale_string (argv[i]),
 495                                         SCM_EOL),
 496                                tail);
 497           argv0 = argv[i];
 498           i++;
 499           interactive = 0;
 500           break;
 501         }
 502
 503       else if (! strcmp (argv[i], "-c")) /* evaluate expr */
 504         {
 505           if (++i >= argc)
 506             scm_shell_usage (1, "missing argument to `-c' switch");
 507           tail = scm_cons (scm_cons2 (sym_eval_string,
 508                                       scm_from_locale_string (argv[i]),
 509                                       SCM_EOL),
 510                            tail);
 511           i++;
 512           interactive = 0;
 513           break;
 514         }
 515
 516       else if (! strcmp (argv[i], "--")) /* end args; go interactive */
 517         {
 518           i++;
 519           break;
 520         }
 521
 522       else if (! strcmp (argv[i], "-l")) /* load a file */
 523         {
 524           if (++i < argc)
 525             tail = scm_cons (scm_cons2 (sym_load,
 526                                         scm_from_locale_string (argv[i]),
 527                                         SCM_EOL),
 528                              tail);
 529           else
 530             scm_shell_usage (1, "missing argument to `-l' switch");
 531         }
 532
 533       else if (! strcmp (argv[i], "-L")) /* add to %load-path */
 534         {
 535           if (++i < argc)
 536             user_load_path =
 537               scm_cons (scm_list_3 (sym_set_x,
 538                                     sym_load_path,
 539                                     scm_list_3 (sym_cons,
 540                                                 scm_from_locale_string (argv[i]),
 541                                                 sym_load_path)),
 542                         user_load_path);
 543           else
 544             scm_shell_usage (1, "missing argument to `-L' switch");
 545         }
 546
 547       else if (! strcmp (argv[i], "-e")) /* entry point */
 548         {
 549           if (++i < argc)
 550             {
 551               SCM port
 552                 = scm_open_input_string (scm_from_locale_string (argv[i]));
 553               SCM arg1 = scm_read (port);
 554               SCM arg2 = scm_read (port);
 555
 556               /* Recognize syntax of certain versions of Guile 1.4 and
 557                  transform to (@ MODULE-NAME FUNC).
 558                */
 559               if (scm_is_false (scm_eof_object_p (arg2)))
 560                 entry_point = scm_list_3 (sym_at, arg1, arg2);
 561               else if (scm_is_pair (arg1)
 562                        && !(scm_is_eq (SCM_CAR (arg1), sym_at)
 563                             || scm_is_eq (SCM_CAR (arg1), sym_atat))
 564                        && all_symbols (arg1))
 565                 entry_point = scm_list_3 (sym_at, arg1, sym_main);
 566               else
 567                 entry_point = arg1;
 568             }
 569           else
 570             scm_shell_usage (1, "missing argument to `-e' switch");
 571         }
 572
 573       else if (! strcmp (argv[i], "-ds")) /* do script here */
 574         {
 575           /* We put a dummy "load" expression, and let the -s put the
 576              filename in.  */
 577           if (!scm_is_null (do_script))
 578             scm_shell_usage (1, "the -ds switch may only be specified once");
 579           do_script = scm_cons (SCM_BOOL_F, SCM_EOL);
 580           tail = scm_cons (scm_cons (sym_load, do_script),
 581                            tail);
 582         }
 583
 584       else if (! strcmp (argv[i], "--debug"))
 585         {
 586           turn_on_debugging = 1;
 587           dont_turn_on_debugging = 0;
 588         }
 589
 590       else if (! strcmp (argv[i], "--no-debug"))
 591         {
 592           dont_turn_on_debugging = 1;
 593           turn_on_debugging = 0;
 594         }
 595
 596       /* Do autocompile on/off now, because the form itself might need this
 597          decision. */
 598       else if (! strcmp (argv[i], "--autocompile"))
 599         scm_variable_set_x (scm_c_lookup ("%load-should-autocompile"),
 600                             SCM_BOOL_T);
 601
 602       else if (! strcmp (argv[i], "--no-autocompile"))
 603         scm_variable_set_x (scm_c_lookup ("%load-should-autocompile"),
 604                             SCM_BOOL_F);
 605
 606       else if (! strcmp (argv[i], "--emacs")) /* use emacs protocol */
 607         use_emacs_interface = 1;
 608
 609       else if (! strcmp (argv[i], "-q")) /* don't load user init */
 610         inhibit_user_init = 1;
 611
 612       else if (! strncmp (argv[i], "--use-srfi=", 11)) /* load SRFIs */
 613         {
 614           SCM srfis = SCM_EOL;  /* List of requested SRFIs.  */
 615           char * p = argv[i] + 11;
 616           while (*p)
 617             {
 618               long num;
 619               char * end;
 620
 621               num = strtol (p, &end, 10);
 622               if (end - p > 0)
 623                 {
 624                   srfis = scm_cons (scm_from_long (num), srfis);
 625                   if (*end)
 626                     {
 627                       if (*end == ',')
 628                         p = end + 1;
 629                       else
 630                         scm_shell_usage (1, "invalid SRFI specification");
 631                     }
 632                   else
 633                     break;
 634                 }
 635               else
 636                 scm_shell_usage (1, "invalid SRFI specification");
 637             }
 638           if (scm_ilength (srfis) <= 0)
 639             scm_shell_usage (1, "invalid SRFI specification");
 640           srfis = scm_reverse_x (srfis, SCM_UNDEFINED);
 641           tail = scm_cons (scm_list_2 (sym_use_srfis,
 642                                        scm_list_2 (scm_sym_quote, srfis)),
 643                            tail);
 644         }
 645
 646       else if (! strcmp (argv[i], "-h")
 647                || ! strcmp (argv[i], "--help"))
 648         {
 649           scm_shell_usage (0, 0);
 650           exit (0);
 651         }
 652
 653       else if (! strcmp (argv[i], "-v")
 654                || ! strcmp (argv[i], "--version"))
 655         {
 656           /* Print version number.  */
 657           version_etc (stdout, scm_usage_name, PACKAGE_NAME, PACKAGE_VERSION,
 658                        /* XXX: Use gettext for the string below.  */
 659                        "the Guile developers", NULL);
 660           exit (0);
 661         }
 662
 663       else
 664         {
 665           fprintf (stderr, "%s: Unrecognized switch `%s'\n",
 666                    scm_usage_name, argv[i]);
 667           scm_shell_usage (1, 0);
 668         }
 669     }
 670
 671   /* Check to make sure the -ds got a -s. */
 672   if (!scm_is_null (do_script))
 673     scm_shell_usage (1, "the `-ds' switch requires the use of `-s' as well");
 674
 675   /* Make any remaining arguments available to the
 676      script/command/whatever.  */
 677   scm_set_program_arguments (argc ? argc - i : 0, argv + i, argv0);
 678
 679   /* If the --emacs switch was set, now is when we process it.  */
 680   scm_c_define ("use-emacs-interface", scm_from_bool (use_emacs_interface));
 681
 682   /* Handle the `-e' switch, if it was specified.  */
 683   if (!scm_is_null (entry_point))
 684     tail = scm_cons (scm_cons2 (entry_point,
 685                                 scm_cons (sym_command_line, SCM_EOL),
 686                                 SCM_EOL),
 687                        tail);
 688
 689   /* If we didn't end with a -c or a -s, start the repl.  */
 690   if (interactive)
 691     {
 692       tail = scm_cons (scm_cons (sym_top_repl, SCM_EOL), tail);
 693     }
 694   else
 695     {
 696       /* After doing all the other actions prescribed by the command line,
 697          quit.  */
 698       tail = scm_cons (scm_cons (sym_quit, SCM_EOL),
 699                        tail);
 700     }
 701
 702   /* After the following line, actions will be added to the front. */
 703   tail = scm_reverse_x (tail, SCM_UNDEFINED);
 704
 705   /* add the user-specified load path here, so it won't be in effect
 706      during the loading of the user's customization file. */
 707   if(!scm_is_null(user_load_path))
 708     {
 709       tail = scm_append_x( scm_cons2(user_load_path, tail, SCM_EOL) );
 710     }
 711
 712   /* If we didn't end with a -c or a -s and didn't supply a -q, load
 713      the user's customization file.  */
 714   if (interactive && !inhibit_user_init)
 715     {
 716       tail = scm_cons (scm_cons (sym_load_user_init, SCM_EOL), tail);
 717     }
 718
 719   /* If debugging was requested, or we are interactive and debugging
 720      was not explicitly turned off, turn on debugging. */
 721   if (turn_on_debugging || (interactive && !dont_turn_on_debugging))
 722     {
 723       tail = scm_cons (scm_cons (sym_turn_on_debugging, SCM_EOL), tail);
 724     }
 725
 726   {
 727     SCM val = scm_cons (sym_begin, tail);
 728
 729     /* Wrap the expression in a prompt. */
 730     val = scm_list_2 (scm_list_3 (scm_sym_at,
 731                                       scm_list_2 (scm_from_locale_symbol ("ice-9"),
 732                                                   scm_from_locale_symbol ("control")),
 733                                       scm_from_locale_symbol ("%")),
 734                       val);
 735
 736 #if 0
 737     scm_write (val, SCM_UNDEFINED);
 738     scm_newline (SCM_UNDEFINED);
 739 #endif
 740
 741     return val;
 742   }
 743 }
 744
 745
 746 void
 747 scm_shell (int argc, char **argv)
 748 {
 749   /* If present, add SCSH-style meta-arguments from the top of the
 750      script file to the argument vector.  See the SCSH manual: "The
 751      meta argument" for more details.  */
 752   {
 753     char **new_argv = scm_get_meta_args (argc, argv);
 754
 755     if (new_argv)
 756       {
 757         argv = new_argv;
 758         argc = scm_count_argv (new_argv);
 759       }
 760   }
 761
 762   exit (scm_exit_status (scm_eval_x (scm_compile_shell_switches (argc, argv),
 763                                      scm_current_module ())));
 764 }
 765
 766
 767 void
 768 scm_init_script ()
 769 {
 770 #include "libguile/script.x"
 771 }
 772
 773 /*
 774   Local Variables:
 775   c-file-style: "gnu"
 776   End:
 777 */