-/* Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
+/* Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 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.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
*
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * 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.
*
* 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
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
*/
/* "script.c" argv tricks for `#!' scripts.
Authors: Aubrey Jaffer and Jim Blandy */
-#if HAVE_CONFIG_H
+#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
+#include <stdlib.h>
#include <stdio.h>
#include <errno.h>
#include <ctype.h>
+#include <version-etc.h>
+
#include "libguile/_scm.h"
-#include "libguile/gh.h"
+#include "libguile/eval.h"
+#include "libguile/feature.h"
#include "libguile/load.h"
-#include "libguile/version.h"
-
-#include "libguile/validate.h"
+#include "libguile/private-gc.h" /* scm_getenv_int */
+#include "libguile/read.h"
#include "libguile/script.h"
+#include "libguile/strings.h"
+#include "libguile/strports.h"
+#include "libguile/validate.h"
+#include "libguile/version.h"
+#include "libguile/vm.h"
#ifdef HAVE_STRING_H
#include <string.h>
scm_find_executable (const char *name)
{
char tbuf[MAXPATHLEN];
- int i = 0;
+ int i = 0, c;
FILE *f;
/* fprintf(stderr, "s_f_e checking access %s ->%d\n", name, access(name, X_OK)); fflush(stderr); */
if ((fgetc (f) == '#') && (fgetc (f) == '!'))
{
while (1)
- switch (tbuf[i++] = fgetc (f))
+ switch (c = fgetc (f))
{
case /*WHITE_SPACES */ ' ':
case '\t':
case '\r':
case '\f':
case EOF:
- tbuf[--i] = 0;
+ tbuf[i] = 0;
fclose (f);
return scm_cat_path (0L, tbuf, 0L);
+ default:
+ tbuf[i++] = c;
+ break;
}
}
fclose (f);
if (message)
fprintf (fp, "%s\n", message);
- fprintf (fp,
- "Usage: %s OPTION ...\n"
+ fprintf (fp,
+ "Usage: %s [OPTION]... [FILE]...\n"
"Evaluate Scheme code, interactively or from a script.\n"
"\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"
+ " -- stop scanning arguments; run interactively\n\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"
+ " -x EXTENSION add EXTENSION to the front of the load extensions\n"
" -l FILE load Scheme source code from FILE\n"
" -e FUNCTION after reading script, apply FUNCTION to\n"
" command line arguments\n"
" --no-debug start with normal evaluator\n"
" Default is to enable debugging for interactive\n"
" use, but not for `-s' and `-c'.\n"
+ " --auto-compile compile source files automatically\n"
+ " --no-auto-compile disable automatic source file compilation\n"
+ " Default is to enable auto-compilation of source\n"
+ " files.\n"
+ " --listen[=P] Listen on a local port or a path for REPL clients.\n"
+ " If P is not given, the default is local port 37146.\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"
- "\n"
- "Please report bugs to bug-guile@gnu.org\n",
+ " \\ read arguments from following script lines\n",
scm_usage_name);
+ emit_bug_reporting_address ();
+
if (fatal)
exit (fatal);
}
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_ice_9, "ice-9");
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_load_extensions, "%load-extensions");
SCM_SYMBOL (sym_set_x, "set!");
+SCM_SYMBOL (sym_sys_load_should_auto_compile, "%load-should-auto-compile");
SCM_SYMBOL (sym_cons, "cons");
SCM_SYMBOL (sym_at, "@");
SCM_SYMBOL (sym_atat, "@@");
the "-ds" switch. */
SCM entry_point = SCM_EOL; /* for -e switch */
SCM user_load_path = SCM_EOL; /* for -L switch */
+ SCM user_extensions = SCM_EOL;/* for -x 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;
scm_shell_usage (1, "missing argument to `-L' switch");
}
+ else if (! strcmp (argv[i], "-x")) /* add to %load-extensions */
+ {
+ if (++i < argc)
+ user_extensions =
+ scm_cons (scm_list_3 (sym_set_x,
+ sym_load_extensions,
+ scm_list_3 (sym_cons,
+ scm_from_locale_string (argv[i]),
+ sym_load_extensions)),
+ user_extensions);
+ else
+ scm_shell_usage (1, "missing argument to `-x' switch");
+ }
+
else if (! strcmp (argv[i], "-e")) /* entry point */
{
if (++i < argc)
}
else
scm_shell_usage (1, "missing argument to `-e' switch");
-
- scm_display (entry_point, SCM_UNDEFINED);
- scm_newline (SCM_UNDEFINED);
}
else if (! strcmp (argv[i], "-ds")) /* do script here */
turn_on_debugging = 0;
}
- else if (! strcmp (argv[i], "--emacs")) /* use emacs protocol */
- use_emacs_interface = 1;
+ /* Do auto-compile on/off now, because the form itself might need this
+ decision. */
+ else if (! strcmp (argv[i], "--auto-compile"))
+ scm_variable_set_x (scm_c_lookup ("%load-should-auto-compile"),
+ SCM_BOOL_T);
+
+ else if (! strcmp (argv[i], "--no-auto-compile"))
+ scm_variable_set_x (scm_c_lookup ("%load-should-auto-compile"),
+ SCM_BOOL_F);
else if (! strcmp (argv[i], "-q")) /* don't load user init */
inhibit_user_init = 1;
tail);
}
+ else if (! strncmp (argv[i], "--listen", 8) /* start a repl server */
+ && (argv[i][8] == '\0' || argv[i][8] == '='))
+ {
+ const char default_template[] =
+ "(@@ (system repl server) (spawn-server))";
+ const char port_template[] =
+ "(@@ (system repl server)"
+ " (spawn-server (make-tcp-server-socket #:port ~a)))";
+ const char path_template[] =
+ "(@@ (system repl server)"
+ " (spawn-server (make-unix-domain-server-socket #:path ~s)))";
+
+ SCM form_str = SCM_BOOL_F;
+ char * p = argv[i] + 8;
+
+ if (*p == '=')
+ {
+ p++;
+ if (*p > '0' && *p <= '9')
+ {
+ /* --listen=PORT */
+ SCM port = scm_string_to_number (scm_from_locale_string (p),
+ SCM_UNDEFINED);
+
+ if (scm_is_false (port))
+ scm_shell_usage (1, "invalid port for --listen");
+
+ form_str =
+ scm_simple_format (SCM_BOOL_F,
+ scm_from_locale_string (port_template),
+ scm_list_1 (port));
+ }
+ else if (*p == '/')
+ {
+ /* --listen=/PATH/TO/SOCKET */
+ SCM path = scm_from_locale_string (p);
+
+ form_str =
+ scm_simple_format (SCM_BOOL_F,
+ scm_from_locale_string (path_template),
+ scm_list_1 (path));
+ }
+ else
+ {
+ /* unknown --listen arg */
+ scm_shell_usage (1, "unknown argument to --listen");
+ }
+ }
+ else
+ form_str = scm_from_locale_string (default_template);
+
+ tail = scm_cons (scm_read (scm_open_input_string (form_str)), tail);
+ }
+
else if (! strcmp (argv[i], "-h")
|| ! strcmp (argv[i], "--help"))
{
scm_shell_usage (0, 0);
- exit (0);
+ exit (EXIT_SUCCESS);
}
else if (! strcmp (argv[i], "-v")
|| ! strcmp (argv[i], "--version"))
{
/* Print version number. */
- printf ("Guile %s\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_to_locale_string (scm_version ()));
- exit (0);
+ version_etc (stdout, scm_usage_name, PACKAGE_NAME, PACKAGE_VERSION,
+ /* XXX: Use gettext for the string below. */
+ "the Guile developers", NULL);
+ exit (EXIT_SUCCESS);
}
else
script/command/whatever. */
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_from_bool (use_emacs_interface));
-
/* Handle the `-e' switch, if it was specified. */
if (!scm_is_null (entry_point))
tail = scm_cons (scm_cons2 (entry_point,
/* If we didn't end with a -c or a -s, start the repl. */
if (interactive)
{
- tail = scm_cons (scm_cons (sym_top_repl, SCM_EOL), tail);
+ tail = scm_cons (scm_list_1 (scm_list_3
+ (sym_at,
+ scm_list_2 (sym_ice_9, sym_top_repl),
+ sym_top_repl)),
+ tail);
}
else
{
{
tail = scm_append_x( scm_cons2(user_load_path, tail, SCM_EOL) );
}
-
+
+ if (!scm_is_null (user_extensions))
+ tail = scm_append_x (scm_cons2 (user_extensions, 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. */
if (interactive && !inhibit_user_init)
}
/* If debugging was requested, or we are interactive and debugging
- was not explicitly turned off, turn on debugging. */
+ was not explicitly turned off, use the debug engine. */
if (turn_on_debugging || (interactive && !dont_turn_on_debugging))
{
- tail = scm_cons (scm_cons (sym_turn_on_debugging, SCM_EOL), tail);
+ scm_c_set_default_vm_engine_x (SCM_VM_DEBUG_ENGINE);
+ scm_c_set_vm_engine_x (scm_the_vm (), SCM_VM_DEBUG_ENGINE);
}
{
SCM val = scm_cons (sym_begin, tail);
+ /* Wrap the expression in a prompt. */
+ val = scm_list_2 (scm_list_3 (scm_sym_at,
+ scm_list_2 (scm_from_latin1_symbol ("ice-9"),
+ scm_from_latin1_symbol ("control")),
+ scm_from_latin1_symbol ("%")),
+ val);
+
#if 0
scm_write (val, SCM_UNDEFINED);
scm_newline (SCM_UNDEFINED);
HCoop / bpt / guile.git / blobdiff