From 716e3a477583ff7680b5188a60395fd2e4b150c3 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Tue, 21 Feb 2006 18:23:46 +0000
Subject: `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
---
 src/guile/skribilo/package/eq.scm      | 24 +++++++++++++++++++++++-
 src/guile/skribilo/package/eq/lout.scm | 14 ++++++++++++++
 2 files changed, 37 insertions(+), 1 deletion(-)

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 ")"))))
 
 
 
-- 
cgit v1.2.3