-/* Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
+/* 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)
/* "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 */
+
#include <stdio.h>
+#include <errno.h>
#include <ctype.h>
-#include "_scm.h"
-#include "gh.h"
-#include "load.h"
-#include "version.h"
-#include "script.h"
+#include "libguile/_scm.h"
+#include "libguile/gh.h"
+#include "libguile/load.h"
+#include "libguile/version.h"
+
+#include "libguile/validate.h"
+#include "libguile/script.h"
+
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h> /* for X_OK define */
string if file exists; 0 otherwise. */
static char *
-scm_cat_path (str1, str2, n)
- char *str1;
- const char *str2;
- long n;
+scm_cat_path (char *str1, const char *str2, long n)
{
if (!n)
n = strlen (str2);
if (str1)
{
- long len = strlen (str1);
- str1 = (char *) realloc (str1, (scm_sizet) (len + n + 1));
+ size_t len = strlen (str1);
+ str1 = (char *) realloc (str1, (size_t) (len + n + 1));
if (!str1)
return 0L;
strncat (str1 + len, str2, n);
return str1;
}
- str1 = (char *) malloc ((scm_sizet) (n + 1));
+ str1 = (char *) malloc ((size_t) (n + 1));
if (!str1)
return 0L;
str1[0] = 0;
#if 0
static char *
-scm_try_path (path)
- char *path;
+scm_try_path (char *path)
{
FILE *f;
/* fprintf(stderr, "Trying %s\n", path);fflush(stderr); */
}
static char *
-scm_sep_init_try (path, sep, initname)
- char *path;
- const char *sep, *initname;
+scm_sep_init_try (char *path, const char *sep, const char *initname)
{
if (path)
path = scm_cat_path (path, sep, 0L);
#define X_OK 1
#endif /* ndef X_OK */
-#ifdef unix
char *
scm_find_executable (const char *name)
{
fclose (f);
return scm_cat_path (0L, name, 0L);
}
-#endif /* unix */
-
-#ifdef MSDOS
-
-#define DEFAULT_PATH "C:\\DOS"
-#define PATH_DELIMITER ';'
-#define ABSOLUTE_FILENAME_P(fname) ((fname[0] == '\\') \
- || (fname[0] && (fname[1] == ':')))
-
-char *
-dld_find_executable (file)
- const char *file;
-{
- /* fprintf(stderr, "dld_find_executable %s -> %s\n", file, scm_cat_path(0L, file, 0L)); fflush(stderr); */
- return scm_cat_path (0L, file, 0L);
-}
-#endif /* def MSDOS */
/* Read a \nnn-style escape. We've just read the backslash. */
static int
-script_get_octal (f)
- FILE *f;
+script_get_octal (FILE *f)
+#define FUNC_NAME "script_get_octal"
{
int i;
int value = 0;
if ('0' <= c && c <= '7')
value = (value * 8) + (c - '0');
else
- scm_wta (SCM_UNDEFINED,
- "malformed script: bad octal backslash escape",
- "script argument parser");
+ SCM_MISC_ERROR ("malformed script: bad octal backslash escape",
+ SCM_EOL);
}
return value;
}
+#undef FUNC_NAME
static int
-script_get_backslash (f)
- FILE *f;
+script_get_backslash (FILE *f)
+#define FUNC_NAME "script_get_backslash"
{
int c = getc (f);
case '4': case '5': case '6': case '7':
ungetc (c, f);
return script_get_octal (f);
-
+
case EOF:
- scm_wta (SCM_UNDEFINED,
- "malformed script: backslash followed by EOF",
- "script argument parser");
+ SCM_MISC_ERROR ("malformed script: backslash followed by EOF", SCM_EOL);
return 0; /* not reached? */
default:
- scm_wta (SCM_UNDEFINED,
- "malformed script: bad backslash sequence",
- "script argument parser");
+ SCM_MISC_ERROR ("malformed script: bad backslash sequence", SCM_EOL);
return 0; /* not reached? */
}
}
+#undef FUNC_NAME
static char *
-script_read_arg (f)
- FILE *f;
+script_read_arg (FILE *f)
+#define FUNC_NAME "script_read_arg"
{
- int size = 7;
+ size_t size = 7;
char *buf = malloc (size + 1);
- int len = 0;
+ size_t len = 0;
if (! buf)
return 0;
case '\t':
free (buf);
- scm_wta (SCM_UNDEFINED,
- "malformed script: TAB in meta-arguments",
- "argument parser");
+ SCM_MISC_ERROR ("malformed script: TAB in meta-arguments", SCM_EOL);
return 0; /* not reached? */
}
}
}
+#undef FUNC_NAME
static int
-script_meta_arg_P (arg)
- char *arg;
+script_meta_arg_P (char *arg)
{
if ('\\' != arg[0])
return 0L;
}
char **
-scm_get_meta_args (argc, argv)
- int argc;
- char **argv;
+scm_get_meta_args (int argc, char **argv)
{
int nargc = argc, argi = 1, nargi = 1;
char *narg, **nargv;
}
int
-scm_count_argv (argv)
- char **argv;
+scm_count_argv (char **argv)
{
int argc = 0;
while (argv[argc])
" -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"
+ " -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",
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");
-/* The boot code "ice-9/boot-9" is only loaded by
- SCM_COMPILE_SHELL_SWITCHES when this is false. The unexec code
- uses this, to keep ice_9 from being loaded into dumped guile
- executables. */
-int scm_ice_9_already_loaded = 0;
-
/* Given an array of command-line switches, return a Scheme expression
to carry out the actions specified by the switches.
probably agree. I'd say I didn't feel comfortable doing that in
the present system. You'd say, well, fix the system so you are
comfortable doing that. I'd agree again. *shrug*
+ */
- We load the ice-9 system from here. It might be nicer if the
- libraries initialized from the inner_main function in guile.c (which
- will be auto-generated eventually) could assume ice-9 were already
- loaded. Then again, it might be nice if ice-9 could assume that
- certain libraries were already loaded. The solution is to break up
- ice-9 into modules which can be frozen and statically linked like any
- other module. Then all the modules can describe their dependencies in
- the usual way, and the auto-generated inner_main will do the right
- thing. */
+static char guile[] = "guile";
SCM
scm_compile_shell_switches (int argc, char **argv)
the "-ds" switch. */
SCM entry_point = SCM_EOL; /* for -e 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 i;
- char *argv0 = 0;
+ char *argv0 = guile;
if (argc > 0)
{
scm_usage_name++;
}
if (! scm_usage_name)
- scm_usage_name = "guile";
+ scm_usage_name = guile;
for (i = 1; i < argc; i++)
{
/* 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 (do_script != SCM_EOL)
+ if (!SCM_NULLP (do_script))
{
SCM_SETCAR (do_script, scm_makfrom0str (argv[i]));
do_script = SCM_EOL;
{
/* We put a dummy "load" expression, and let the -s put the
filename in. */
- if (do_script != SCM_EOL)
+ if (!SCM_NULLP (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 */
+ {
+ SCM_DEVAL_P = 1;
+ SCM_BACKTRACE_P = 1;
+ SCM_RECORD_POSITIONS_P = 1;
+ SCM_RESET_DEBUG_MODE;
+ }
+
else if (! strcmp (argv[i], "--emacs")) /* use emacs protocol */
use_emacs_interface = 1;
+ else if (! strcmp (argv[i], "-q")) /* don't load user init */
+ inhibit_user_init = 1;
+
+ else if (! strncmp (argv[i], "--use-srfi=", 11)) /* load SRFIs */
+ {
+ SCM srfis = SCM_EOL; /* List of requested SRFIs. */
+ char * p = argv[i] + 11;
+ while (*p)
+ {
+ long num;
+ char * end;
+
+ num = strtol (p, &end, 10);
+ if (end - p > 0)
+ {
+ srfis = scm_cons (scm_long2num (num), srfis);
+ if (*end)
+ {
+ if (*end == ',')
+ p = end + 1;
+ else
+ scm_shell_usage (1, "invalid SRFI specification");
+ }
+ else
+ break;
+ }
+ else
+ scm_shell_usage (1, "invalid SRFI specification");
+ }
+ if (scm_ilength (srfis) <= 0)
+ scm_shell_usage (1, "invalid SRFI specification");
+ srfis = scm_reverse_x (srfis, SCM_UNDEFINED);
+ tail = scm_cons (scm_listify
+ (sym_use_srfis,
+ scm_listify (scm_sym_quote,
+ srfis, SCM_UNDEFINED),
+ SCM_UNDEFINED),
+ tail);
+ }
+
else if (! strcmp (argv[i], "-h")
|| ! strcmp (argv[i], "--help"))
{
{
/* Print version number. */
printf ("Guile %s\n"
- "Copyright (c) 1995, 1996, 1997 Free Software Foundation\n"
+ "Copyright (c) 1995, 1996, 1997, 2000 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_CHARS (scm_version ()));
+ SCM_STRING_CHARS (scm_version ()));
exit (0);
}
}
/* Check to make sure the -ds got a -s. */
- if (do_script != SCM_EOL)
+ if (!SCM_NULLP (do_script))
scm_shell_usage (1, "the `-ds' switch requires the use of `-s' as well");
/* Make any remaining arguments available to the
script/command/whatever. */
- scm_set_program_arguments (argc - i, argv + i, argv0);
+ scm_set_program_arguments (argc ? argc - i : 0, argv + i, argv0);
/* If the --emacs switch was set, now is when we process it. */
- scm_sysintern ("use-emacs-interface",
- (use_emacs_interface) ? SCM_BOOL_T : SCM_BOOL_F);
+ scm_c_define ("use-emacs-interface", SCM_BOOL (use_emacs_interface));
/* Handle the `-e' switch, if it was specified. */
- if (entry_point != SCM_EOL)
+ if (!SCM_NULLP (entry_point))
tail = scm_cons (scm_cons2 (entry_point,
scm_cons (sym_command_line, SCM_EOL),
SCM_EOL),
tail);
- /* If we didn't end with a -c or a -s, load the user's customization
- file, and start the repl. */
+ /* If we didn't end with a -c or a -s, start the repl. */
if (interactive)
{
- tail = scm_cons (scm_cons (sym_load_user_init, SCM_EOL), tail);
tail = scm_cons (scm_cons (sym_top_repl, SCM_EOL), tail);
}
else
/* After doing all the other actions prescribed by the command line,
quit. */
tail = scm_cons (scm_cons (sym_quit, SCM_EOL),
- tail);
+ tail);
/* Allow asyncs (signal handlers etc.) to be run. */
scm_mask_ints = 0;
}
- {
- /* We want a path only containing directories from GUILE_LOAD_PATH,
- SCM_SITE_DIR and SCM_LIBRARY_DIR when searching for the site init
- file, so we do this before loading Ice-9. */
- SCM init_path = scm_sys_search_load_path (scm_makfrom0str ("init.scm"));
-
- /* Load Ice-9. */
- if (!scm_ice_9_already_loaded)
- scm_primitive_load_path (scm_makfrom0str ("ice-9/boot-9.scm"));
-
- /* Load the init.scm file. */
- if (SCM_NFALSEP (init_path))
- scm_primitive_load (init_path);
- }
+
+ /* After the following line, actions will be added to the front. */
+ tail = scm_reverse_x (tail, SCM_UNDEFINED);
+
+ /* If we didn't end with a -c or a -s and didn't supply a -q, load
+ the user's customization file. */
+ if (interactive && !inhibit_user_init)
+ {
+ tail = scm_cons (scm_cons (sym_load_user_init, SCM_EOL), tail);
+ }
{
- SCM val = scm_cons (sym_begin, scm_reverse_x (tail, SCM_UNDEFINED));
+ SCM val = scm_cons (sym_begin, tail);
#if 0
scm_write (val, SCM_UNDEFINED);
void
-scm_shell (argc, argv)
- int argc;
- char **argv;
+scm_shell (int argc, char **argv)
{
/* If present, add SCSH-style meta-arguments from the top of the
script file to the argument vector. See the SCSH manual: "The
}
}
- exit (scm_exit_status (scm_eval_x (scm_compile_shell_switches (argc,argv))));
+ exit (scm_exit_status (scm_eval_x (scm_compile_shell_switches (argc, argv),
+ scm_current_module ())));
}
void
scm_init_script ()
{
-#include "script.x"
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/script.x"
+#endif
}
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/
HCoop / bpt / guile.git / blobdiff