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(-) 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