summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>2000-04-21 23:11:05 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>2000-04-21 23:11:05 +0000
commit87694b930cbc3be9b29d3f4a3dd455617b58c32c (patch)
tree35a4f1046ed78ea3a0f86cea8b3d66b84995ddee
parent7157d7a90abc706f428147b21ddfd0889b2fb553 (diff)
downloadguile-87694b930cbc3be9b29d3f4a3dd455617b58c32c.tar.gz
* feature.c, feature.h: Broke out hook code into separate files.
-rw-r--r--libguile/feature.c225
-rw-r--r--libguile/feature.h23
2 files changed, 2 insertions, 246 deletions
diff --git a/libguile/feature.c b/libguile/feature.c
index 7c2598105..e05a10115 100644
--- a/libguile/feature.c
+++ b/libguile/feature.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 1996, 1998, 1999 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 1998, 1999, 2000 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
@@ -47,9 +47,6 @@
#include <stdio.h>
#include "libguile/_scm.h"
-#include "libguile/eval.h"
-#include "libguile/ports.h"
-#include "libguile/procprop.h"
#include "libguile/root.h"
#include "libguile/smob.h"
#include "libguile/strings.h"
@@ -99,222 +96,6 @@ scm_set_program_arguments (int argc, char **argv, char *first)
-/* Hooks
- *
- * A hook is basically a list of procedures to be called at well defined
- * points in time.
- *
- * Hook name and arity are not full members of this type and therefore
- * lack accessors. They are added to aid debugging and are not
- * intended to be used in programs.
- *
- */
-
-long scm_tc16_hook;
-
-
-static SCM
-make_hook (SCM name, SCM n_args, const char *subr)
-{
- int n;
- SCM_ASSERT (SCM_FALSEP (name) || (SCM_SYMBOLP (name)),
- name,
- SCM_ARG1,
- subr);
- if (SCM_UNBNDP (n_args))
- n = 0;
- else
- {
- SCM_ASSERT (SCM_INUMP (n_args), n_args, SCM_ARGn, subr);
- n = SCM_INUM (n_args);
- }
- SCM_ASSERT (n >= 0 && n <= 16, n_args, SCM_OUTOFRANGE, subr);
- SCM_RETURN_NEWSMOB (scm_tc16_hook + (n << 16), SCM_UNPACK (SCM_LIST1 (name)));
-}
-
-
-static int
-print_hook (SCM hook, SCM port, scm_print_state *pstate)
-{
- SCM ls, name;
- scm_puts ("#<hook ", port);
- if (SCM_NFALSEP (SCM_HOOK_NAME (hook)))
- {
- scm_iprin1 (SCM_HOOK_NAME (hook), port, pstate);
- scm_putc (' ', port);
- }
- scm_intprint (SCM_HOOK_ARITY (hook), 10, port);
- scm_putc (' ', port);
- scm_intprint (SCM_UNPACK (hook), 16, port);
- ls = SCM_HOOK_PROCEDURES (hook);
- while (SCM_NIMP (ls))
- {
- scm_putc (' ', port);
- name = scm_procedure_name (SCM_CAR (ls));
- if (SCM_NFALSEP (name))
- scm_iprin1 (name, port, pstate);
- else
- scm_putc ('?', port);
- ls = SCM_CDR (ls);
- }
- scm_putc ('>', port);
- return 1;
-}
-
-
-SCM
-scm_create_hook (const char* name, int n_args)
-{
- SCM vcell = scm_sysintern0 (name);
- SCM hook = make_hook (SCM_CAR (vcell), SCM_MAKINUM (n_args),
- "scm_create_hook");
- SCM_SETCDR (vcell, hook);
- scm_protect_object (vcell);
- return hook;
-}
-
-
-/* This function is deprecated. It will be removed in next release. */
-SCM
-scm_make_named_hook (const char* name, int n_args)
-{
- return scm_create_hook (name, n_args);
-}
-
-
-SCM_DEFINE (scm_make_hook_with_name, "make-hook-with-name", 1, 1, 0,
- (SCM name, SCM n_args),
-"")
-#define FUNC_NAME s_scm_make_hook_with_name
-{
- return make_hook (name, n_args, FUNC_NAME);
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_make_hook, "make-hook", 0, 1, 0,
- (SCM n_args),
-"")
-#define FUNC_NAME s_scm_make_hook
-{
- return make_hook (SCM_BOOL_F, n_args, FUNC_NAME);
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_hook_p, "hook?", 1, 0, 0,
- (SCM x),
-"")
-#define FUNC_NAME s_scm_hook_p
-{
- return SCM_BOOL(SCM_HOOKP (x));
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_hook_empty_p, "hook-empty?", 1, 0, 0,
- (SCM hook),
-"")
-#define FUNC_NAME s_scm_hook_empty_p
-{
- SCM_VALIDATE_HOOK (1,hook);
- return SCM_BOOL(SCM_NULLP (SCM_HOOK_PROCEDURES (hook)));
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_add_hook_x, "add-hook!", 2, 1, 0,
- (SCM hook, SCM proc, SCM append_p),
-"")
-#define FUNC_NAME s_scm_add_hook_x
-{
- SCM arity, rest;
- int n_args;
- SCM_VALIDATE_HOOK (1,hook);
- SCM_ASSERT (SCM_NFALSEP (arity = scm_i_procedure_arity (proc)),
- proc, SCM_ARG2, FUNC_NAME);
- n_args = SCM_HOOK_ARITY (hook);
- if (SCM_INUM (SCM_CAR (arity)) > n_args
- || (SCM_FALSEP (SCM_CADDR (arity))
- && (SCM_INUM (SCM_CAR (arity)) + SCM_INUM (SCM_CADR (arity))
- < n_args)))
- scm_wrong_type_arg (FUNC_NAME, 2, proc);
- rest = scm_delq_x (proc, SCM_HOOK_PROCEDURES (hook));
- SCM_SET_HOOK_PROCEDURES (hook,
- (!SCM_UNBNDP (append_p) && SCM_NFALSEP (append_p)
- ? scm_append_x (SCM_LIST2 (rest, SCM_LIST1 (proc)))
- : scm_cons (proc, rest)));
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_remove_hook_x, "remove-hook!", 2, 0, 0,
- (SCM hook, SCM proc),
-"")
-#define FUNC_NAME s_scm_remove_hook_x
-{
- SCM_VALIDATE_HOOK (1,hook);
- SCM_SET_HOOK_PROCEDURES (hook,
- scm_delq_x (proc, SCM_HOOK_PROCEDURES (hook)));
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_reset_hook_x, "reset-hook!", 1, 0, 0,
- (SCM hook),
-"")
-#define FUNC_NAME s_scm_reset_hook_x
-{
- SCM_VALIDATE_HOOK (1,hook);
- SCM_SET_HOOK_PROCEDURES (hook, SCM_EOL);
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_run_hook, "run-hook", 1, 0, 1,
- (SCM hook, SCM args),
-"")
-#define FUNC_NAME s_scm_run_hook
-{
- SCM_VALIDATE_HOOK (1,hook);
- if (SCM_UNBNDP (args))
- args = SCM_EOL;
- if (scm_ilength (args) != SCM_HOOK_ARITY (hook))
- SCM_MISC_ERROR ("Hook ~S requires ~A arguments",
- SCM_LIST2 (hook,SCM_MAKINUM (SCM_HOOK_ARITY (hook))));
- scm_c_run_hook (hook, args);
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-void
-scm_c_run_hook (SCM hook, SCM args)
-{
- SCM procs = SCM_HOOK_PROCEDURES (hook);
- while (SCM_NIMP (procs))
- {
- scm_apply (SCM_CAR (procs), args, SCM_EOL);
- procs = SCM_CDR (procs);
- }
-}
-
-
-SCM_DEFINE (scm_hook_to_list, "hook->list", 1, 0, 0,
- (SCM hook),
-"")
-#define FUNC_NAME s_scm_hook_to_list
-{
- SCM_VALIDATE_HOOK (1,hook);
- return scm_list_copy (SCM_HOOK_PROCEDURES (hook));
-}
-#undef FUNC_NAME
-
-
-
void
scm_init_feature()
@@ -344,10 +125,6 @@ scm_init_feature()
scm_sysintern ("char-code-limit", SCM_MAKINUM (SCM_CHAR_CODE_LIMIT));
- scm_tc16_hook = scm_make_smob_type ("hook", 0);
- scm_set_smob_mark (scm_tc16_hook, scm_markcdr);
- scm_set_smob_print (scm_tc16_hook, print_hook);
-
#include "libguile/feature.x"
}
diff --git a/libguile/feature.h b/libguile/feature.h
index 125e88324..81baa9011 100644
--- a/libguile/feature.h
+++ b/libguile/feature.h
@@ -2,7 +2,7 @@
#ifndef FEATUREH
#define FEATUREH
-/* Copyright (C) 1995, 1996, 1999 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 1999, 2000 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
@@ -49,30 +49,9 @@
#include "libguile/__scm.h"
-#define SCM_HOOKP(x) (SCM_NIMP(x) && (SCM_TYP16 (x) == scm_tc16_hook))
-#define SCM_HOOK_ARITY(hook) (SCM_UNPACK_CAR (hook) >> 16)
-#define SCM_HOOK_NAME(hook) SCM_CADR (hook)
-#define SCM_HOOK_PROCEDURES(hook) SCM_CDDR (hook)
-#define SCM_SET_HOOK_PROCEDURES(hook, procs) SCM_SETCDR (SCM_CDR (hook), procs)
-
-extern long scm_tc16_hook;
-
extern void scm_add_feature (const 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 (SCM n_args);
-extern SCM scm_make_hook_with_name (SCM name, SCM n_args);
-extern SCM scm_create_hook (const char* name, int n_args);
-extern void scm_free_hook (SCM hook);
-extern SCM scm_make_named_hook (const char* name, int n_args);
-extern SCM scm_hook_p (SCM x);
-extern SCM scm_hook_empty_p (SCM hook);
-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_reset_hook_x (SCM hook);
-extern SCM scm_run_hook (SCM hook, SCM args);
-extern void scm_c_run_hook (SCM hook, SCM args);
-extern SCM scm_hook_to_list (SCM hook);
extern void scm_init_feature (void);
#endif /* FEATUREH */