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
  44 #ifdef HAVE_STRING_H
  45 #include <string.h>
  46 #endif
  47
  48 #ifdef HAVE_UNISTD_H
  49 #include <unistd.h>             /* for X_OK define */
  50 #endif
  51
  52 #ifdef HAVE_IO_H
  53 #include <io.h>
  54 #endif
  55
  56 /* Concatentate str2 onto str1 at position n and return concatenated
  57    string if file exists; 0 otherwise. */
  58
  59 static char *
  60 scm_cat_path (char *str1, const char *str2, long n)
  61 {
  62   if (!n)
  63     n = strlen (str2);
  64   if (str1)
  65     {
  66       size_t len = strlen (str1);
  67       str1 = (char *) realloc (str1, (size_t) (len + n + 1));
  68       if (!str1)
  69         return 0L;
  70       strncat (str1 + len, str2, n);
  71       return str1;
  72     }
  73   str1 = (char *) scm_malloc ((size_t) (n + 1));
  74   if (!str1)
  75     return 0L;
  76   str1[0] = 0;
  77   strncat (str1, str2, n);
  78   return str1;
  79 }
  80
  81 #if 0
  82 static char *
  83 scm_try_path (char *path)
  84 {
  85   FILE *f;
  86   /* fprintf(stderr, "Trying %s\n", path);fflush(stderr); */
  87   if (!path)
  88     return 0L;
  89   SCM_SYSCALL (f = fopen (path, "r");
  90     );
  91   if (f)
  92     {
  93       fclose (f);
  94       return path;
  95     }
  96   free (path);
  97   return 0L;
  98 }
  99
 100 static char *
 101 scm_sep_init_try (char *path, const char *sep, const char *initname)
 102 {
 103   if (path)
 104     path = scm_cat_path (path, sep, 0L);
 105   if (path)
 106     path = scm_cat_path (path, initname, 0L);
 107   return scm_try_path (path);
 108 }
 109 #endif
 110
 111 #ifndef LINE_INCREMENTORS
 112 #define LINE_INCREMENTORS  '\n'
 113 #ifdef MSDOS
 114 #define WHITE_SPACES  ' ':case '\t':case '\r':case '\f':case 26
 115 #else
 116 #define WHITE_SPACES  ' ':case '\t':case '\r':case '\f'
 117 #endif /* def MSDOS */
 118 #endif /* ndef LINE_INCREMENTORS */
 119
 120 #ifndef MAXPATHLEN
 121 #define MAXPATHLEN 80
 122 #endif /* ndef MAXPATHLEN */
 123 #ifndef X_OK
 124 #define X_OK 1
 125 #endif /* ndef X_OK */
 126
 127 char *
 128 scm_find_executable (const char *name)
 129 {
 130   char tbuf[MAXPATHLEN];
 131   int i = 0, c;
 132   FILE *f;
 133
 134   /* fprintf(stderr, "s_f_e checking access %s ->%d\n", name, access(name, X_OK)); fflush(stderr); */
 135   if (access (name, X_OK))
 136     return 0L;
 137   f = fopen (name, "r");
 138   if (!f)
 139     return 0L;
 140   if ((fgetc (f) == '#') && (fgetc (f) == '!'))
 141     {
 142       while (1)
 143         switch (c = fgetc (f))
 144           {
 145           case /*WHITE_SPACES */ ' ':
 146           case '\t':
 147           case '\r':
 148           case '\f':
 149           case EOF:
 150             tbuf[i] = 0;
 151             fclose (f);
 152             return scm_cat_path (0L, tbuf, 0L);
 153           default:
 154             tbuf[i++] = c;
 155             break;
 156           }
 157     }
 158   fclose (f);
 159   return scm_cat_path (0L, name, 0L);
 160 }
 161
 162
 163 /* Read a \nnn-style escape.  We've just read the backslash.  */
 164 static int
 165 script_get_octal (FILE *f)
 166 #define FUNC_NAME "script_get_octal"
 167 {
 168   int i;
 169   int value = 0;
 170
 171   for (i = 0; i < 3; i++)
 172     {
 173       int c = getc (f);
 174       if ('0' <= c && c <= '7')
 175         value = (value * 8) + (c - '0');
 176       else
 177         SCM_MISC_ERROR ("malformed script: bad octal backslash escape",
 178                         SCM_EOL);
 179     }
 180   return value;
 181 }
 182 #undef FUNC_NAME
 183
 184
 185 static int
 186 script_get_backslash (FILE *f)
 187 #define FUNC_NAME "script_get_backslash"
 188 {
 189   int c = getc (f);
 190
 191   switch (c)
 192     {
 193     case 'a': return '\a';
 194     case 'b': return '\b';
 195     case 'f': return '\f';
 196     case 'n': return '\n';
 197     case 'r': return '\r';
 198     case 't': return '\t';
 199     case 'v': return '\v';
 200
 201     case '\\':
 202     case ' ':
 203     case '\t':
 204     case '\n':
 205       return c;
 206
 207     case '0': case '1': case '2': case '3':
 208     case '4': case '5': case '6': case '7':
 209       ungetc (c, f);
 210       return script_get_octal (f);
 211
 212     case EOF:
 213       SCM_MISC_ERROR ("malformed script: backslash followed by EOF", SCM_EOL);
 214       return 0; /* not reached? */
 215
 216     default:
 217       SCM_MISC_ERROR ("malformed script: bad backslash sequence", SCM_EOL);
 218       return 0; /* not reached? */
 219     }
 220 }
 221 #undef FUNC_NAME
 222
 223
 224 static char *
 225 script_read_arg (FILE *f)
 226 #define FUNC_NAME "script_read_arg"
 227 {
 228   size_t size = 7;
 229   char *buf = scm_malloc (size + 1);
 230   size_t len = 0;
 231
 232   if (! buf)
 233     return 0;
 234
 235   for (;;)
 236     {
 237       int c = getc (f);
 238       switch (c)
 239         {
 240         case '\\':
 241           c = script_get_backslash (f);
 242           /* The above produces a new character to add to the argument.
 243              Fall through.  */
 244         default:
 245           if (len >= size)
 246             {
 247               size = (size + 1) * 2;
 248               buf = realloc (buf, size);
 249               if (! buf)
 250                 return 0;
 251             }
 252           buf[len++] = c;
 253           break;
 254
 255         case '\n':
 256           /* This may terminate an arg now, but it will terminate the
 257              entire list next time through.  */
 258           ungetc ('\n', f);
 259         case EOF:
 260           if (len == 0)
 261             {
 262               free (buf);
 263               return 0;
 264             }
 265           /* Otherwise, those characters terminate the argument; fall
 266              through.  */
 267         case ' ':
 268           buf[len] = '\0';
 269           return buf;
 270
 271         case '\t':
 272           free (buf);
 273           SCM_MISC_ERROR ("malformed script: TAB in meta-arguments", SCM_EOL);
 274           return 0; /* not reached? */
 275         }
 276     }
 277 }
 278 #undef FUNC_NAME
 279
 280
 281 static int
 282 script_meta_arg_P (char *arg)
 283 {
 284   if ('\\' != arg[0])
 285     return 0L;
 286 #ifdef MSDOS
 287   return !arg[1];
 288 #else
 289   switch (arg[1])
 290     {
 291     case 0:
 292     case '%':
 293     case WHITE_SPACES:
 294       return !0;
 295     default:
 296       return 0L;
 297     }
 298 #endif
 299 }
 300
 301 char **
 302 scm_get_meta_args (int argc, char **argv)
 303 {
 304   int nargc = argc, argi = 1, nargi = 1;
 305   char *narg, **nargv;
 306   if (!(argc > 2 && script_meta_arg_P (argv[1])))
 307     return 0L;
 308   if (!(nargv = (char **) scm_malloc ((1 + nargc) * sizeof (char *))))
 309       return 0L;
 310   nargv[0] = argv[0];
 311   while (((argi + 1) < argc) && (script_meta_arg_P (argv[argi])))
 312     {
 313       FILE *f = fopen (argv[++argi], "r");
 314       if (f)
 315         {
 316           nargc--;              /* to compensate for replacement of '\\' */
 317           while (1)
 318             switch (getc (f))
 319               {
 320               case EOF:
 321                 return 0L;
 322               default:
 323                 continue;
 324               case '\n':
 325                 goto found_args;
 326               }
 327         found_args:
 328           while ((narg = script_read_arg (f)))
 329             if (!(nargv = (char **) realloc (nargv,
 330                                              (1 + ++nargc) * sizeof (char *))))
 331                 return 0L;
 332             else
 333               nargv[nargi++] = narg;
 334           fclose (f);
 335           nargv[nargi++] = argv[argi++];
 336         }
 337     }
 338   while (argi <= argc)
 339     nargv[nargi++] = argv[argi++];
 340   return nargv;
 341 }
 342
 343 int
 344 scm_count_argv (char **argv)
 345 {
 346   int argc = 0;
 347   while (argv[argc])
 348     argc++;
 349   return argc;
 350 }
 351
 352
 353 /* For use in error messages.  */
 354 char *scm_usage_name = 0;
 355
 356 void
 357 scm_shell_usage (int fatal, char *message)
 358 {
 359   FILE  *fp = (fatal ? stderr : stdout);
 360
 361   if (message)
 362     fprintf (fp, "%s\n", message);
 363
 364   fprintf (fp,
 365            "Usage: %s [OPTION]... [FILE]...\n"
 366            "Evaluate Scheme code, interactively or from a script.\n"
 367            "\n"
 368            "  [-s] FILE      load Scheme source code from FILE, and exit\n"
 369            "  -c EXPR        evalute Scheme expression EXPR, and exit\n"
 370            "  --             stop scanning arguments; run interactively\n\n"
 371            "The above switches stop argument processing, and pass all\n"
 372            "remaining arguments as the value of (command-line).\n"
 373            "If FILE begins with `-' the -s switch is mandatory.\n"
 374            "\n"
 375            "  -L DIRECTORY   add DIRECTORY to the front of the module load path\n"
 376            "  -l FILE        load Scheme source code from FILE\n"
 377            "  -e FUNCTION    after reading script, apply FUNCTION to\n"
 378            "                 command line arguments\n"
 379            "  -ds            do -s script at this point\n"
 380            "  --debug        start with debugging evaluator and backtraces\n"
 381            "  --no-debug     start with normal evaluator\n"
 382            "                 Default is to enable debugging for interactive\n"
 383            "                 use, but not for `-s' and `-c'.\n"
 384            "  --autocompile  compile source files automatically\n"
 385            "  --no-autocompile  disable automatic source file compilation\n"
 386            "                 Default is to enable autocompilation of source\n"
 387            "                 files.\n"
 388            "  -q             inhibit loading of user init file\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_ice_9, "ice-9");
 411 SCM_SYMBOL (sym_top_repl, "top-repl");
 412 SCM_SYMBOL (sym_quit, "quit");
 413 SCM_SYMBOL (sym_use_srfis, "use-srfis");
 414 SCM_SYMBOL (sym_load_path, "%load-path");
 415 SCM_SYMBOL (sym_set_x, "set!");
 416 SCM_SYMBOL (sym_sys_load_should_autocompile, "%load-should-autocompile");
 417 SCM_SYMBOL (sym_cons, "cons");
 418 SCM_SYMBOL (sym_at, "@");
 419 SCM_SYMBOL (sym_atat, "@@");
 420 SCM_SYMBOL (sym_main, "main");
 421
 422 /* Given an array of command-line switches, return a Scheme expression
 423    to carry out the actions specified by the switches.
 424
 425    If you told me this should have been written in Scheme, I'd
 426    probably agree.  I'd say I didn't feel comfortable doing that in
 427    the present system.  You'd say, well, fix the system so you are
 428    comfortable doing that.  I'd agree again.  *shrug*
 429  */
 430
 431 static char guile[] = "guile";
 432
 433 static int
 434 all_symbols (SCM list)
 435 {
 436   while (scm_is_pair (list))
 437     {
 438       if (!scm_is_symbol (SCM_CAR (list)))
 439         return 0;
 440       list = SCM_CDR (list);
 441     }
 442   return 1;
 443 }
 444
 445 SCM
 446 scm_compile_shell_switches (int argc, char **argv)
 447 {
 448   SCM tail = SCM_EOL;           /* We accumulate the list backwards,
 449                                    and then reverse! it before we
 450                                    return it.  */
 451   SCM do_script = SCM_EOL;      /* The element of the list containing
 452                                    the "load" command, in case we get
 453                                    the "-ds" switch.  */
 454   SCM entry_point = SCM_EOL;    /* for -e switch */
 455   SCM user_load_path = SCM_EOL; /* for -L switch */
 456   int interactive = 1;          /* Should we go interactive when done? */
 457   int inhibit_user_init = 0;    /* Don't load user init file */
 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], "-q")) /* don't load user init */
 607         inhibit_user_init = 1;
 608
 609       else if (! strncmp (argv[i], "--use-srfi=", 11)) /* load SRFIs */
 610         {
 611           SCM srfis = SCM_EOL;  /* List of requested SRFIs.  */
 612           char * p = argv[i] + 11;
 613           while (*p)
 614             {
 615               long num;
 616               char * end;
 617
 618               num = strtol (p, &end, 10);
 619               if (end - p > 0)
 620                 {
 621                   srfis = scm_cons (scm_from_long (num), srfis);
 622                   if (*end)
 623                     {
 624                       if (*end == ',')
 625                         p = end + 1;
 626                       else
 627                         scm_shell_usage (1, "invalid SRFI specification");
 628                     }
 629                   else
 630                     break;
 631                 }
 632               else
 633                 scm_shell_usage (1, "invalid SRFI specification");
 634             }
 635           if (scm_ilength (srfis) <= 0)
 636             scm_shell_usage (1, "invalid SRFI specification");
 637           srfis = scm_reverse_x (srfis, SCM_UNDEFINED);
 638           tail = scm_cons (scm_list_2 (sym_use_srfis,
 639                                        scm_list_2 (scm_sym_quote, srfis)),
 640                            tail);
 641         }
 642
 643       else if (! strcmp (argv[i], "-h")
 644                || ! strcmp (argv[i], "--help"))
 645         {
 646           scm_shell_usage (0, 0);
 647           exit (EXIT_SUCCESS);
 648         }
 649
 650       else if (! strcmp (argv[i], "-v")
 651                || ! strcmp (argv[i], "--version"))
 652         {
 653           /* Print version number.  */
 654           version_etc (stdout, scm_usage_name, PACKAGE_NAME, PACKAGE_VERSION,
 655                        /* XXX: Use gettext for the string below.  */
 656                        "the Guile developers", NULL);
 657           exit (EXIT_SUCCESS);
 658         }
 659
 660       else
 661         {
 662           fprintf (stderr, "%s: Unrecognized switch `%s'\n",
 663                    scm_usage_name, argv[i]);
 664           scm_shell_usage (1, 0);
 665         }
 666     }
 667
 668   /* Check to make sure the -ds got a -s. */
 669   if (!scm_is_null (do_script))
 670     scm_shell_usage (1, "the `-ds' switch requires the use of `-s' as well");
 671
 672   /* Make any remaining arguments available to the
 673      script/command/whatever.  */
 674   scm_set_program_arguments (argc ? argc - i : 0, argv + i, argv0);
 675
 676   /* Handle the `-e' switch, if it was specified.  */
 677   if (!scm_is_null (entry_point))
 678     tail = scm_cons (scm_cons2 (entry_point,
 679                                 scm_cons (sym_command_line, SCM_EOL),
 680                                 SCM_EOL),
 681                        tail);
 682
 683   /* If we didn't end with a -c or a -s, start the repl.  */
 684   if (interactive)
 685     {
 686       tail = scm_cons (scm_list_1 (scm_list_3
 687                                    (sym_at,
 688                                     scm_list_2 (sym_ice_9, sym_top_repl),
 689                                     sym_top_repl)),
 690                        tail);
 691     }
 692   else
 693     {
 694       /* After doing all the other actions prescribed by the command line,
 695          quit.  */
 696       tail = scm_cons (scm_cons (sym_quit, SCM_EOL),
 697                        tail);
 698     }
 699
 700   /* After the following line, actions will be added to the front. */
 701   tail = scm_reverse_x (tail, SCM_UNDEFINED);
 702
 703   /* add the user-specified load path here, so it won't be in effect
 704      during the loading of the user's customization file. */
 705   if(!scm_is_null(user_load_path))
 706     {
 707       tail = scm_append_x( scm_cons2(user_load_path, tail, SCM_EOL) );
 708     }
 709
 710   /* If we didn't end with a -c or a -s and didn't supply a -q, load
 711      the user's customization file.  */
 712   if (interactive && !inhibit_user_init)
 713     {
 714       tail = scm_cons (scm_cons (sym_load_user_init, SCM_EOL), tail);
 715     }
 716
 717   /* If debugging was requested, or we are interactive and debugging
 718      was not explicitly turned off, turn on debugging. */
 719   if (turn_on_debugging || (interactive && !dont_turn_on_debugging))
 720     {
 721       tail = scm_cons (scm_cons (sym_turn_on_debugging, SCM_EOL), tail);
 722     }
 723
 724   {
 725     SCM val = scm_cons (sym_begin, tail);
 726
 727     /* Wrap the expression in a prompt. */
 728     val = scm_list_2 (scm_list_3 (scm_sym_at,
 729                                       scm_list_2 (scm_from_locale_symbol ("ice-9"),
 730                                                   scm_from_locale_symbol ("control")),
 731                                       scm_from_locale_symbol ("%")),
 732                       val);
 733
 734 #if 0
 735     scm_write (val, SCM_UNDEFINED);
 736     scm_newline (SCM_UNDEFINED);
 737 #endif
 738
 739     return val;
 740   }
 741 }
 742
 743
 744 void
 745 scm_shell (int argc, char **argv)
 746 {
 747   /* If present, add SCSH-style meta-arguments from the top of the
 748      script file to the argument vector.  See the SCSH manual: "The
 749      meta argument" for more details.  */
 750   {
 751     char **new_argv = scm_get_meta_args (argc, argv);
 752
 753     if (new_argv)
 754       {
 755         argv = new_argv;
 756         argc = scm_count_argv (new_argv);
 757       }
 758   }
 759
 760   exit (scm_exit_status (scm_eval_x (scm_compile_shell_switches (argc, argv),
 761                                      scm_current_module ())));
 762 }
 763
 764
 765 void
 766 scm_init_script ()
 767 {
 768 #include "libguile/script.x"
 769 }
 770
 771 /*
 772   Local Variables:
 773   c-file-style: "gnu"
 774   End:
 775 */