diff options
author | Ludovic Courtes | 2006-11-03 14:16:33 +0000 |
---|---|---|
committer | Ludovic Courtes | 2006-11-03 14:16:33 +0000 |
commit | 2a636363d6de52e2c49b544c2a6aee21efc31d4a (patch) | |
tree | 06f85484db04d2e7cbb4f18ff9286458567d648e | |
parent | 3aaf0dfae4fdea885a054b701ac41c9166c0daa8 (diff) | |
download | skribilo-2a636363d6de52e2c49b544c2a6aee21efc31d4a.tar.gz skribilo-2a636363d6de52e2c49b544c2a6aee21efc31d4a.tar.lz skribilo-2a636363d6de52e2c49b544c2a6aee21efc31d4a.zip |
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
-rw-r--r-- | src/guile/skribilo/utils/compat.scm | 50 |
1 files 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,12 +292,43 @@ (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'). ;;; |