From 85bc77eef9715f726eefe71ac74ecf6e17656bf5 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Mon, 27 Feb 2006 13:16:08 +0000
Subject: `eq': Implemented the text-based markup writers.

* src/guile/skribilo/package/eq.scm: Implemented the text-based markup
  writers for the `base' engine.

git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-56
---
 src/guile/skribilo/package/eq.scm | 135 ++++++++++++++++++++++++++++++++++----
 1 file changed, 122 insertions(+), 13 deletions(-)

(limited to 'src/guile')

diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
index 687a3f5..8a4ad3b 100644
--- a/src/guile/skribilo/package/eq.scm
+++ b/src/guile/skribilo/package/eq.scm
@@ -27,6 +27,7 @@
   :use-module (skribilo utils syntax)
   :use-module (skribilo module)
   :use-module (skribilo skribe utils) ;; `the-options', etc.
+  :autoload   (skribilo skribe api) (it symbol sub sup)
   :use-module (ice-9 optargs))
 
 ;;; Author: Ludovic Courtès
@@ -213,20 +214,128 @@
 
 (markup-writer 'eq (find-engine 'base)
    :action (lambda (node engine)
-	      (output (apply it (markup-body node)) engine)))
-
-(markup-writer 'eq:/ (find-engine 'base)
+	      (output (it (markup-body node)) engine)))
+
+(define-macro (simple-markup-writer op . obj)
+  `(markup-writer ',(symbol-append 'eq: op) (find-engine 'base)
+     :action (lambda (node engine)
+		(let loop ((operands (markup-body node)))
+		 (if (null? operands)
+		     #t
+		     (let ((o (car operands)))
+		       (display (if (equation-markup? o) "(" ""))
+		       (output o engine)
+		       (display (if (equation-markup? o) ")" ""))
+		       (if (pair? (cdr operands))
+			   (begin
+			     (display " ")
+			     (output ,(if (null? obj)
+					  (symbol->string op)
+					  (car obj))
+				     engine)
+			     (display " ")))
+		       (loop (cdr operands))))))))
+
+(simple-markup-writer +)
+(simple-markup-writer -)
+(simple-markup-writer /)
+(simple-markup-writer * (symbol "times"))
+
+(simple-markup-writer =)
+(simple-markup-writer !=)
+(simple-markup-writer ~=)
+(simple-markup-writer <)
+(simple-markup-writer >)
+(simple-markup-writer >=)
+(simple-markup-writer <=)
+
+(markup-writer 'eq:sqrt (find-engine 'base)
+   :action (lambda (node engine)
+	     (display "sqrt(")
+	     (output (markup-body node) engine)
+	     (display ")")))
+
+(define-macro (simple-binary-markup-writer op obj)
+  `(markup-writer ',(symbol-append 'eq: op) (find-engine 'base)
+     :action (lambda (node engine)
+	       (let ((body (markup-body node)))
+		 (if (= (length body) 2)
+		     (let ((first (car body))
+			   (second (cadr body)))
+		       (display (if (equation-markup? first) "(" " "))
+		       (output first engine)
+		       (display (if (equation-markup? first) ")" " "))
+		       (output ,obj engine)
+		       (display (if (equation-markup? second) "(" ""))
+		       (output second engine)
+		       (display (if (equation-markup? second) ")" "")))
+		     (skribe-error ',(symbol-append 'eq: op)
+				   "wrong argument type"
+				   body))))))
+
+(markup-writer 'eq:expt (find-engine 'base)
+   :action (lambda (node engine)
+	     (let ((body (markup-body node)))
+		 (if (= (length body) 2)
+		     (let ((first (car body))
+			   (second (cadr body)))
+		       (display (if (equation-markup? first) "(" ""))
+		       (output first engine)
+		       (display (if (equation-markup? first) ")" ""))
+		       (output (sup second) engine))))))
+
+(simple-binary-markup-writer in    (symbol "in"))
+(simple-binary-markup-writer notin (symbol "notin"))
+
+(markup-writer 'eq:apply (find-engine 'base)
+   :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 ")"))))
+
+(markup-writer 'eq:sum (find-engine 'base)
+   :action (lambda (node engine)
+	     (let ((from (markup-option node :from))
+		   (to (markup-option node :to)))
+	       (output (symbol "Sigma") engine)
+	       (display "(")
+	       (output from engine)
+	       (display ", ")
+	       (output to engine)
+	       (display ", ")
+	       (output (markup-body node) engine)
+	       (display ")"))))
+
+(markup-writer 'eq:prod (find-engine 'base)
+   :action (lambda (node engine)
+	     (let ((from (markup-option node :from))
+		   (to (markup-option node :to)))
+	       (output (symbol "Pi") engine)
+	       (display "(")
+	       (output from engine)
+	       (display ", ")
+	       (output to engine)
+	       (display ", ")
+	       (output (markup-body node) engine)
+	       (display ")"))))
+
+(markup-writer 'eq:script (find-engine 'base)
    :action (lambda (node engine)
-	      (let loop ((operands (markup-body node)))
-	       (if (null? operands)
-		   #t
-		   (begin
-		     (display " ")
-		     (output (car operands) engine)
-		     (display " ")
-		     (if (pair? (cdr operands))
-			 (display " / "))
-		     (loop (cdr operands)))))))
+	     (let ((body (markup-body node))
+		   (sup* (markup-option node :sup))
+		   (sub* (markup-option node :sub)))
+	       (output body engine)
+	       (output (sup sup*) engine)
+	       (output (sub sub*) engine))))
 
 
 ;;;
-- 
cgit v1.2.3