mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

* The name property of hooks is deprecated.

Browse source
This commit is contained in:
Dirk Herrmann 2000-05-26 16:31:22 +00:00
parent 6a63e24726
commit e11f8b42f2
9 changed files with 69 additions and 39 deletions
Download patch file Download diff file Expand all files Collapse all files

5
NEWS
View file

@ -234,6 +234,11 @@ E.g., in order to set bit 7 in an SCM value x, use the expression
SCM_PACK (SCM_UNPACK (x) | 0x80)
** The name property of hooks is deprecated.
Thus, the use of SCM_HOOK_NAME and scm_make_hook_with_name is deprecated.
You can emulate this feature by using object properties.
** Deprecated macros: SCM_INPORTP, SCM_OUTPORTP, SCM_CRDY, SCM_ICHRP,
SCM_ICHR, SCM_MAKICHR, SCM_SETJMPBUF, SCM_NSTRINGP, SCM_NRWSTRINGP,
SCM_NVECTORP

2
RELEASE
View file

@ -24,6 +24,8 @@ In release 1.5:
- remove gh_int2scmb (replaced by gh_bool2scm)
- remove scm_fseek (replaced by scm_seek)
- remove scm_tag
- remove code related to the name property of hooks. Also, check init.c,
since the dependency between hooks and objprop will then be eliminated.
Dirk:FIXME:: look into deprecated things in numbers.h and tags.h, don't forget
to update NEWS accordingly.

15
libguile/ChangeLog
View file

@ -1,3 +1,18 @@
2000-05-26 Dirk Herrmann <D.Herrmann@tu-bs.de>
* gc.c (scm_init_gc): Protect scm_after_gc_hook, since this will
soon not be done by scm_create_hook any longer.
* hooks.c (make_hook, print_hook, scm_create_hook,
scm_make_hook_with_name, scm_make_hook), hooks.h (SCM_HOOK_NAME,
SCM_HOOK_PROCEDURES, SCM_SET_HOOK_PROCEDURES,
scm_make_hook_with_name), init.c (scm_boot_guile_1): Hooks no
longer have names. As an intermediate solution, the name
predicate is emulated via object properties, but use of this
feature is deprecated.
* hooks.h (scm_free_hook): Removed, as it is never defined.
2000-05-25 Dirk Herrmann <D.Herrmann@tu-bs.de>
* numbers.[ch] (SCM_POSFIXABLE, SCM_NEGFIXABLE, SCM_FIXABLE):

1
libguile/gc.c
View file

@ -2340,6 +2340,7 @@ void
scm_init_gc ()
{
scm_after_gc_hook = scm_create_hook ("after-gc-hook", 0);
scm_protect_object (scm_after_gc_hook);
#include "libguile/gc.x"
}

50
libguile/hooks.c
View file

@ -49,6 +49,7 @@
#include "libguile/eval.h"
#include "libguile/ports.h"
#include "libguile/objprop.h"
#include "libguile/procprop.h"
#include "libguile/root.h"
#include "libguile/smob.h"
@ -142,32 +143,30 @@ scm_c_hook_run (scm_c_hook_t *hook, void *data)
* 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 exist to aid debugging and are not intended
* to be used in programs.
*
* Hook arity is not a full member of this type and therefore lacks an
* accessor. It exists to aid debugging and is not intended to be used in
* programs.
*/
long scm_tc16_hook;
static SCM
make_hook (SCM name, SCM n_args, const char *subr)
make_hook (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;
{
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_ASSERT (n >= 0 && n <= 16, n_args, SCM_OUTOFRANGE, subr);
SCM_RETURN_NEWSMOB (scm_tc16_hook + (n << 16), SCM_UNPACK (SCM_LIST1 (name)));
SCM_RETURN_NEWSMOB (scm_tc16_hook + (n << 16), SCM_EOL);
}
@ -176,11 +175,6 @@ 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);
@ -204,30 +198,42 @@ 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 hook = make_hook (SCM_MAKINUM (n_args), "scm_create_hook");
SCM_SETCDR (vcell, hook);
#if (SCM_DEBUG_DEPRECATED == 0)
scm_set_object_property_x (hook, scm_makfrom0str ("name"), scm_makfrom0str (name));
scm_protect_object (vcell);
#endif /* SCM_DEBUG_DEPRECATED == 0 */
return hook;
}
#if (SCM_DEBUG_DEPRECATED == 0)
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);
SCM hook = make_hook (n_args, FUNC_NAME);
scm_set_object_property_x (hook, scm_makfrom0str ("name"), name);
return hook;
}
#undef FUNC_NAME
#endif /* SCM_DEBUG_DEPRECATED == 0 */
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);
return make_hook (n_args, FUNC_NAME);
}
#undef FUNC_NAME
@ -271,7 +277,7 @@ SCM_DEFINE (scm_add_hook_x, "add-hook!", 2, 1, 0,
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_UNBNDP (append_p) && !SCM_FALSEP (append_p)
? scm_append_x (SCM_LIST2 (rest, SCM_LIST1 (proc)))
: scm_cons (proc, rest)));
return SCM_UNSPECIFIED;

17
libguile/hooks.h
View file

@ -98,16 +98,13 @@ extern void *scm_c_hook_run (scm_c_hook_t *hook, void *data);
#define SCM_HOOKP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_hook))
#define SCM_HOOK_ARITY(hook) (SCM_CELL_WORD_0 (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)
#define SCM_HOOK_PROCEDURES(hook) SCM_CELL_OBJECT_1 (hook)
#define SCM_SET_HOOK_PROCEDURES(hook, procs) SCM_SET_CELL_OBJECT_1 ((hook), (procs))
extern long scm_tc16_hook;
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_hook_p (SCM x);
extern SCM scm_hook_empty_p (SCM hook);
extern SCM scm_add_hook_x (SCM hook, SCM thunk, SCM appendp);
@ -118,6 +115,16 @@ extern void scm_c_run_hook (SCM hook, SCM args);
extern SCM scm_hook_to_list (SCM hook);
extern void scm_init_hooks (void);
#if (SCM_DEBUG_DEPRECATED == 0)
/* Use scm_set_object_property_x to set the name property of a hook: */
#define SCM_HOOK_NAME(h) scm_object_property (h, scm_makfrom0str ("name"))
extern SCM scm_make_hook_with_name (SCM name, SCM n_args);
#endif /* SCM_DEBUG_DEPRECATED == 0 */
#endif /* HOOKSH */
/*

4
libguile/init.c
View file

@ -511,7 +511,8 @@ scm_boot_guile_1 (SCM_STACKITEM *base, struct main_func_closure *closure)
scm_init_gdbint ();
scm_init_hash ();
scm_init_hashtab ();
scm_init_hooks ();
scm_init_objprop ();
scm_init_hooks (); /* Requires objprop until hook names are removed */
scm_init_gc (); /* Requires hooks */
#ifdef GUILE_ISELECT
scm_init_iselect ();
@ -523,7 +524,6 @@ scm_boot_guile_1 (SCM_STACKITEM *base, struct main_func_closure *closure)
scm_init_mallocs ();
scm_init_modules ();
scm_init_numbers ();
scm_init_objprop ();
scm_init_options ();
scm_init_pairs ();
scm_init_ports ();

4
test-suite/ChangeLog
View file

@ -1,3 +1,7 @@
2000-05-26 Dirk Herrmann <D.Herrmann@tu-bs.de>
* tests/hooks.test: make-hook-with-name is deprecated.
2000-05-08 Dirk Herrmann <D.Herrmann@tu-bs.de>
* tests/list.test, tests/numbers.test: Added.

10
test-suite/tests/hooks.test
View file

@ -136,16 +136,6 @@
(and (eq? (car val) 'i-sunk-your-battleship)
(eq? (cdr val) 'no-way!)))))
(pass-if "make-hook-with-name"
(catch-error-returning-false
#t
(let ((x (make-hook-with-name 'x 1)))
(add-hook! x proc1))))
(pass-if "make-hook-with-name: bad name"
(catch-error-returning-true
'wrong-type-arg
(define x (make-hook-with-name '(a b) 1))))
(with-test-prefix "remove-hook!"
(pass-if ""
(let ((x (make-hook 1)))