From c08a39d53562e20e9f3914ecad4b737a4a92abfe Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Mon, 20 Feb 2006 17:08:04 +0000
Subject: `eq': Added `eq:in', `eq:notin' and their Lout writers.

* src/guile/skribilo/package/eq.scm (%symbols): New.
  (make-fast-member-predicate): New.
  (known-operator?): New.
  (known-symbol?): New.
  (equation-markup?): New.
  (eq:symbols->strings): When EQUATION is a symbol, check whether it is
  KNOWN-SYMBOL?.
  (eq:in): New markup
  (eq:notin): New markup.

* src/guile/skribilo/package/eq/lout.scm (binary-lout-markup-writer):
  New.
  (eq:in): New writer.
  (eq:notin): New writer.

git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-53
---
 src/guile/skribilo/package/eq.scm      | 49 ++++++++++++++++++++++++++++++++--
 src/guile/skribilo/package/eq/lout.scm | 38 +++++++++++++++-----------
 2 files changed, 70 insertions(+), 17 deletions(-)

(limited to 'src/guile')

diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
index 410f04f..058320f 100644
--- a/src/guile/skribilo/package/eq.scm
+++ b/src/guile/skribilo/package/eq.scm
@@ -51,13 +51,54 @@
 ;;;
 
 (define %operators
-  '(/ * + - = != ~= < > <= >= sqrt expt sum product script))
+  '(/ * + - = != ~= < > <= >= sqrt expt sum product script in notin))
+
+(define %symbols
+  ;; A set of symbols that are automatically recognized within an `eq' quoted
+  ;; list.
+  '(;; lower-case Greek
+    alpha beta gamma delta epsilon zeta eta theta iota kappa
+    lambda mu nu xi omicron pi rho sigma tau upsilon phi chi omega
+
+    ;; upper-case Greek
+    Alpha Beta Gamma Delta Epsilon Zeta Eta Theta Iota Kappa
+    Lambda Mu Nu Xi Omicron Pi Rho Sigma Tau Upsilon Phi Chi Omega
+
+    ;; Hebrew
+    alef
+
+    ;; mathematics
+    ellipsis weierp image real forall partial exists
+    emptyset infinity in notin nabla nipropto angle and or cap cup
+    sim cong approx neq equiv le ge subset supset subseteq supseteq
+    oplus otimes perp mid lceil rceil lfloor rfloor langle rangle))
 
 (define %rebindings
   (map (lambda (sym)
 	 (list sym (symbol-append 'eq: sym)))
        %operators))
 
+(define (make-fast-member-predicate lst)
+  (let ((h (make-hash-table)))
+    ;; initialize a hash table equivalent to LST
+    (for-each (lambda (s) (hashq-set! h s #t)) lst)
+
+    ;; the run-time, fast, definition
+    (lambda (sym)
+      (hashq-ref h sym #f))))
+
+(define-public known-operator? (make-fast-member-predicate %operators))
+(define-public known-symbol? (make-fast-member-predicate %symbols))
+
+(define-public (equation-markup? m)
+  "Return true if @var{m} is an instance of one of the equation sub-markups."
+  (define eq-sym?
+    (make-fast-member-predicate (map (lambda (s)
+				       (symbol-append 'eq: s))
+				     %operators)))
+  (and (markup? m)
+       (eq-sym? (markup-markup m))))
+
 
 (define (eq:symbols->strings equation)
   "Turn symbols located in non-@code{car} positions into strings."
@@ -67,7 +108,9 @@
 	     (cons (car equation) ;; XXX: not tail-recursive
 		   (map eq:symbols->strings (cdr equation)))))
 	((symbol? equation)
-	 (symbol->string equation))
+	 (if (known-symbol? equation)
+	     `(symbol ,(symbol->string equation))
+	     (symbol->string equation)))
 	(else equation)))
 
 (define-public (eq-evaluate equation)
@@ -138,6 +181,8 @@
        (options (the-options opts))
        (body (the-body opts))))
 
+(define-simple-markup eq:in)
+(define-simple-markup eq:notin)
 
 
 ;;;
diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm
index 30a6d39..6469bea 100644
--- a/src/guile/skribilo/package/eq/lout.scm
+++ b/src/guile/skribilo/package/eq/lout.scm
@@ -120,21 +120,29 @@
 (simple-lout-markup-writer <=)
 (simple-lout-markup-writer >=)
 
-(markup-writer 'eq:expt (find-engine 'lout)
-   :action (lambda (node engine)
-	     (let ((body (markup-body node)))
-	       (if (= (length body) 2)
-		   (let ((base (car body))
-			 (expt (cadr body)))
-		     (display " { { ")
-		     (if (markup? base) (display "("))
-		     (output base engine)
-		     (if (markup? base) (display ")"))
-		     (display " } sup { ")
-		     (output expt engine)
-		     (display " } } "))
-		   (skribe-error 'eq:expt "wrong number of arguments"
-				 body)))))
+(define-macro (binary-lout-markup-writer sym lout-name)
+  `(markup-writer ',(symbol-append 'eq: sym) (find-engine 'lout)
+     :action (lambda (node engine)
+	       (let ((body (markup-body node)))
+		 (if (= (length body) 2)
+		     (let* ((first (car body))
+			    (second (cadr body))
+			    (parentheses? (equation-markup? first)))
+		       (display " { { ")
+		       (if parentheses? (display "("))
+		       (output first engine)
+		       (if parentheses? (display ")"))
+		       (display ,(string-append " } " lout-name " { "))
+		       (output second engine)
+		       (display " } } "))
+		     (skribe-error ,(symbol-append 'eq: sym)
+				   "wrong number of arguments"
+				   body))))))
+
+(binary-lout-markup-writer expt "sup")
+(binary-lout-markup-writer in "element")
+(binary-lout-markup-writer notin "notelement")
+
 
 
 
-- 
cgit v1.2.3