eq: Added the `:div-style' option.

* src/guile/skribilo/package/eq.scm (eq): New `:div-style' option.
  Return a container rather than a markup.
  (eq:/): Added support for `:div-style'.

* src/guile/skribilo/package/eq/lout.scm (eq): List `:div-style' as
  supported.
  (div-style->lout): New.
  (simple-lout-markup-writer): Handle LOUT-NAME as procedure.
  (eq:/): Use the `:div-style' option.
  (eq:script): Only use "on" when SUP is passed.

git-archimport-id: skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-22

2 files changed, 72 insertions, 39 deletions

diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
index 4f5020e..58fb77c 100644
--- a/src/guile/skribilo/package/eq.scm
+++ b/src/guile/skribilo/package/eq.scm
@@ -169,12 +169,15 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g.,
 ;;; Markup.
 ;;;
 
-(define-markup (eq :rest opts :key (ident #f) (inline? #f)
-		                   (renderer #f) (class "eq"))
-  (new markup
+(define-markup (eq :rest opts :key (ident #f) (class "eq")
+                                   (inline? #f)
+		                   (renderer #f) (div-style 'over))
+  (new container
        (markup 'eq)
        (ident (or ident (symbol->string (gensym "eq"))))
-       (options (the-options opts))
+       (class class)
+       (options `((:div-style ,div-style)
+                  ,@(the-options opts :ident :class :div-style)))
        (body (let loop ((body (the-body opts))
 			(result '()))
 	       (if (null? body)
@@ -187,7 +190,16 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g.,
 						       ;; passed
 			     ))))))
 
-(define-simple-markup eq:/)
+(define-markup (eq:/ :rest opts :key (ident #f) (div-style #f))
+  ;; If no `:div-style' is specified here, obey the top-level one.
+  (new markup
+       (markup 'eq:/)
+       (ident (or ident (symbol->string (gensym "eq:/"))))
+       (class #f)
+       (options `((:div-style ,div-style)
+                  ,@(the-options opts :ident :class :div-style)))
+       (body (the-body opts))))
+
 (define-simple-markup eq:*)
 (define-simple-markup eq:+)
 (define-simple-markup eq:-)
diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm
index c487b85..cce5124 100644
--- a/src/guile/skribilo/package/eq/lout.scm
+++ b/src/guile/skribilo/package/eq/lout.scm
@@ -53,7 +53,7 @@
 
 
 (markup-writer 'eq (find-engine 'lout)
-   :options '(:inline?)
+   :options '(:inline? :div-style)
    :before "{ "
    :action (lambda (node engine)
 	     (display (if (markup-option node :inline?)
@@ -65,6 +65,14 @@
    :after  " } }")
 
 
+(define (div-style->lout style)
+  (case style
+    ((over)     "over")
+    ((fraction) "frac")
+    ((div)      "div")
+    ((slash)    "slash")
+    (else
+     (error "unsupported div style" style))))
 
 (define-macro (simple-lout-markup-writer sym . args)
   (let* ((lout-name (if (null? args)
@@ -83,37 +91,41 @@
     `(markup-writer ',(symbol-append 'eq: sym)
 		    (find-engine 'lout)
 		    :action (lambda (node engine)
-			      (let loop ((operands (markup-body node)))
-				(if (null? operands)
-				    #t
-				    (let* ((op (car operands))
-					   (eq-op? (equation-markup? op))
-					   (need-paren?
-					    (and eq-op?
-						 (< (operator-precedence
-						     (equation-markup-name->operator
-						      (markup-markup op)))
-						    ,precedence)))
-					   (column (port-column
-						    (current-output-port))))
-
-				      ;; Work around Lout's limitations...
-				      (if (> column 1000) (display "\n"))
-
-				      (display (string-append " { "
-							      ,(if parentheses?
-								   open-par
-								   "")))
-				      (output op engine)
-				      (display (string-append ,(if parentheses?
-								   close-par
-								   "")
-							      " }"))
-				      (if (pair? (cdr operands))
-					  (display ,(string-append " "
-								   lout-name
-								   " ")))
-				      (loop (cdr operands)))))))))
+                              (let ((lout-name ,(if (string? lout-name)
+                                                    lout-name
+                                                    `(,lout-name node
+                                                                 engine))))
+                                (let loop ((operands (markup-body node)))
+                                  (if (null? operands)
+                                      #t
+                                      (let* ((op (car operands))
+                                             (eq-op? (equation-markup? op))
+                                             (need-paren?
+                                              (and eq-op?
+                                                   (< (operator-precedence
+                                                       (equation-markup-name->operator
+                                                        (markup-markup op)))
+                                                      ,precedence)))
+                                             (column (port-column
+                                                      (current-output-port))))
+
+                                        ;; Work around Lout's limitations...
+                                        (if (> column 1000) (display "\n"))
+
+                                        (display (string-append " { "
+                                                                ,(if parentheses?
+                                                                     open-par
+                                                                     "")))
+                                        (output op engine)
+                                        (display (string-append ,(if parentheses?
+                                                                     close-par
+                                                                     "")
+                                                                " }"))
+                                        (if (pair? (cdr operands))
+                                            (display (string-append " "
+                                                                    lout-name
+                                                                    " ")))
+                                        (loop (cdr operands))))))))))
 
 
 ;; `+' and `*' have higher precedence than `-', `/', `=', etc., so their
@@ -124,7 +136,16 @@
 (simple-lout-markup-writer +)
 (simple-lout-markup-writer * "times")
 (simple-lout-markup-writer - "-")
-(simple-lout-markup-writer / "over" #f)
+(simple-lout-markup-writer /
+                           (lambda (n e)
+                             ;; Obey either the per-node `:div-style' or the
+                             ;; top-level one.
+                             (or (markup-option n :div-style)
+                                 (let* ((eq (ast-parent n))
+                                        (div-style
+                                         (markup-option eq :div-style)))
+                                   (div-style->lout div-style))))
+                           #f)
 (simple-lout-markup-writer =)
 (simple-lout-markup-writer <)
 (simple-lout-markup-writer >)
@@ -208,7 +229,7 @@
 		     (display " } ")))
 	       (if sub
 		   (begin
-		     (display " on { ")
+		     (display (if sup " on { " " sub { "))
 		     (output sub engine)
 		     (display " } ")))
 	       (display " } "))))