aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorLudovic Court`es2006-02-21 18:23:46 +0000
committerLudovic Court`es2006-02-21 18:23:46 +0000
commit716e3a477583ff7680b5188a60395fd2e4b150c3 (patch)
tree2a03ca309aaaf2f16438ebfec84d2225f0553112 /src
parentc08a39d53562e20e9f3914ecad4b737a4a92abfe (diff)
downloadskribilo-716e3a477583ff7680b5188a60395fd2e4b150c3.tar.gz
skribilo-716e3a477583ff7680b5188a60395fd2e4b150c3.tar.lz
skribilo-716e3a477583ff7680b5188a60395fd2e4b150c3.zip
`eq': added the `apply' markup.
* src/guile/skribilo/package/eq.scm (%operators): Added `apply'. (eq:apply): New markup. * src/guile/skribilo/package/eq/lout.scm (eq:apply): New writer. git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-54
Diffstat (limited to 'src')
-rw-r--r--src/guile/skribilo/package/eq.scm24
-rw-r--r--src/guile/skribilo/package/eq/lout.scm14
2 files changed, 37 insertions, 1 deletions
diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
index 058320f..687a3f5 100644
--- a/src/guile/skribilo/package/eq.scm
+++ b/src/guile/skribilo/package/eq.scm
@@ -51,7 +51,8 @@
;;;
(define %operators
- '(/ * + - = != ~= < > <= >= sqrt expt sum product script in notin))
+ '(/ * + - = != ~= < > <= >= sqrt expt sum product script
+ in notin apply))
(define %symbols
;; A set of symbols that are automatically recognized within an `eq' quoted
@@ -184,6 +185,27 @@
(define-simple-markup eq:in)
(define-simple-markup eq:notin)
+(define-markup (eq:apply :rest opts :key (ident #f) (class "eq:apply"))
+ ;; This markup may receive either a list of arguments or arguments
+ ;; compatible with the real `apply'. Note: the real `apply' can take N
+ ;; non-list arguments but the last one has to be a list.
+ (new markup
+ (markup 'eq:apply)
+ (ident (or ident (symbol->string (gensym "eq:apply"))))
+ (options (the-options opts))
+ (body (let loop ((body (the-body opts))
+ (result '()))
+ (if (null? body)
+ (reverse! result)
+ (let ((first (car body)))
+ (if (list? first)
+ (if (null? (cdr body))
+ (append (reverse! result) first)
+ (skribe-error 'eq:apply
+ "wrong argument type"
+ body))
+ (loop (cdr body) (cons first result)))))))))
+
;;;
;;; Text-only implementation.
diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm
index 6469bea..bd2ccf4 100644
--- a/src/guile/skribilo/package/eq/lout.scm
+++ b/src/guile/skribilo/package/eq/lout.scm
@@ -143,6 +143,20 @@
(binary-lout-markup-writer in "element")
(binary-lout-markup-writer notin "notelement")
+(markup-writer 'eq:apply (find-engine 'lout)
+ :action (lambda (node engine)
+ (let ((func (car (markup-body node))))
+ (output func engine)
+ (display "(")
+ (let loop ((operands (cdr (markup-body node))))
+ (if (null? operands)
+ #t
+ (begin
+ (output (car operands) engine)
+ (if (not (null? (cdr operands)))
+ (display ", "))
+ (loop (cdr operands)))))
+ (display ")"))))