mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

* feature.c, feature.h (scm_make_hook, scm_add_hook_x,

Browse source 
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".
This commit is contained in:
Mikael Djurfeldt 1998-11-23 02:34:49 +00:00
parent 7e41462735
commit 1330700c7d
2 changed files with 83 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

74
libguile/feature.c
View file

@ -43,6 +43,8 @@
#include <stdio.h>
#include "_scm.h"
#include "eval.h"
#include "feature.h"
#ifdef HAVE_STRING_H
@ -88,6 +90,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

14
libguile/feature.h
View file

@ -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 */