X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/1afff620541041a7b680a85fee6d641092091b7c..d2e53ed6f84df8c79f4bf5cf41d4f6d381bc065b:/libguile/script.c?ds=sidebyside diff --git a/libguile/script.c b/libguile/script.c index 0c4810446..b2629b3f1 100644 --- a/libguile/script.c +++ b/libguile/script.c @@ -1,48 +1,25 @@ -/* Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001 Free Software Foundation, Inc. - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA - * - * As a special exception, the Free Software Foundation gives permission - * for additional uses of the text contained in its release of GUILE. - * - * The exception is that, if you link the GUILE library with other files - * to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the GUILE library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. +/* Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. * - * This exception applies only to the code released by the - * Free Software Foundation under the name GUILE. If you copy - * code from other Free Software Foundation releases into a copy of - * GUILE, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. * - * If you write modifications of your own for GUILE, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. */ + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + */ /* "script.c" argv tricks for `#!' scripts. Authors: Aubrey Jaffer and Jim Blandy */ -/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999, - gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */ +#if HAVE_CONFIG_H +# include +#endif #include #include @@ -64,6 +41,10 @@ #include /* for X_OK define */ #endif +#ifdef HAVE_IO_H +#include +#endif + /* Concatentate str2 onto str1 at position n and return concatenated string if file exists; 0 otherwise. */ @@ -81,7 +62,7 @@ scm_cat_path (char *str1, const char *str2, long n) strncat (str1 + len, str2, n); return str1; } - str1 = (char *) malloc ((size_t) (n + 1)); + str1 = (char *) scm_malloc ((size_t) (n + 1)); if (!str1) return 0L; str1[0] = 0; @@ -234,7 +215,7 @@ script_read_arg (FILE *f) #define FUNC_NAME "script_read_arg" { size_t size = 7; - char *buf = malloc (size + 1); + char *buf = scm_malloc (size + 1); size_t len = 0; if (! buf) @@ -313,7 +294,7 @@ scm_get_meta_args (int argc, char **argv) char *narg, **nargv; if (!(argc > 2 && script_meta_arg_P (argv[1]))) return 0L; - if (!(nargv = (char **) malloc ((1 + nargc) * sizeof (char *)))) + if (!(nargv = (char **) scm_malloc ((1 + nargc) * sizeof (char *)))) return 0L; nargv[0] = argv[0]; while (((argi + 1) < argc) && (script_meta_arg_P (argv[argi]))) @@ -364,31 +345,40 @@ char *scm_usage_name = 0; void scm_shell_usage (int fatal, char *message) { + FILE *fp = (fatal ? stderr : stdout); + if (message) - fprintf (stderr, "%s\n", message); + fprintf (fp, "%s\n", message); - fprintf (stderr, + fprintf (fp, "Usage: %s OPTION ...\n" "Evaluate Scheme code, interactively or from a script.\n" "\n" - " -s SCRIPT load Scheme source code from FILE, and exit\n" + " [-s] FILE load Scheme source code from FILE, and exit\n" " -c EXPR evalute Scheme expression EXPR, and exit\n" " -- stop scanning arguments; run interactively\n" "The above switches stop argument processing, and pass all\n" "remaining arguments as the value of (command-line).\n" + "If FILE begins with `-' the -s switch is mandatory.\n" "\n" + " -L DIRECTORY add DIRECTORY to the front of the module load path\n" " -l FILE load Scheme source code from FILE\n" " -e FUNCTION after reading script, apply FUNCTION to\n" " command line arguments\n" " -ds do -s script at this point\n" " --debug start with debugging evaluator and backtraces\n" + " --no-debug start with normal evaluator\n" + " Default is to enable debugging for interactive\n" + " use, but not for `-s' and `-c'.\n" " -q inhibit loading of user init file\n" " --emacs enable Emacs protocol (experimental)\n" " --use-srfi=LS load SRFI modules for the SRFIs in LS,\n" " which is a list of numbers like \"2,13,14\"\n" " -h, --help display this help and exit\n" " -v, --version display version information and exit\n" - " \\ read arguments from following script lines\n", + " \\ read arguments from following script lines\n" + "\n" + "Please report bugs to bug-guile@gnu.org\n", scm_usage_name); if (fatal) @@ -401,11 +391,14 @@ SCM_SYMBOL (sym_load, "load"); SCM_SYMBOL (sym_eval_string, "eval-string"); SCM_SYMBOL (sym_command_line, "command-line"); SCM_SYMBOL (sym_begin, "begin"); +SCM_SYMBOL (sym_turn_on_debugging, "turn-on-debugging"); SCM_SYMBOL (sym_load_user_init, "load-user-init"); SCM_SYMBOL (sym_top_repl, "top-repl"); SCM_SYMBOL (sym_quit, "quit"); SCM_SYMBOL (sym_use_srfis, "use-srfis"); - +SCM_SYMBOL (sym_load_path, "%load-path"); +SCM_SYMBOL (sym_set_x, "set!"); +SCM_SYMBOL (sym_cons, "cons"); /* Given an array of command-line switches, return a Scheme expression to carry out the actions specified by the switches. @@ -428,9 +421,13 @@ scm_compile_shell_switches (int argc, char **argv) the "load" command, in case we get the "-ds" switch. */ SCM entry_point = SCM_EOL; /* for -e switch */ + SCM user_load_path = SCM_EOL; /* for -L switch */ int interactive = 1; /* Should we go interactive when done? */ int inhibit_user_init = 0; /* Don't load user init file */ int use_emacs_interface = 0; + int turn_on_debugging = 0; + int dont_turn_on_debugging = 0; + int i; char *argv0 = guile; @@ -448,23 +445,23 @@ scm_compile_shell_switches (int argc, char **argv) for (i = 1; i < argc; i++) { - if (! strcmp (argv[i], "-s")) /* load script */ + if ((! strcmp (argv[i], "-s")) || (argv[i][0] != '-')) /* load script */ { - if (++i >= argc) + if ((argv[i][0] == '-') && (++i >= argc)) scm_shell_usage (1, "missing argument to `-s' switch"); /* If we specified the -ds option, do_script points to the cdr of an expression like (load #f); we replace the car (i.e., the #f) with the script name. */ - if (!SCM_NULLP (do_script)) + if (!scm_is_null (do_script)) { - SCM_SETCAR (do_script, scm_makfrom0str (argv[i])); + SCM_SETCAR (do_script, scm_from_locale_string (argv[i])); do_script = SCM_EOL; } else /* Construct an application of LOAD to the script name. */ tail = scm_cons (scm_cons2 (sym_load, - scm_makfrom0str (argv[i]), + scm_from_locale_string (argv[i]), SCM_EOL), tail); argv0 = argv[i]; @@ -478,7 +475,7 @@ scm_compile_shell_switches (int argc, char **argv) if (++i >= argc) scm_shell_usage (1, "missing argument to `-c' switch"); tail = scm_cons (scm_cons2 (sym_eval_string, - scm_makfrom0str (argv[i]), + scm_from_locale_string (argv[i]), SCM_EOL), tail); i++; @@ -496,17 +493,31 @@ scm_compile_shell_switches (int argc, char **argv) { if (++i < argc) tail = scm_cons (scm_cons2 (sym_load, - scm_makfrom0str (argv[i]), + scm_from_locale_string (argv[i]), SCM_EOL), tail); else scm_shell_usage (1, "missing argument to `-l' switch"); } + else if (! strcmp (argv[i], "-L")) /* add to %load-path */ + { + if (++i < argc) + user_load_path = + scm_cons (scm_list_3 (sym_set_x, + sym_load_path, + scm_list_3 (sym_cons, + scm_from_locale_string (argv[i]), + sym_load_path)), + user_load_path); + else + scm_shell_usage (1, "missing argument to `-L' switch"); + } + else if (! strcmp (argv[i], "-e")) /* entry point */ { if (++i < argc) - entry_point = gh_symbol2scm (argv[i]); + entry_point = scm_c_read_string (argv[i]); else scm_shell_usage (1, "missing argument to `-e' switch"); } @@ -515,19 +526,23 @@ scm_compile_shell_switches (int argc, char **argv) { /* We put a dummy "load" expression, and let the -s put the filename in. */ - if (!SCM_NULLP (do_script)) + if (!scm_is_null (do_script)) scm_shell_usage (1, "the -ds switch may only be specified once"); do_script = scm_cons (SCM_BOOL_F, SCM_EOL); tail = scm_cons (scm_cons (sym_load, do_script), tail); } - else if (! strcmp (argv[i], "--debug")) /* debug eval + backtraces */ + else if (! strcmp (argv[i], "--debug")) + { + turn_on_debugging = 1; + dont_turn_on_debugging = 0; + } + + else if (! strcmp (argv[i], "--no-debug")) { - SCM_DEVAL_P = 1; - SCM_BACKTRACE_P = 1; - SCM_RECORD_POSITIONS_P = 1; - SCM_RESET_DEBUG_MODE; + dont_turn_on_debugging = 1; + turn_on_debugging = 0; } else if (! strcmp (argv[i], "--emacs")) /* use emacs protocol */ @@ -548,7 +563,7 @@ scm_compile_shell_switches (int argc, char **argv) num = strtol (p, &end, 10); if (end - p > 0) { - srfis = scm_cons (scm_long2num (num), srfis); + srfis = scm_cons (scm_from_long (num), srfis); if (*end) { if (*end == ',') @@ -582,12 +597,12 @@ scm_compile_shell_switches (int argc, char **argv) { /* Print version number. */ printf ("Guile %s\n" - "Copyright (c) 1995, 1996, 1997, 2000 Free Software Foundation\n" + "Copyright (c) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004 Free Software Foundation\n" "Guile may be distributed under the terms of the GNU General Public Licence;\n" "certain other uses are permitted as well. For details, see the file\n" "`COPYING', which is included in the Guile distribution.\n" "There is no warranty, to the extent permitted by law.\n", - SCM_STRING_CHARS (scm_version ())); + scm_to_locale_string (scm_version ())); exit (0); } @@ -600,7 +615,7 @@ scm_compile_shell_switches (int argc, char **argv) } /* Check to make sure the -ds got a -s. */ - if (!SCM_NULLP (do_script)) + if (!scm_is_null (do_script)) scm_shell_usage (1, "the `-ds' switch requires the use of `-s' as well"); /* Make any remaining arguments available to the @@ -608,10 +623,10 @@ scm_compile_shell_switches (int argc, char **argv) scm_set_program_arguments (argc ? argc - i : 0, argv + i, argv0); /* If the --emacs switch was set, now is when we process it. */ - scm_c_define ("use-emacs-interface", SCM_BOOL (use_emacs_interface)); + scm_c_define ("use-emacs-interface", scm_from_bool (use_emacs_interface)); /* Handle the `-e' switch, if it was specified. */ - if (!SCM_NULLP (entry_point)) + if (!scm_is_null (entry_point)) tail = scm_cons (scm_cons2 (entry_point, scm_cons (sym_command_line, SCM_EOL), SCM_EOL), @@ -628,12 +643,17 @@ scm_compile_shell_switches (int argc, char **argv) quit. */ tail = scm_cons (scm_cons (sym_quit, SCM_EOL), tail); - /* Allow asyncs (signal handlers etc.) to be run. */ - scm_mask_ints = 0; } /* After the following line, actions will be added to the front. */ tail = scm_reverse_x (tail, SCM_UNDEFINED); + + /* add the user-specified load path here, so it won't be in effect + during the loading of the user's customization file. */ + if(!scm_is_null(user_load_path)) + { + tail = scm_append_x( scm_cons2(user_load_path, tail, SCM_EOL) ); + } /* If we didn't end with a -c or a -s and didn't supply a -q, load the user's customization file. */ @@ -642,6 +662,13 @@ scm_compile_shell_switches (int argc, char **argv) tail = scm_cons (scm_cons (sym_load_user_init, SCM_EOL), tail); } + /* If debugging was requested, or we are interactive and debugging + was not explicitly turned off, turn on debugging. */ + if (turn_on_debugging || (interactive && !dont_turn_on_debugging)) + { + tail = scm_cons (scm_cons (sym_turn_on_debugging, SCM_EOL), tail); + } + { SCM val = scm_cons (sym_begin, tail); @@ -679,9 +706,7 @@ scm_shell (int argc, char **argv) void scm_init_script () { -#ifndef SCM_MAGIC_SNARFER #include "libguile/script.x" -#endif } /*