mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-05 19:50:23 +02:00
Code Activity

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

Browse source 
if you don't want the old style hook warnings.
This commit is contained in:
Mikael Djurfeldt 1998-12-01 11:28:24 +00:00
parent 49e5d550cb
commit 3b3085c692
2 changed files with 11 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

5
ice-9/ChangeLog
View file

@ -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> 1998-12-01 Christian Lynbech <chl@tbit.dk>
* boot-9.scm (try-using-libtool-name): Fix check on dlname to make * boot-9.scm (try-using-libtool-name): Fix check on dlname to make

8
ice-9/boot-9.scm
View file

@ -569,6 +569,8 @@
(run-hook hook) (run-hook hook)
(for-each (lambda (thunk) (thunk)) hook))) (for-each (lambda (thunk) (thunk)) hook)))
(define *suppress-old-style-hook-warning* #f)
(define add-hook! (define add-hook!
(procedure->memoizing-macro (procedure->memoizing-macro
(lambda (exp env) (lambda (exp env)
@ -576,7 +578,8 @@
(if (and (pair? hook) (eq? (car hook) 'hook)) (if (and (pair? hook) (eq? (car hook) 'hook))
`(new-add-hook! ,@(cdr exp)) `(new-add-hook! ,@(cdr exp))
(begin (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))) `(let ((thunk ,(caddr exp)))
(if (not (memq thunk ,(cadr exp))) (if (not (memq thunk ,(cadr exp)))
(set! ,(cadr exp) (set! ,(cadr exp)
@ -589,7 +592,8 @@
(if (and (pair? hook) (eq? (car hook) 'hook)) (if (and (pair? hook) (eq? (car hook) 'hook))
`(new-remove-hook! ,@(cdr exp)) `(new-remove-hook! ,@(cdr exp))
(begin (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))) `(let ((thunk ,(caddr exp)))
(set! ,(cadr exp) (set! ,(cadr exp)
(delq! thunk ,(cadr exp)))))))))) (delq! thunk ,(cadr exp))))))))))