-/* Copyright (C) 1995,1996,1998 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002 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
* 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. */
-\f
-
-#include <stdio.h>
-#include "_scm.h"
-#include "eval.h"
-#include "feature.h"
+\f
+#if HAVE_CONFIG_H
+# include <config.h>
+#endif
#ifdef HAVE_STRING_H
#include <string.h>
#endif
+
+#include "libguile/_scm.h"
+#include "libguile/root.h"
+#include "libguile/strings.h"
+#include "libguile/validate.h"
+
+#include "libguile/feature.h"
+
\f
-static SCM *scm_loc_features;
+static SCM features_var;
+
void
-scm_add_feature(str)
- char* str;
+scm_add_feature (const char *str)
{
- *scm_loc_features = scm_cons(SCM_CAR(scm_intern(str, strlen(str))),
- *scm_loc_features);
+ SCM old = SCM_VARIABLE_REF (features_var);
+ SCM new = scm_cons (scm_str2symbol (str), old);
+ SCM_VARIABLE_SET (features_var, new);
}
-
\f
-SCM_PROC(s_program_arguments, "program-arguments", 0, 0, 0, scm_program_arguments);
-SCM
-scm_program_arguments ()
+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_progargs;
}
+#undef FUNC_NAME
/* Set the value returned by program-arguments, given ARGC and ARGV.
arguments, but we still want the script name to be the first
element. */
void
-scm_set_program_arguments (argc, argv, first)
- int argc;
- char **argv;
- char *first;
+scm_set_program_arguments (int argc, char **argv, char *first)
{
scm_progargs = scm_makfromstrs (argc, argv);
if (first)
\f
-/* Hooks */
-
-SCM_SYMBOL (scm_sym_hook, "hook");
-
-SCM_PROC (s_make_hook, "make-hook", 0, 0, 0, scm_make_hook);
-
-SCM
-scm_make_hook ()
-{
- return scm_cons (scm_sym_hook, SCM_EOL);
-}
-
-SCM
-scm_make_named_hook (char* name)
-{
- SCM hook = scm_make_hook ();
- scm_permanent_object (scm_sysintern (name, hook));
- return hook;
-}
-
-SCM_PROC (s_add_hook_x, "add-hook!", 2, 1, 0, scm_add_hook_x);
-
-SCM
-scm_add_hook_x (SCM hook, SCM thunk, SCM append_p)
-{
- SCM rest;
- SCM_ASSERT (SCM_NIMP (hook)
- && SCM_CONSP (hook)
- && SCM_CAR (hook) == scm_sym_hook
- && scm_ilength (SCM_CDR (hook)) >= 0,
- hook, SCM_ARG1, s_add_hook_x);
- SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)),
- thunk, SCM_ARG2, s_add_hook_x);
- rest = scm_delq_x (thunk, SCM_CDR (hook));
- SCM_SETCDR (hook, (!SCM_UNBNDP (append_p) && SCM_NFALSEP (append_p)
- ? scm_append_x (SCM_LIST2 (rest, SCM_LIST1 (thunk)))
- : scm_cons (thunk, rest)));
- return SCM_UNSPECIFIED;
-}
-
-SCM_PROC (s_remove_hook_x, "remove-hook!", 2, 0, 0, scm_remove_hook_x);
-
-SCM
-scm_remove_hook_x (SCM hook, SCM thunk)
-{
- SCM_ASSERT (SCM_NIMP (hook)
- && SCM_CONSP (hook)
- && SCM_CAR (hook) == scm_sym_hook
- && scm_ilength (SCM_CDR (hook)) >= 0,
- hook, SCM_ARG1, s_add_hook_x);
- SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)),
- thunk, SCM_ARG2, s_add_hook_x);
- SCM_SETCDR (hook, scm_delq_x (thunk, SCM_CDR (hook)));
- return SCM_UNSPECIFIED;
-}
-
-SCM_PROC (s_run_hooks, "run-hooks", 1, 0, 0, scm_run_hooks);
-
-SCM
-scm_run_hooks (SCM hook)
-{
- SCM_ASSERT (SCM_NIMP (hook)
- && SCM_CONSP (hook)
- && SCM_CAR (hook) == scm_sym_hook
- && scm_ilength (SCM_CDR (hook)) >= 0,
- hook, SCM_ARG1, s_add_hook_x);
- while (SCM_NIMP (hook = SCM_CDR (hook)))
- scm_apply (SCM_CAR (hook), SCM_EOL, SCM_EOL);
- return SCM_UNSPECIFIED;
-}
-
-\f
void
scm_init_feature()
{
- scm_loc_features = SCM_CDRLOC (scm_sysintern ("*features*", SCM_EOL));
-#ifdef SCM_RECKLESS
- scm_add_feature("reckless");
-#endif
+ features_var = scm_c_define ("*features*", SCM_EOL);
#ifndef _Windows
scm_add_feature("system");
#endif
#ifndef CHEAP_CONTINUATIONS
scm_add_feature ("full-continuation");
#endif
-#ifdef USE_THREADS
+#ifndef SCM_USE_NULL_THREADS
scm_add_feature ("threads");
#endif
- scm_sysintern ("char-code-limit", SCM_MAKINUM (SCM_CHAR_CODE_LIMIT));
-#include "feature.x"
+ scm_c_define ("char-code-limit", SCM_MAKINUM (SCM_CHAR_CODE_LIMIT));
+
+#include "libguile/feature.x"
}
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/