* boot-9.scm (*suppress-old-style-hook-warning*): Set this to #t

if you don't want the old style hook warnings.

diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index 5cf88b7..88706cf 100644 (file)
--- a/ice-9/ChangeLog
+++ b/ice-9/ChangeLog
@@ -1,3 +1,8 @@
+1998-12-01  Mikael Djurfeldt  <mdj@mdj.nada.kth.se>
+
+       * boot-9.scm (*suppress-old-style-hook-warning*): Set this to #t
+       if you don't want the old style hook warnings.
+
 1998-12-01  Christian Lynbech  <chl@tbit.dk>
 
        * boot-9.scm (try-using-libtool-name): Fix check on dlname to make

diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index 8469607..d2e2848 100644 (file)
--- a/ice-9/boot-9.scm
+++ b/ice-9/boot-9.scm
@@ -569,6 +569,8 @@
       (run-hook hook)
       (for-each (lambda (thunk) (thunk)) hook)))
 
+(define *suppress-old-style-hook-warning* #f)
+
 (define add-hook!
   (procedure->memoizing-macro
     (lambda (exp env)
@@ -576,7 +578,8 @@
        (if (and (pair? hook) (eq? (car hook) 'hook))
            `(new-add-hook! ,@(cdr exp))
            (begin
-             (display "Warning: Old style hooks\n" (current-error-port))
+             (or *suppress-old-style-hook-warning*
+                 (display "Warning: Old style hooks\n" (current-error-port)))
              `(let ((thunk ,(caddr exp)))
                 (if (not (memq thunk ,(cadr exp)))
                     (set! ,(cadr exp)
@@ -589,7 +592,8 @@
        (if (and (pair? hook) (eq? (car hook) 'hook))
            `(new-remove-hook! ,@(cdr exp))
            (begin
-             (display "Warning: Old style hooks\n" (current-error-port))
+             (or *suppress-old-style-hook-warning*
+                 (display "Warning: Old style hooks\n" (current-error-port)))
              `(let ((thunk ,(caddr exp)))
                     (set! ,(cadr exp)
                           (delq! thunk ,(cadr exp))))))))))