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            "  --use-srfi=LS  load SRFI modules for the SRFIs in LS,\n"
 389            "                 which is a list of numbers like \"2,13,14\"\n"
 390            "  -h, --help     display this help and exit\n"
 391            "  -v, --version  display version information and exit\n"
 392            "  \\              read arguments from following script lines\n",
 393            scm_usage_name);
 394
 395   emit_bug_reporting_address ();
 396
 397   if (fatal)
 398     exit (fatal);
 399 }
 400
 401
 402 /* Some symbols used by the command-line compiler.  */
 403 SCM_SYMBOL (sym_load, "load");
 404 SCM_SYMBOL (sym_eval_string, "eval-string");
 405 SCM_SYMBOL (sym_command_line, "command-line");
 406 SCM_SYMBOL (sym_begin, "begin");
 407 SCM_SYMBOL (sym_turn_on_debugging, "turn-on-debugging");
 408 SCM_SYMBOL (sym_load_user_init, "load-user-init");
 409 SCM_SYMBOL (sym_ice_9, "ice-9");
 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 turn_on_debugging = 0;
 458   int dont_turn_on_debugging = 0;
 459
 460   int i;
 461   char *argv0 = guile;
 462
 463   if (argc > 0)
 464     {
 465       argv0 = argv[0];
 466       scm_usage_name = strrchr (argv[0], '/');
 467       if (! scm_usage_name)
 468         scm_usage_name = argv[0];
 469       else
 470         scm_usage_name++;
 471     }
 472   if (! scm_usage_name)
 473     scm_usage_name = guile;
 474
 475   for (i = 1; i < argc; i++)
 476     {
 477       if ((! strcmp (argv[i], "-s")) || (argv[i][0] != '-')) /* load script */
 478         {
 479           if ((argv[i][0] == '-') && (++i >= argc))
 480             scm_shell_usage (1, "missing argument to `-s' switch");
 481
 482           /* If we specified the -ds option, do_script points to the
 483              cdr of an expression like (load #f); we replace the car
 484              (i.e., the #f) with the script name.  */
 485           if (!scm_is_null (do_script))
 486             {
 487               SCM_SETCAR (do_script, scm_from_locale_string (argv[i]));
 488               do_script = SCM_EOL;
 489             }
 490           else
 491             /* Construct an application of LOAD to the script name.  */
 492             tail = scm_cons (scm_cons2 (sym_load,
 493                                         scm_from_locale_string (argv[i]),
 494                                         SCM_EOL),
 495                                tail);
 496           argv0 = argv[i];
 497           i++;
 498           interactive = 0;
 499           break;
 500         }
 501
 502       else if (! strcmp (argv[i], "-c")) /* evaluate expr */
 503         {
 504           if (++i >= argc)
 505             scm_shell_usage (1, "missing argument to `-c' switch");
 506           tail = scm_cons (scm_cons2 (sym_eval_string,
 507                                       scm_from_locale_string (argv[i]),
 508                                       SCM_EOL),
 509                            tail);
 510           i++;
 511           interactive = 0;
 512           break;
 513         }
 514
 515       else if (! strcmp (argv[i], "--")) /* end args; go interactive */
 516         {
 517           i++;
 518           break;
 519         }
 520
 521       else if (! strcmp (argv[i], "-l")) /* load a file */
 522         {
 523           if (++i < argc)
 524             tail = scm_cons (scm_cons2 (sym_load,
 525                                         scm_from_locale_string (argv[i]),
 526                                         SCM_EOL),
 527                              tail);
 528           else
 529             scm_shell_usage (1, "missing argument to `-l' switch");
 530         }
 531
 532       else if (! strcmp (argv[i], "-L")) /* add to %load-path */
 533         {
 534           if (++i < argc)
 535             user_load_path =
 536               scm_cons (scm_list_3 (sym_set_x,
 537                                     sym_load_path,
 538                                     scm_list_3 (sym_cons,
 539                                                 scm_from_locale_string (argv[i]),
 540                                                 sym_load_path)),
 541                         user_load_path);
 542           else
 543             scm_shell_usage (1, "missing argument to `-L' switch");
 544         }
 545
 546       else if (! strcmp (argv[i], "-e")) /* entry point */
 547         {
 548           if (++i < argc)
 549             {
 550               SCM port
 551                 = scm_open_input_string (scm_from_locale_string (argv[i]));
 552               SCM arg1 = scm_read (port);
 553               SCM arg2 = scm_read (port);
 554
 555               /* Recognize syntax of certain versions of Guile 1.4 and
 556                  transform to (@ MODULE-NAME FUNC).
 557                */
 558               if (scm_is_false (scm_eof_object_p (arg2)))
 559                 entry_point = scm_list_3 (sym_at, arg1, arg2);
 560               else if (scm_is_pair (arg1)
 561                        && !(scm_is_eq (SCM_CAR (arg1), sym_at)
 562                             || scm_is_eq (SCM_CAR (arg1), sym_atat))
 563                        && all_symbols (arg1))
 564                 entry_point = scm_list_3 (sym_at, arg1, sym_main);
 565               else
 566                 entry_point = arg1;
 567             }
 568           else
 569             scm_shell_usage (1, "missing argument to `-e' switch");
 570         }
 571
 572       else if (! strcmp (argv[i], "-ds")) /* do script here */
 573         {
 574           /* We put a dummy "load" expression, and let the -s put the
 575              filename in.  */
 576           if (!scm_is_null (do_script))
 577             scm_shell_usage (1, "the -ds switch may only be specified once");
 578           do_script = scm_cons (SCM_BOOL_F, SCM_EOL);
 579           tail = scm_cons (scm_cons (sym_load, do_script),
 580                            tail);
 581         }
 582
 583       else if (! strcmp (argv[i], "--debug"))
 584         {
 585           turn_on_debugging = 1;
 586           dont_turn_on_debugging = 0;
 587         }
 588
 589       else if (! strcmp (argv[i], "--no-debug"))
 590         {
 591           dont_turn_on_debugging = 1;
 592           turn_on_debugging = 0;
 593         }
 594
 595       /* Do autocompile on/off now, because the form itself might need this
 596          decision. */
 597       else if (! strcmp (argv[i], "--autocompile"))
 598         scm_variable_set_x (scm_c_lookup ("%load-should-autocompile"),
 599                             SCM_BOOL_T);
 600
 601       else if (! strcmp (argv[i], "--no-autocompile"))
 602         scm_variable_set_x (scm_c_lookup ("%load-should-autocompile"),
 603                             SCM_BOOL_F);
 604
 605       else if (! strcmp (argv[i], "-q")) /* don't load user init */
 606         inhibit_user_init = 1;
 607
 608       else if (! strncmp (argv[i], "--use-srfi=", 11)) /* load SRFIs */
 609         {
 610           SCM srfis = SCM_EOL;  /* List of requested SRFIs.  */
 611           char * p = argv[i] + 11;
 612           while (*p)
 613             {
 614               long num;
 615               char * end;
 616
 617               num = strtol (p, &end, 10);
 618               if (end - p > 0)
 619                 {
 620                   srfis = scm_cons (scm_from_long (num), srfis);
 621                   if (*end)
 622                     {
 623                       if (*end == ',')
 624                         p = end + 1;
 625                       else
 626                         scm_shell_usage (1, "invalid SRFI specification");
 627                     }
 628                   else
 629                     break;
 630                 }
 631               else
 632                 scm_shell_usage (1, "invalid SRFI specification");
 633             }
 634           if (scm_ilength (srfis) <= 0)
 635             scm_shell_usage (1, "invalid SRFI specification");
 636           srfis = scm_reverse_x (srfis, SCM_UNDEFINED);
 637           tail = scm_cons (scm_list_2 (sym_use_srfis,
 638                                        scm_list_2 (scm_sym_quote, srfis)),
 639                            tail);
 640         }
 641
 642       else if (! strcmp (argv[i], "-h")
 643                || ! strcmp (argv[i], "--help"))
 644         {
 645           scm_shell_usage (0, 0);
 646           exit (0);
 647         }
 648
 649       else if (! strcmp (argv[i], "-v")
 650                || ! strcmp (argv[i], "--version"))
 651         {
 652           /* Print version number.  */
 653           version_etc (stdout, scm_usage_name, PACKAGE_NAME, PACKAGE_VERSION,
 654                        /* XXX: Use gettext for the string below.  */
 655                        "the Guile developers", NULL);
 656           exit (0);
 657         }
 658
 659       else
 660         {
 661           fprintf (stderr, "%s: Unrecognized switch `%s'\n",
 662                    scm_usage_name, argv[i]);
 663           scm_shell_usage (1, 0);
 664         }
 665     }
 666
 667   /* Check to make sure the -ds got a -s. */
 668   if (!scm_is_null (do_script))
 669     scm_shell_usage (1, "the `-ds' switch requires the use of `-s' as well");
 670
 671   /* Make any remaining arguments available to the
 672      script/command/whatever.  */
 673   scm_set_program_arguments (argc ? argc - i : 0, argv + i, argv0);
 674
 675   /* Handle the `-e' switch, if it was specified.  */
 676   if (!scm_is_null (entry_point))
 677     tail = scm_cons (scm_cons2 (entry_point,
 678                                 scm_cons (sym_command_line, SCM_EOL),
 679                                 SCM_EOL),
 680                        tail);
 681
 682   /* If we didn't end with a -c or a -s, start the repl.  */
 683   if (interactive)
 684     {
 685       tail = scm_cons (scm_list_1 (scm_list_3
 686                                    (sym_at,
 687                                     scm_list_2 (sym_ice_9, sym_top_repl),
 688                                     sym_top_repl)),
 689                        tail);
 690     }
 691   else
 692     {
 693       /* After doing all the other actions prescribed by the command line,
 694          quit.  */
 695       tail = scm_cons (scm_cons (sym_quit, SCM_EOL),
 696                        tail);
 697     }
 698
 699   /* After the following line, actions will be added to the front. */
 700   tail = scm_reverse_x (tail, SCM_UNDEFINED);
 701
 702   /* add the user-specified load path here, so it won't be in effect
 703      during the loading of the user's customization file. */
 704   if(!scm_is_null(user_load_path))
 705     {
 706       tail = scm_append_x( scm_cons2(user_load_path, tail, SCM_EOL) );
 707     }
 708
 709   /* If we didn't end with a -c or a -s and didn't supply a -q, load
 710      the user's customization file.  */
 711   if (interactive && !inhibit_user_init)
 712     {
 713       tail = scm_cons (scm_cons (sym_load_user_init, SCM_EOL), tail);
 714     }
 715
 716   /* If debugging was requested, or we are interactive and debugging
 717      was not explicitly turned off, turn on debugging. */
 718   if (turn_on_debugging || (interactive && !dont_turn_on_debugging))
 719     {
 720       tail = scm_cons (scm_cons (sym_turn_on_debugging, SCM_EOL), tail);
 721     }
 722
 723   {
 724     SCM val = scm_cons (sym_begin, tail);
 725
 726     /* Wrap the expression in a prompt. */
 727     val = scm_list_2 (scm_list_3 (scm_sym_at,
 728                                       scm_list_2 (scm_from_locale_symbol ("ice-9"),
 729                                                   scm_from_locale_symbol ("control")),
 730                                       scm_from_locale_symbol ("%")),
 731                       val);
 732
 733 #if 0
 734     scm_write (val, SCM_UNDEFINED);
 735     scm_newline (SCM_UNDEFINED);
 736 #endif
 737
 738     return val;
 739   }
 740 }
 741
 742
 743 void
 744 scm_shell (int argc, char **argv)
 745 {
 746   /* If present, add SCSH-style meta-arguments from the top of the
 747      script file to the argument vector.  See the SCSH manual: "The
 748      meta argument" for more details.  */
 749   {
 750     char **new_argv = scm_get_meta_args (argc, argv);
 751
 752     if (new_argv)
 753       {
 754         argv = new_argv;
 755         argc = scm_count_argv (new_argv);
 756       }
 757   }
 758
 759   exit (scm_exit_status (scm_eval_x (scm_compile_shell_switches (argc, argv),
 760                                      scm_current_module ())));
 761 }
 762
 763
 764 void
 765 scm_init_script ()
 766 {
 767 #include "libguile/script.x"
 768 }
 769
 770 /*
 771   Local Variables:
 772   c-file-style: "gnu"
 773   End:
 774 */