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(-)
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