diff options
-rw-r--r-- | NEWS | 5 | ||||
-rw-r--r-- | RELEASE | 2 | ||||
-rw-r--r-- | libguile/ChangeLog | 15 | ||||
-rw-r--r-- | libguile/gc.c | 1 | ||||
-rw-r--r-- | libguile/hooks.c | 50 | ||||
-rw-r--r-- | libguile/hooks.h | 17 | ||||
-rw-r--r-- | libguile/init.c | 4 | ||||
-rw-r--r-- | test-suite/ChangeLog | 4 | ||||
-rw-r--r-- | test-suite/tests/hooks.test | 10 |
9 files changed, 69 insertions, 39 deletions
@@ -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 @@ -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. diff --git a/libguile/ChangeLog b/libguile/ChangeLog index f58e4a886..d738ed86a 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -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): diff --git a/libguile/gc.c b/libguile/gc.c index 9c90dc31c..4100338dd 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -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" } diff --git a/libguile/hooks.c b/libguile/hooks.c index 7ec54766e..fc46c6138 100644 --- a/libguile/hooks.c +++ b/libguile/hooks.c @@ -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; diff --git a/libguile/hooks.h b/libguile/hooks.h index c61a292fd..6d898db86 100644 --- a/libguile/hooks.h +++ b/libguile/hooks.h @@ -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 */ /* diff --git a/libguile/init.c b/libguile/init.c index 42fba5226..c7d547d11 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -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 (); diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 539084815..e0a92a011 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -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. diff --git a/test-suite/tests/hooks.test b/test-suite/tests/hooks.test index bdd5e58e2..21a357122 100644 --- a/test-suite/tests/hooks.test +++ b/test-suite/tests/hooks.test @@ -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))) |