* The name property of hooks is deprecated.

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

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.
 

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):

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"
 }
 

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
+ * Hook arity is not a full member of this type and therefore lacks an
- * lack accessors.  They exist to aid debugging and are not intended
+ * accessor.  It exists to aid debugging and is not intended to be used in
- * to be used in programs.
+ * 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_EOL);
-  SCM_RETURN_NEWSMOB (scm_tc16_hook + (n << 16), SCM_UNPACK (SCM_LIST1 (name)));
 }
 
 
@@ -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 hook = make_hook (SCM_MAKINUM (n_args), "scm_create_hook");
-			"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;

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_CELL_OBJECT_1 (hook)
-#define SCM_HOOK_PROCEDURES(hook) SCM_CDDR (hook)
+#define SCM_SET_HOOK_PROCEDURES(hook, procs) SCM_SET_CELL_OBJECT_1 ((hook), (procs))
-#define SCM_SET_HOOK_PROCEDURES(hook, procs) SCM_SETCDR (SCM_CDR (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 */
 
 /*

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 ();

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.

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)))