From 2a636363d6de52e2c49b544c2a6aee21efc31d4a Mon Sep 17 00:00:00 2001
From: Ludovic Courtes
Date: Fri, 3 Nov 2006 14:16:33 +0000
Subject: compat: Various fixes: `skribe-load', `make-engine', `markup-writer',
 etc.

* src/guile/skribilo/utils/compat.scm (skribe-load): Use
  `resolve-interface' rather than `resolve-module' when loading a
  compatibility package; this avoids binding leakage.
  (make-engine)[rewrite-delegate-arg]: Reversed the order of `:delegate'
  and the corresponding engine.
  (default-engine): Fixed a typo.
  (engine-ident): New.
  (markup-writer): Use `(default-engine)' when no engine is passed.
  (markup-writer-get): New.

git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--engine-classes--1.2--patch-8
---
 src/guile/skribilo/utils/compat.scm | 50 ++++++++++++++++++++++++++-----------
 1 file changed, 35 insertions(+), 15 deletions(-)

diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm
index 787d9b9..5074bd7 100644
--- a/src/guile/skribilo/utils/compat.scm
+++ b/src/guile/skribilo/utils/compat.scm
@@ -155,7 +155,7 @@
 				 "  skribe-load: `~a' -> `~a'~%"
 				 file mod-name))
 		     (let ((mod (false-if-exception
-				 (resolve-module mod-name))))
+				 (resolve-interface mod-name))))
 		       (if (not mod)
 			   (raise c)
 			   (begin
@@ -237,10 +237,10 @@
 	    (if (eq? arg :delegate)
 		(let ((delegate (cadr args)))
 		  (loop (cddr args)
-			(cons* :delegate
-			       (if (orig:engine? delegate)
+			(cons* (if (orig:engine? delegate)
 				   (orig:engine-class delegate)
 				   delegate)
+                               :delegate
 			       result)))
 		(loop (cdr args) (cons arg result)))))))
 
@@ -248,17 +248,6 @@
       (apply orig:make-engine-class first-arg (rewrite-delegate-arg args))
       (apply orig:make-engine-class first-arg args)))
 
-(define-public (markup-writer markup . args)
-  ;; In old-style `markup-writer', the first arg could (optionally) be an
-  ;; engine.  Now, this must be (optionally) an engine class instead of an
-  ;; engine.
-  (if (null? args)
-      (apply orig:markup-writer markup args)
-      (let loop ((first-arg (car args)))
-	(if (orig:engine? first-arg)
-	    (loop (orig:engine-class first-arg))
-	    (apply orig:markup-writer markup first-arg (cdr args))))))
-
 
 (define (ensure-engine engine-or-class)
   (cond ((orig:engine-class? engine-or-class)
@@ -272,7 +261,7 @@
    (if (null? %default-engines)
        (let* ((class  (orig:default-engine-class))
 	      (engine (find-engine (orig:engine-class-ident class))))
-	 (set! %default-engine (list engine))
+	 (set! %default-engines (list engine))
 	 engine)
        (car %default-engines))))
 
@@ -303,10 +292,41 @@
 	(else
 	 (apply orig:copy-engine-class ident e args))))
 
+(define-public engine-ident       orig:engine-ident)
 (define-public engine-custom      orig:engine-custom)
 (define-public engine-custom-set! orig:engine-custom-set!)
 (define-public engine-format?     orig:engine-format?)
 
+
+;;;
+;;; Writers.
+;;;
+
+(define-public (markup-writer markup . args)
+  ;; In old-style `markup-writer', the second arg could (optionally) be an
+  ;; engine.  Now, this must be (optionally) an engine class instead of an
+  ;; engine.
+  (if (null? args)
+      (apply orig:markup-writer markup args)
+      (let loop ((first-arg (car args))
+                 (rest (cdr args)))
+	(cond ((orig:engine? first-arg)
+               (loop (orig:engine-class first-arg) rest))
+              ((orig:engine-class? first-arg)
+               (apply orig:markup-writer markup first-arg rest))
+              (else
+               ;; FIRST-ARG does not specify an engine: keep it and use the
+               ;; current default engine.
+               (loop (default-engine) (cons first-arg rest)))))))
+
+(define*-public (markup-writer-get markup :optional engine :key (class #f)
+                                   (pred #f))
+  (let ((eclass (if (orig:engine? engine)
+                    (orig:engine-class engine)
+                    (orig:engine-class (default-engine)))))
+    (orig:markup-writer-get markup eclass
+                            :class class :pred pred)))
+
 
 ;;;
 ;;; Node lookup (formerly provided by `ast.scm').
-- 
cgit v1.2.3