eq: Added `eq-display' and the `:align-with' option for `eq'.

* src/guile/skribilo/package/eq.scm: Use `srfi-39'.
  (*embedded-renderer*): New.
  (eq-display): New.
  (eq)[:align-with]: New option.
  (eq-display): New text-based writer.
  (eq): Parameterize `*embedded-renderer*'.

* src/guile/skribilo/package/eq/lout.scm (eq-display): New writer.
  (eq): Support `:align-with'.
  (simple-lout-markup-writer): Honor `:align-with'.

git-archimport-id: lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-84

2 files changed, 95 insertions, 53 deletions

diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
index a3eb99c..76bbf6c 100644
--- a/src/guile/skribilo/package/eq.scm
+++ b/src/guile/skribilo/package/eq.scm
@@ -29,6 +29,8 @@
   :use-module (skribilo utils keywords) ;; `the-options', etc.
   :autoload   (skribilo package base) (it symbol sub sup)
   :autoload   (skribilo engine lout) (lout-illustration)
+
+  :use-module (srfi srfi-39)
   :use-module (ice-9 optargs))
 
 ;;; Author: Ludovic Courtès
@@ -52,6 +54,11 @@
 ;;; Utilities.
 ;;;
 
+(define-public *embedded-renderer*
+  ;; Tells whether an engine is invoked as an embedded renderer or as the
+  ;; native engine.
+  (make-parameter #f))
+
 (define %operators
   '(/ * + - = != ~= < > <= >= sqrt expt sum product script
     in notin apply limit combinations))
@@ -178,15 +185,25 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g.,
 ;;; Markup.
 ;;;
 
+(define-markup (eq-display :rest opts :key (ident #f) (class "eq-display"))
+  (new container
+       (markup 'eq-display)
+       (ident (or ident (symbol->string (gensym "eq-display"))))
+       (class class)
+       (options (the-options opts :ident :class :div-style))
+       (body (the-body opts))))
+
 (define-markup (eq :rest opts :key (ident #f) (class "eq")
-                                   (inline? #f)
+                                   (inline? #f) (align-with #f)
 		                   (renderer #f) (div-style 'over))
   (new container
        (markup 'eq)
        (ident (or ident (symbol->string (gensym "eq"))))
        (class class)
-       (options `((:div-style ,div-style)
-                  ,@(the-options opts :ident :class :div-style)))
+       (options `((:div-style ,div-style) (:align-with ,align-with)
+                  ,@(the-options opts
+                                 :ident :class
+                                 :div-style :align-with)))
        (body (let loop ((body (the-body opts))
 			(result '()))
 	       (if (null? body)
@@ -199,6 +216,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g.,
 						       ;; passed
 			     ))))))
 
+
 (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
@@ -295,6 +313,15 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g.,
 ;;;
 
 
+(markup-writer 'eq-display (find-engine 'base)
+   :action (lambda (node engine)
+             (for-each (lambda (node)
+                         (let ((eq? (is-markup? node 'eq)))
+                           (if eq? (output (linebreak) engine))
+                           (output node engine)
+                           (if eq? (output (linebreak) engine))))
+                       (markup-body node))))
+
 (markup-writer 'eq (find-engine 'base)
    :action (lambda (node engine)
 	     ;; The `:renderer' option should be a symbol (naming an engine
@@ -306,20 +333,21 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g.,
 	       (cond ((not renderer) ;; default: use the current engine
 		      (output (it (markup-body node)) engine))
 		     ((symbol? renderer)
-		      (case renderer
-			;; FIXME: We should have an `embed' slot for each
-			;; engine class similar to `lout-illustration'.
-			((lout)
-			 (let ((lout-code
-				(with-output-to-string
-				  (lambda ()
-				    (output node (find-engine 'lout))))))
-			   (output (lout-illustration
-				    :ident (markup-ident node)
-				    lout-code)
-				   engine)))
-			(else
-			 (skribe-error 'eq "invalid renderer" renderer))))
+                      (parameterize ((*embedded-renderer* #t))
+                        (case renderer
+                          ;; FIXME: We should have an `embed' slot for each
+                          ;; engine class similar to `lout-illustration'.
+                          ((lout)
+                           (let ((lout-code
+                                  (with-output-to-string
+                                    (lambda ()
+                                      (output node (find-engine 'lout))))))
+                             (output (lout-illustration
+                                      :ident (markup-ident node)
+                                      lout-code)
+                                     engine)))
+                          (else
+                           (skribe-error 'eq "invalid renderer" renderer)))))
 		     ;; FIXME: `engine?' and `engine-class?'
 		     (else
 		      (skribe-error 'eq "`:renderer' -- wrong argument type"
diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm
index 9cd594b..b1ff7ae 100644
--- a/src/guile/skribilo/package/eq/lout.scm
+++ b/src/guile/skribilo/package/eq/lout.scm
@@ -51,10 +51,18 @@
 ;;; Simple markup writers.
 ;;;
 
+(markup-writer 'eq-display (find-engine 'lout)
+   :before "\n@BeginAlignedDisplays\n"
+   :after  "\n@EndAlignedDisplays\n")
 
 (markup-writer 'eq (find-engine 'lout)
-   :options '(:inline? :div-style)
-   :before "{ "
+   :options '(:inline? :align-with :div-style)
+   :before (lambda (node engine)
+             (let* ((parent (ast-parent node))
+                    (displayed? (is-markup? parent 'eq-display)))
+               (format #t "~a{ "
+                       (if (and displayed? (not (*embedded-renderer*)))
+                           "\n@IAD " ""))))
    :action (lambda (node engine)
 	     (display (if (markup-option node :inline?)
 			  "@E { "
@@ -92,40 +100,46 @@
                         `(if need-paren? "{ @VScale ) }" "")
                         "")))
 
-    `(markup-writer ',(symbol-append 'eq: sym)
-		    (find-engine 'lout)
-		    :action (lambda (node engine)
-                              (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 " { " ,open-par))
-                                        (output op engine)
-                                        (display
-                                         (string-append ,close-par " }"))
-                                        (if (pair? (cdr operands))
-                                            (display (string-append " "
-                                                                    lout-name
-                                                                    " ")))
-                                        (loop (cdr operands))))))))))
+    `(markup-writer ',(symbol-append 'eq: sym) (find-engine 'lout)
+        :action (lambda (node engine)
+                  (let* ((lout-name ,(if (string? lout-name)
+                                         lout-name
+                                         `(,lout-name node
+                                                      engine)))
+                         (eq        (ast-parent node))
+                         (eq-parent (ast-parent eq)))
+
+                    (let loop ((operands (markup-body node))
+                               (first? #t))
+                      (if (null? operands)
+                          #t
+                          (let* ((align?
+                                  (and first?
+                                       (is-markup? eq-parent 'eq-display)
+                                       (eq? ',sym
+                                            (markup-option eq :align-with))))
+                                 (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 " { " ,open-par))
+                            (output op engine)
+                            (display (string-append ,close-par " }"))
+                            (if (pair? (cdr operands))
+                                (display (string-append " "
+                                                        (if align? "^" "")
+                                                        lout-name
+                                                        " ")))
+                            (loop (cdr operands) #f)))))))))
 
 
 ;; `+' and `*' have higher precedence than `-', `/', `=', etc., so their