From b5e6483d3823d197e5c20d574487db5e916a8555 Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Fri, 17 Feb 2006 17:14:05 +0000 Subject: Fixes for `when-engine-is-loaded'. * src/guile/skribilo/engine.scm (consume-load-hook!): New. (when-engine-is-loaded): Call `consume-load-hook!' when `engine-loaded?' returns true. (lookup-engine): Use `consume-load-hook!'. git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-50 --- src/guile/skribilo/engine.scm | 28 +++++++++++++++++++--------- 1 file changed, 19 insertions(+), 9 deletions(-) (limited to 'src') diff --git a/src/guile/skribilo/engine.scm b/src/guile/skribilo/engine.scm index 83528a9..5800486 100644 --- a/src/guile/skribilo/engine.scm +++ b/src/guile/skribilo/engine.scm @@ -195,15 +195,30 @@ `(skribilo engine ,id)) (define (engine-loaded? id) - (nested-ref the-root-module (engine-id->module-name id))) + "Check whether engine @var{id} is already loaded." + ;; Trick taken from `resolve-module' in `boot-9.scm'. + (nested-ref the-root-module + `(%app modules ,@(engine-id->module-name id)))) ;; A mapping of engine names to hooks. (define %engine-load-hook (make-hash-table)) +(define (consume-load-hook! id) + (with-debug 5 'consume-load-hook! + (let ((hook (hashq-ref %engine-load-hook id))) + (if hook + (begin + (debug-item "running hook " hook " for engine " id) + (hashq-remove! %engine-load-hook id) + (run-hook hook)))))) + (define (when-engine-is-loaded id thunk) "Run @var{thunk} only when engine with identifier @var{id} is loaded." (if (engine-loaded? id) - (thunk) + (begin + ;; Maybe the engine had already been loaded via `use-modules'. + (consume-load-hook! id) + (thunk)) (let ((hook (or (hashq-ref %engine-load-hook id) (let ((hook (make-hook))) (hashq-set! %engine-load-hook id hook) @@ -219,15 +234,10 @@ otherwise the requested engine is returned." (debug-item "id=" id " version=" version) (let* ((engine (symbol-append id '-engine)) - (m (resolve-module (engine-id->module-name id))) - (hook (hashq-ref %engine-load-hook id))) + (m (resolve-module (engine-id->module-name id)))) (if (module-bound? m engine) (let ((e (module-ref m engine))) - (if (and e hook) - (begin - ;; consume the hook - (run-hook hook) - (hashq-remove! %engine-load-hook id))) + (if e (consume-load-hook! id)) e) (error "no such engine" id))))) -- cgit v1.2.3