X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/f072db0c4191bb9455cf53670a280677a97dad79..b6ed39c411acebf6c94efe149942310422adc891:/libguile/feature.c diff --git a/libguile/feature.c b/libguile/feature.c dissimilarity index 81% index e0640793e..1d44a7790 100644 --- a/libguile/feature.c +++ b/libguile/feature.c @@ -1,99 +1,116 @@ -/* Copyright (C) 1995,1996 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, 675 Mass Ave, Cambridge, MA 02139, 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. - * - * 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. - * - * 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. - */ - - -#include -#include "_scm.h" - -#ifdef HAVE_STRING_H -#include -#endif - - -static SCM *scm_loc_features; - -void -scm_add_feature(str) - char* str; -{ - *scm_loc_features = scm_cons(SCM_CAR(scm_intern(str, strlen(str))), - *scm_loc_features); -} - - - - -SCM_PROC(s_program_arguments, "program-arguments", 0, 0, 0, scm_program_arguments); -SCM -scm_program_arguments () -{ - return scm_progargs; -} - - - - -void -scm_init_feature() -{ - scm_loc_features = &SCM_CDR(scm_sysintern("*features*", SCM_EOL)); -#ifdef RECKLESS - scm_add_feature("reckless"); -#endif -#ifndef _Windows - scm_add_feature("system"); -#endif -#ifdef vms - scm_add_feature(s_ed); -#endif -#ifdef SICP - scm_add_feature("sicp"); -#endif -#ifndef GO32 - scm_add_feature("char-ready?"); -#endif -#ifndef CHEAP_CONTINUATIONS - scm_add_feature ("full-continuation"); -#endif - - scm_sysintern ("char-code-limit", SCM_MAKINUM (SCM_CHAR_SCM_CODE_LIMIT)); -#include "feature.x" -} +/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2004, 2006 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 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ + + + +#if HAVE_CONFIG_H +# include +#endif + +#ifdef HAVE_STRING_H +#include +#endif + +#include "libguile/_scm.h" +#include "libguile/root.h" +#include "libguile/strings.h" +#include "libguile/validate.h" +#include "libguile/fluids.h" + +#include "libguile/feature.h" + + + +static SCM progargs_fluid; +static SCM features_var; + +void +scm_add_feature (const char *str) +{ + SCM old = SCM_VARIABLE_REF (features_var); + SCM new = scm_cons (scm_from_locale_symbol (str), old); + SCM_VARIABLE_SET (features_var, new); +} + + + +SCM_DEFINE (scm_program_arguments, "program-arguments", 0, 0, 0, + (), + "@deffnx {Scheme Procedure} command-line\n" + "Return the list of command line arguments passed to Guile, as a list of\n" + "strings. The list includes the invoked program name, which is usually\n" + "@code{\"guile\"}, but excludes switches and parameters for command line\n" + "options like @code{-e} and @code{-l}.") +#define FUNC_NAME s_scm_program_arguments +{ + return scm_fluid_ref (progargs_fluid); +} +#undef FUNC_NAME + +/* Set the value returned by program-arguments, given ARGC and ARGV. + + If FIRST is non-zero, make it the first element; we do this in + situations where other code (like getopt) has parsed out a few + arguments, but we still want the script name to be the first + element. */ +void +scm_set_program_arguments (int argc, char **argv, char *first) +{ + SCM args = scm_makfromstrs (argc, argv); + if (first) + args = scm_cons (scm_from_locale_string (first), args); + scm_fluid_set_x (progargs_fluid, args); +} + + + + +void +scm_init_feature() +{ + progargs_fluid = scm_permanent_object (scm_make_fluid ()); + + features_var = scm_c_define ("*features*", SCM_EOL); +#ifndef _Windows + scm_add_feature("system"); +#endif +#ifdef vms + scm_add_feature(s_ed); +#endif +#ifdef SICP + scm_add_feature("sicp"); +#endif +#ifndef GO32 + scm_add_feature("char-ready?"); +#endif +#ifndef CHEAP_CONTINUATIONS + scm_add_feature ("full-continuation"); +#endif +#if SCM_USE_PTHREAD_THREADS + scm_add_feature ("threads"); +#endif + + scm_c_define ("char-code-limit", scm_from_int (SCM_CHAR_CODE_LIMIT)); + +#include "libguile/feature.x" +} + +/* + Local Variables: + c-file-style: "gnu" + End: +*/