summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>1998-11-23 02:34:49 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>1998-11-23 02:34:49 +0000
commit1330700c7d48982bfb0e22e47225b6ea7df0fd03 (patch)
treee4c3416fbee237dad6158baac9961220c4543304 /libguile
parent7e4146273589131ba1450f54cdab9e6236655569 (diff)
downloadguile-1330700c7d48982bfb0e22e47225b6ea7df0fd03.tar.gz
* feature.c, feature.h (scm_make_hook, scm_add_hook_x,
scm_remove_hook_x, scm_run_hooks): Moved from ice-9/boot-9.scm. (scm_make_named_hook): New function. * feature.c: Added #include "eval.h".
Diffstat (limited to 'libguile')
-rw-r--r--libguile/feature.c74
-rw-r--r--libguile/feature.h14
2 files changed, 83 insertions, 5 deletions
diff --git a/libguile/feature.c b/libguile/feature.c
index 965ee530d..0b67918c6 100644
--- a/libguile/feature.c
+++ b/libguile/feature.c
@@ -43,6 +43,8 @@
#include <stdio.h>
#include "_scm.h"
+#include "eval.h"
+
#include "feature.h"
#ifdef HAVE_STRING_H
@@ -89,6 +91,78 @@ scm_set_program_arguments (argc, argv, first)
+/* 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;
+}
+
+
void
scm_init_feature()
diff --git a/libguile/feature.h b/libguile/feature.h
index 7b24d06a6..aec777254 100644
--- a/libguile/feature.h
+++ b/libguile/feature.h
@@ -46,10 +46,14 @@
#include "libguile/__scm.h"
-extern void scm_add_feature SCM_P((char* str));
-extern SCM scm_program_arguments SCM_P((void));
-extern void scm_set_program_arguments SCM_P ((int argc, char **argv,
- char *first));
-extern void scm_init_feature SCM_P((void));
+extern void scm_add_feature (char* str);
+extern SCM scm_program_arguments (void);
+extern void scm_set_program_arguments (int argc, char **argv, char *first);
+extern SCM scm_make_hook (void);
+extern SCM scm_make_named_hook (char* name);
+extern SCM scm_add_hook_x (SCM hook, SCM thunk, SCM appendp);
+extern SCM scm_remove_hook_x (SCM hook, SCM thunk);
+extern SCM scm_run_hooks (SCM hooks);
+extern void scm_init_feature (void);
#endif /* FEATUREH */