Merge from lcourtes@laas.fr--2004-libre

Patches applied:

 * lcourtes@laas.fr--2004-libre/skribilo--devel--1.2  (patch 55-59)

   - Made `make-string-replace' faster.
   - `eq': Implemented the text-based markup writers.
   - `eq': Added the `:renderer' option to `eq'.  Support `lout'.
   - Changed the way `slide' implementations are loaded.  Doc is buildable now.
   - Doc: Added a chapter (stub) about the `eq' package.

git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-36

5 files changed, 264 insertions, 111 deletions

diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
index 687a3f5..45a863f 100644
--- a/src/guile/skribilo/package/eq.scm
+++ b/src/guile/skribilo/package/eq.scm
@@ -27,6 +27,8 @@
   :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)
+  :autoload   (skribilo engine lout) (lout-illustration)
   :use-module (ice-9 optargs))
 
 ;;; Author: Ludovic Courtès
@@ -125,7 +127,7 @@
 ;;; Markup.
 ;;;
 
-(define-markup (eq :rest opts :key (ident #f) (class "eq"))
+(define-markup (eq :rest opts :key (ident #f) (renderer #f) (class "eq"))
   (new markup
        (markup 'eq)
        (ident (or ident (symbol->string (gensym "eq"))))
@@ -208,25 +210,163 @@
 
 
 ;;;
-;;; Text-only implementation.
+;;; Base and text-only implementation.
 ;;;
 
+
+
 (markup-writer 'eq (find-engine 'base)
    :action (lambda (node engine)
-	      (output (apply it (markup-body node)) engine)))
-
-(markup-writer 'eq:/ (find-engine 'base)
+	     ;; The `:renderer' option should be a symbol (naming an engine
+	     ;; class) or an engine or engine class.  This allows the use of
+	     ;; another engine to render equations.  For instance, equations
+	     ;; may be rendered using the Lout engine within an HTML
+	     ;; document.
+	     (let ((renderer (markup-option node :renderer)))
+	       (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))))
+		     ;; FIXME: `engine?' and `engine-class?'
+		     (else
+		      (skribe-error 'eq "`:renderer' -- wrong argument type"
+				    renderer))))))
+
+(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 != (symbol "neq"))
+(simple-markup-writer ~= (symbol "approx"))
+(simple-markup-writer <)
+(simple-markup-writer >)
+(simple-markup-writer >= (symbol "ge"))
+(simple-markup-writer <= (symbol "le"))
+
+(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 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 ((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 ((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))))
+
+
 
 
 ;;;
diff --git a/src/guile/skribilo/package/slide.scm b/src/guile/skribilo/package/slide.scm
index 8968d00..629abdf 100644
--- a/src/guile/skribilo/package/slide.scm
+++ b/src/guile/skribilo/package/slide.scm
@@ -21,10 +21,7 @@
 
 
 (define-skribe-module (skribilo package slide)
-  :autoload (skribilo engine html) (html-width html-title-authors)
-  :autoload (skribilo package slide html) (%slide-html-initialize!)
-  :autoload (skribilo package slide lout) (%slide-lout-initialize!)
-  :autoload (skribilo package slide latex) (%slide-latex-initialize!))
+  :autoload (skribilo engine html) (html-width html-title-authors))
 
 
 ;*---------------------------------------------------------------------*/
@@ -47,13 +44,13 @@
 ;; Register specific implementations for lazy loading.
 (when-engine-is-loaded 'latex
   (lambda ()
-    (%slide-latex-initialize!)))
+    (resolve-module '(skribilo package slide latex))))
 (when-engine-is-loaded 'html
   (lambda ()
-    (%slide-html-initialize!)))
+    (resolve-module '(skribilo package slide html))))
 (when-engine-is-loaded 'lout
   (lambda ()
-    (%slide-lout-initialize!)))
+    (resolve-module '(skribilo package slide lout))))
 
 
 ;*---------------------------------------------------------------------*/
diff --git a/src/guile/skribilo/package/slide/html.scm b/src/guile/skribilo/package/slide/html.scm
index 5398fbf..128b7e3 100644
--- a/src/guile/skribilo/package/slide/html.scm
+++ b/src/guile/skribilo/package/slide/html.scm
@@ -59,6 +59,7 @@
     (markup-writer 'slide-vspace he
        :action (lambda (n e) (display "<br>")))))
 
+
 ;*---------------------------------------------------------------------*/
 ;*    slide-body-width ...                                             */
 ;*---------------------------------------------------------------------*/
@@ -103,4 +104,12 @@
       (display "</td></tr></tbody></table></center>\n")))
 
 
+
+;;;
+;;; Initialization.
+;;;
+
+(%slide-html-initialize!)
+
+
 ;;; arch-tag: 8be0cdf2-b755-4baa-baf6-739cdd00e193
diff --git a/src/guile/skribilo/package/slide/latex.scm b/src/guile/skribilo/package/slide/latex.scm
index 15f4535..4105e74 100644
--- a/src/guile/skribilo/package/slide/latex.scm
+++ b/src/guile/skribilo/package/slide/latex.scm
@@ -25,6 +25,7 @@
 (define-public %slide-latex-mode 'seminar)
 
 (define-public (%slide-latex-initialize!)
+  (skribe-message "LaTeX slides setup...\n")
   (case %slide-latex-mode
     ((seminar)
      (%slide-seminar-setup!))
@@ -35,6 +36,7 @@
     (else
      (skribe-error 'slide "Illegal latex mode" %slide-latex-mode))))
 
+
 ;*---------------------------------------------------------------------*/
 ;*    &slide-seminar-predocument ...                                   */
 ;*---------------------------------------------------------------------*/
@@ -382,4 +384,11 @@
 	      (set! %slide-latex-mode 'advi)))))
 
 
+
+;;;
+;;; Initialization.
+;;;
+
+(%slide-latex-initialize!)
+
 ;;; arch-tag: b99e2c65-55f7-462c-8482-f47c7e223538
diff --git a/src/guile/skribilo/package/slide/lout.scm b/src/guile/skribilo/package/slide/lout.scm
index f816469..39e0175 100644
--- a/src/guile/skribilo/package/slide/lout.scm
+++ b/src/guile/skribilo/package/slide/lout.scm
@@ -34,98 +34,96 @@
 ;;;
 ;;; Make some more PS/PDF trickery.
 
-(format (current-error-port) "slide/lout.scm~%")
-
-(define-public (%slide-lout-initialize!)
-  (format (current-error-port) "Lout slides initializing...~%")
-
-  (let ((le (find-engine 'lout)))
-
-    ;; Automatically switch to the `slides' document type.
-    (engine-custom-set! le 'document-type 'slides)
-
-    (markup-writer 'slide le
-       :options '(:title :number :toc :ident) ;; '(:bg :vspace :image)
-
-       :validate (lambda (n e)
-		    (eq? (engine-custom e 'document-type) 'slides))
-
-       :before (lambda (n e)
-		  (display "\n@Overhead\n")
-		  (display "  @Title { ")
-		  (output (markup-option n :title) e)
-		  (display " }\n")
-		  (if (markup-ident n)
-		      (begin
-			 (display "  @Tag { ")
-			 (display (lout-tagify (markup-ident n)))
-			 (display " }\n")))
-		  (if (markup-option n :number)
-		      (begin
-			 (display "  @BypassNumber { ")
-			 (output (markup-option n :number) e)
-			 (display " }\n")))
-		  (display "@Begin\n")
-
-		  ;; `doc' documents produce their PDF outline right after
-		  ;; `@Text @Begin'; other types of documents must produce it
-		  ;; as part of their first chapter.
-		  (lout-output-pdf-meta-info (ast-document n) e))
-
-       :after "@End @Overhead\n")
-
-    (markup-writer 'slide-vspace le
-       :options '(:unit)
-       :validate (lambda (n e)
-		    (and (pair? (markup-body n))
-			 (number? (car (markup-body n)))))
-       :action (lambda (n e)
-		  (printf "\n//~a~a # slide-vspace\n"
-			  (car (markup-body n))
-			  (case (markup-option n :unit)
-			     ((cm)              "c")
-			     ((point points pt) "p")
-			     ((inch inches)     "i")
-			     (else
-			      (skribe-error 'lout
-					    "Unknown vspace unit"
-					    (markup-option n :unit)))))))
-
-    (markup-writer 'slide-pause le
-       ;; FIXME:  Use a `pdfmark' custom action and a PDF transition action.
-       ;; << /Type /Action
-       ;; << /S /Trans
-       ;; entry in the trans dict
-       ;; << /Type /Trans  /S /Dissolve >>
-       :action (lambda (n e)
-		 (let ((filter (make-string-replace lout-verbatim-encoding))
-		       (pdfmark "
+(format (current-error-port) "Lout slides setup...~%")
+
+(let ((le (find-engine 'lout)))
+
+  ;; Automatically switch to the `slides' document type.
+  (engine-custom-set! le 'document-type 'slides)
+
+  (markup-writer 'slide le
+     :options '(:title :number :toc :ident) ;; '(:bg :vspace :image)
+
+     :validate (lambda (n e)
+		  (eq? (engine-custom e 'document-type) 'slides))
+
+     :before (lambda (n e)
+		(display "\n@Overhead\n")
+		(display "  @Title { ")
+		(output (markup-option n :title) e)
+		(display " }\n")
+		(if (markup-ident n)
+		    (begin
+		       (display "  @Tag { ")
+		       (display (lout-tagify (markup-ident n)))
+		       (display " }\n")))
+		(if (markup-option n :number)
+		    (begin
+		       (display "  @BypassNumber { ")
+		       (output (markup-option n :number) e)
+		       (display " }\n")))
+		(display "@Begin\n")
+
+		;; `doc' documents produce their PDF outline right after
+		;; `@Text @Begin'; other types of documents must produce it
+		;; as part of their first chapter.
+		(lout-output-pdf-meta-info (ast-document n) e))
+
+     :after "@End @Overhead\n")
+
+  (markup-writer 'slide-vspace le
+     :options '(:unit)
+     :validate (lambda (n e)
+		  (and (pair? (markup-body n))
+		       (number? (car (markup-body n)))))
+     :action (lambda (n e)
+		(printf "\n//~a~a # slide-vspace\n"
+			(car (markup-body n))
+			(case (markup-option n :unit)
+			   ((cm)              "c")
+			   ((point points pt) "p")
+			   ((inch inches)     "i")
+			   (else
+			    (skribe-error 'lout
+					  "Unknown vspace unit"
+					  (markup-option n :unit)))))))
+
+  (markup-writer 'slide-pause le
+     ;; FIXME:  Use a `pdfmark' custom action and a PDF transition action.
+     ;; << /Type /Action
+     ;; << /S /Trans
+     ;; entry in the trans dict
+     ;; << /Type /Trans  /S /Dissolve >>
+     :action (lambda (n e)
+	       (let ((filter (make-string-replace lout-verbatim-encoding))
+		     (pdfmark "
 [ {ThisPage} << /Trans << /S /Wipe /Dm /V /D 3 /M /O >> >> /PUT pdfmark"))
-		   (display (lout-embedded-postscript-code
-			     (filter pdfmark))))))
-
-    ;; For movies, see
-    ;; http://www.tug.org/tex-archive/macros/latex/contrib/movie15/movie15.sty .
-    (markup-writer 'slide-embed le
-       :options '(:alt :geometry :rgeometry :geometry-opt :command)
-       ;; FIXME:  `pdfmark'.
-       ;; << /Type /Action   /S /Launch
-       :action (lambda (n e)
-		 (let ((command (markup-option n :command))
-		       (filter (make-string-replace lout-verbatim-encoding))
-		       (pdfmark "[ /Rect [ 0 ysize xsize 0 ]
-  /Name /Comment
-  /Contents (This is an embedded application)
-  /ANN pdfmark
+		 (display (lout-embedded-postscript-code
+			   (filter pdfmark))))))
+
+  ;; For movies, see
+  ;; http://www.tug.org/tex-archive/macros/latex/contrib/movie15/movie15.sty .
+  (markup-writer 'slide-embed le
+     :options '(:alt :geometry :rgeometry :geometry-opt :command)
+     ;; FIXME:  `pdfmark'.
+     ;; << /Type /Action   /S /Launch
+     :action (lambda (n e)
+	       (let ((command (markup-option n :command))
+		     (filter (make-string-replace lout-verbatim-encoding))
+		     (pdfmark "[ /Rect [ 0 ysize xsize 0 ]
+/Name /Comment
+/Contents (This is an embedded application)
+/ANN pdfmark
 
 [ /Type /Action
-  /S    /Launch
-  /F    (~a)
-  /OBJ pdfmark"))
-		 (display (string-append
-			   "4c @Wide 3c @High "
-			   (lout-embedded-postscript-code
-			    (filter (format #f pdfmark command))))))))))
+/S    /Launch
+/F    (~a)
+/OBJ pdfmark"))
+	       (display (string-append
+			 "4c @Wide 3c @High "
+			 (lout-embedded-postscript-code
+			  (filter (format #f pdfmark command)))))))))
+
 
 
 ;;; arch-tag: 0c717553-5cbb-46ed-937a-f844b6aeb145