mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 20:30:28 +02:00
Code Activity

* boot-9.scm: Use run-hook instead of run-hooks everywhere.

Browse source
This commit is contained in:
Mikael Djurfeldt 1998-11-26 08:31:02 +00:00
parent 0d2e4c1bec
commit 04efd24d82
1 changed files with 11 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -559,15 +559,14 @@
;;; procedures. This interface is only provided for backward compatibility ;;; procedures. This interface is only provided for backward compatibility
;;; and will be removed. ;;; and will be removed.
;;; ;;;
(if (not (defined? 'new-run-hooks)) (if (not (defined? 'new-add-hook!))
(begin (begin
(define new-run-hooks run-hooks)
(define new-add-hook! add-hook!) (define new-add-hook! add-hook!)
(define new-remove-hook! remove-hook!))) (define new-remove-hook! remove-hook!)))
(define (run-hooks hook) (define (run-hooks hook)
(if (and (pair? hook) (eq? (car hook) 'hook)) (if (and (pair? hook) (eq? (car hook) 'hook))
(new-run-hooks hook) (run-hook hook)
(for-each (lambda (thunk) (thunk)) hook))) (for-each (lambda (thunk) (thunk)) hook)))
(define add-hook! (define add-hook!
@ -2522,7 +2521,7 @@
;; (set! first #f) above ;; (set! first #f) above
;; ;;
(lambda () (lambda ()
(run-hooks abort-hook) (run-hook abort-hook)
(force-output) (force-output)
(display "ABORT: " (current-error-port)) (display "ABORT: " (current-error-port))
(write args (current-error-port)) (write args (current-error-port))
@ -2587,14 +2586,14 @@
(let ((cep (current-error-port))) (let ((cep (current-error-port)))
(cond ((not (stack? (fluid-ref the-last-stack)))) (cond ((not (stack? (fluid-ref the-last-stack))))
((memq 'backtrace (debug-options-interface)) ((memq 'backtrace (debug-options-interface))
(run-hooks before-backtrace-hook) (run-hook before-backtrace-hook)
(newline cep) (newline cep)
(display-backtrace (fluid-ref the-last-stack) cep) (display-backtrace (fluid-ref the-last-stack) cep)
(newline cep) (newline cep)
(run-hooks after-backtrace-hook))) (run-hook after-backtrace-hook)))
(run-hooks before-error-hook) (run-hook before-error-hook)
(apply display-error (fluid-ref the-last-stack) cep args) (apply display-error (fluid-ref the-last-stack) cep args)
(run-hooks after-error-hook) (run-hook after-error-hook)
(force-output cep) (force-output cep)
(throw 'abort key))) (throw 'abort key)))
@ -2636,7 +2635,7 @@
(lambda (prompt) (lambda (prompt)
(display prompt) (display prompt)
(force-output) (force-output)
(run-hooks before-read-hook) (run-hook before-read-hook)
(read (current-input-port)))) (read (current-input-port))))
(define (scm-style-repl) (define (scm-style-repl)
@ -2688,7 +2687,7 @@
;; trailing newline here, as well as any whitespace ;; trailing newline here, as well as any whitespace
;; before it. ;; before it.
(consume-trailing-whitespace) (consume-trailing-whitespace)
(run-hooks after-read-hook) (run-hook after-read-hook)
(if (eof-object? val) (if (eof-object? val)
(begin (begin
(repl-report-start-timing) (repl-report-start-timing)
@ -3015,7 +3014,7 @@
(not (and (module-defined? the-root-module (not (and (module-defined? the-root-module
'use-emacs-interface) 'use-emacs-interface)
use-emacs-interface))) use-emacs-interface)))
(let ((read-hook (lambda () (run-hooks before-read-hook)))) (let ((read-hook (lambda () (run-hook before-read-hook))))
(set-current-input-port (readline-port)) (set-current-input-port (readline-port))
(set! repl-reader (set! repl-reader
(lambda (prompt) (lambda (prompt)
@ -3028,7 +3027,7 @@
(set-readline-prompt! "") (set-readline-prompt! "")
(set-readline-read-hook! #f))))))) (set-readline-read-hook! #f)))))))
(let ((status (scm-style-repl))) (let ((status (scm-style-repl)))
(run-hooks exit-hook) (run-hook exit-hook)
status)) status))
;; call at exit. ;; call at exit.