diff options
| author | Ludovic Court`es | 2006-02-21 18:23:46 +0000 |
|---|---|---|
| committer | Ludovic Court`es | 2006-02-21 18:23:46 +0000 |
| commit | 716e3a477583ff7680b5188a60395fd2e4b150c3 (patch) | |
| tree | 2a03ca309aaaf2f16438ebfec84d2225f0553112 /src/guile | |
| parent | c08a39d53562e20e9f3914ecad4b737a4a92abfe (diff) | |
| download | skribilo-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/guile')
| -rw-r--r-- | src/guile/skribilo/package/eq.scm | 24 | ||||
| -rw-r--r-- | src/guile/skribilo/package/eq/lout.scm | 14 |
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 ")")))) |