summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--NEWS5
-rw-r--r--RELEASE2
-rw-r--r--libguile/ChangeLog15
-rw-r--r--libguile/gc.c1
-rw-r--r--libguile/hooks.c50
-rw-r--r--libguile/hooks.h17
-rw-r--r--libguile/init.c4
-rw-r--r--test-suite/ChangeLog4
-rw-r--r--test-suite/tests/hooks.test10
9 files changed, 69 insertions, 39 deletions
diff --git a/NEWS b/NEWS
index e46edb4c6..9b5739f55 100644
--- a/NEWS
+++ b/NEWS
@@ -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
diff --git a/RELEASE b/RELEASE
index 0b6a0ac51..d909caadc 100644
--- a/RELEASE
+++ b/RELEASE
@@ -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)))