mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
* feature.c, feature.h: Broke out hook code into separate files.
This commit is contained in:
Mikael Djurfeldt
parent
7157d7a90a
commit
87694b930c
2 changed files with 2 additions and 246 deletions
|
|
@ -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"
|
||||
|
|
@ -98,222 +95,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
|
||||
|
|
@ -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"
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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 */
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue