From 36155810dc2785ad00490e41521d289ff3ef4868 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Fri, 17 Feb 2006 13:51:35 +0000
Subject: Implemented `when-engine-is-loaded'.

* src/guile/skribilo/engine.scm (engine-id->module-name): New.
  (engine-loaded?): New.
  (%engine-load-hook): New.
  (when-engine-is-loaded): New.
  (lookup-engine): Run the engine-load hook when available and consume
  it.

git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-49
---
 src/guile/skribilo/engine.scm | 44 +++++++++++++++++++++++++++++++++++++++----
 1 file changed, 40 insertions(+), 4 deletions(-)

(limited to 'src/guile')

diff --git a/src/guile/skribilo/engine.scm b/src/guile/skribilo/engine.scm
index d747ea0..83528a9 100644
--- a/src/guile/skribilo/engine.scm
+++ b/src/guile/skribilo/engine.scm
@@ -41,7 +41,9 @@
 	   engine-custom engine-custom-set!
 	   engine-format? engine-add-writer!
 	   processor-get-engine
-	   push-default-engine pop-default-engine))
+	   push-default-engine pop-default-engine
+
+	   engine-loaded? when-engine-is-loaded))
 
 
 (fluid-set! current-reader %skribilo-module-reader)
@@ -180,10 +182,35 @@
     new))
 
 
+
 ;;;
-;;;	FIND-ENGINE
+;;; Engine loading.
 ;;;
 
+;; Each engine is to be stored in its own module with the `(skribilo engine)'
+;; hierarchy.  The `engine-id->module-name' procedure returns this module
+;; name based on the engine name.
+
+(define (engine-id->module-name id)
+  `(skribilo engine ,id))
+
+(define (engine-loaded? id)
+  (nested-ref the-root-module (engine-id->module-name id)))
+
+;; A mapping of engine names to hooks.
+(define %engine-load-hook (make-hash-table))
+
+(define (when-engine-is-loaded id thunk)
+  "Run @var{thunk} only when engine with identifier @var{id} is loaded."
+  (if (engine-loaded? id)
+      (thunk)
+      (let ((hook (or (hashq-ref %engine-load-hook id)
+		      (let ((hook (make-hook)))
+			(hashq-set! %engine-load-hook id hook)
+			hook))))
+	(add-hook! hook thunk))))
+
+
 (define* (lookup-engine id :key (version 'unspecified))
   "Look for an engine named @var{name} (a symbol) in the @code{(skribilo
 engine)} module hierarchy.  If no such engine was found, an error is raised,
@@ -192,15 +219,24 @@ otherwise the requested engine is returned."
      (debug-item "id=" id " version=" version)
 
      (let* ((engine (symbol-append id '-engine))
-	    (m (resolve-module `(skribilo engine ,id))))
+	    (m (resolve-module (engine-id->module-name id)))
+	    (hook (hashq-ref %engine-load-hook id)))
        (if (module-bound? m engine)
-	   (module-ref 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)))
+	     e)
 	   (error "no such engine" id)))))
 
 (define* (find-engine id :key (version 'unspecified))
   (false-if-exception (apply lookup-engine (list id version))))
 
 
+
+
 
 ;;;
 ;;; Engine methods.
-- 
cgit v1.2.3