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