aboutsummaryrefslogtreecommitdiff
path: root/src/guile
diff options
context:
space:
mode:
authorLudovic Courtes2006-03-07 23:01:27 +0000
committerLudovic Courtes2006-03-07 23:01:27 +0000
commit37105ac9d8dac73a04b2fc542d3a94340964781d (patch)
tree7b5b024b5d7fe58756422a0da50eef91a091a398 /src/guile
parent1dcb0a085655142728057dcf956a7ed4c989b07a (diff)
parentfaf5a61d584ccad016d5bb3d50ce515931e17897 (diff)
downloadskribilo-37105ac9d8dac73a04b2fc542d3a94340964781d.tar.gz
skribilo-37105ac9d8dac73a04b2fc542d3a94340964781d.tar.lz
skribilo-37105ac9d8dac73a04b2fc542d3a94340964781d.zip
Slight optimization: allow for non-proc predicates for markup writers.
Patches applied: * skribilo--devel--1.2 (patch 43) - Slight optimization: allow for non-proc predicated for markup writers. git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-71
Diffstat (limited to 'src/guile')
-rw-r--r--src/guile/skribilo/engine.scm5
-rw-r--r--src/guile/skribilo/writer.scm21
2 files changed, 15 insertions, 11 deletions
diff --git a/src/guile/skribilo/engine.scm b/src/guile/skribilo/engine.scm
index 0c3f406..3e05571 100644
--- a/src/guile/skribilo/engine.scm
+++ b/src/guile/skribilo/engine.scm
@@ -333,11 +333,12 @@ otherwise the requested engine is returned."
(skribe-error ident "Illegal options" opt))
;; check the correctness of the predicate
- (check-procedure "predicate" pred 2)
+ (if pred
+ (check-procedure "predicate" pred 2))
;; check the correctness of the validation proc
(if valid
- (check-procedure "validate" valid 2))
+ (check-procedure "validate" valid 2))
;; check the correctness of the three actions
(check-output "before" before)
diff --git a/src/guile/skribilo/writer.scm b/src/guile/skribilo/writer.scm
index 62fa8b0..b46cddc 100644
--- a/src/guile/skribilo/writer.scm
+++ b/src/guile/skribilo/writer.scm
@@ -89,13 +89,12 @@
(define (make-writer-predicate markup predicate class)
- (let* ((t1 (if (symbol? markup)
- (lambda (n e) (is-markup? n markup))
- (lambda (n e) #t)))
- (t2 (if class
+ (define (%always-true n e) #t)
+
+ (let* ((t2 (if class
(lambda (n e)
- (and (t1 n e) (equal? (markup-class n) class)))
- t1)))
+ (and (equal? (markup-class n) class)))
+ #f)))
(if predicate
(cond
((not (procedure? predicate))
@@ -107,8 +106,10 @@
"Illegal predicate arity (2 arguments expected)"
predicate))
(else
- (lambda (n e)
- (and (t2 n e) (predicate n e)))))
+ (if (procedure? t2)
+ (lambda (n e)
+ (and (t2 n e) (predicate n e)))
+ predicate)))
t2)))
@@ -167,7 +168,9 @@
(define (matching-writer writers)
(find (lambda (w)
(let ((pred (slot-ref w 'pred)))
- (pred node e)))
+ (if (procedure? pred)
+ (pred node e)
+ #t)))
writers))
(let* ((writers (slot-ref e 'writers))