From 3b3085c69294a4225bd9ce96408ff05977ecc6e3 Mon Sep 17 00:00:00 2001 From: Mikael Djurfeldt Date: Tue, 1 Dec 1998 11:28:24 +0000 Subject: [PATCH] * boot-9.scm (*suppress-old-style-hook-warning*): Set this to #t if you don't want the old style hook warnings. --- ice-9/ChangeLog | 5 +++++ ice-9/boot-9.scm | 8 ++++++-- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 5cf88b70b..88706cf5a 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,8 @@ +1998-12-01 Mikael Djurfeldt + + * 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 * 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 846960702..d2e28485f 100644 --- 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))))))))))