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

Patches applied:

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

   - Merge from lcourtes@laas.fr--2005-mobile
   - More Skribe compatibility fixes (more exported bindings).
   - Implemented `lout-illustration' for non-Lout engines.
   - Created the `(skribilo utils files)' module.
   - Skribe reader: consider square brackets as delimiters.
   - `skribilo': do not catch all exceptions, let a stack trace be output
     intead.
   - Added the equation formatting package (unfinished, undocumented).
   - `eq' package: added the `script' markup.
   - Implemented `when-engine-is-loaded'.
   - Fixes for `when-engine-is-loaded'.
   - `slide' and `eq': moved engine-specific code in separate modules.
   - Lout engine: fixed use of `@Sym' so that it works fine within `@Eq'.
   - `eq': Added `eq:in', `eq:notin' and their Lout writers.
   - `eq': added the `apply' markup.

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

1 files changed, 40 insertions, 454 deletions

diff --git a/src/guile/skribilo/package/slide.scm b/src/guile/skribilo/package/slide.scm
index ddbbd1d..8968d00 100644
--- a/src/guile/skribilo/package/slide.scm
+++ b/src/guile/skribilo/package/slide.scm
@@ -1,82 +1,60 @@
-;*=====================================================================*/
-;*    serrano/prgm/project/skribe/skr/slide.skr                        */
-;*    -------------------------------------------------------------    */
-;*    Author      :  Manuel Serrano                                    */
-;*    Creation    :  Fri Oct  3 12:22:13 2003                          */
-;*    Last change :  Mon Aug 23 09:08:21 2004 (serrano)                */
-;*    Copyright   :  2003-04 Manuel Serrano                            */
-;*    -------------------------------------------------------------    */
-;*    Skribe style for slides                                          */
-;*=====================================================================*/
+;;; slide.scm  --  Overhead transparencies.
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;; Copyright 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; USA.
+
 
 (define-skribe-module (skribilo package slide)
-  :autoload (skribilo engine html) (html-width html-title-authors))
+  :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!))
 
 
 ;*---------------------------------------------------------------------*/
 ;*    slide-options                                                    */
 ;*---------------------------------------------------------------------*/
-(define &slide-load-options (skribe-load-options))
-
-;*---------------------------------------------------------------------*/
-;*    &slide-seminar-predocument ...                                   */
-;*---------------------------------------------------------------------*/
-(define &slide-seminar-predocument
-   "\\special{landscape}
-   \\slideframe{none}
-   \\centerslidesfalse
-   \\raggedslides[0pt]
-   \\renewcommand{\\slideleftmargin}{0.2in}
-   \\renewcommand{\\slidetopmargin}{0.3in}
-   \\newdimen\\slidewidth \\slidewidth 9in")
-
-;*---------------------------------------------------------------------*/
-;*    &slide-seminar-maketitle ...                                     */
-;*---------------------------------------------------------------------*/
-(define &slide-seminar-maketitle
-   "\\def\\labelitemi{$\\bullet$}
-   \\def\\labelitemii{$\\circ$}
-   \\def\\labelitemiii{$\\diamond$}
-   \\def\\labelitemiv{$\\cdot$}
-   \\pagestyle{empty}
-   \\slideframe{none}
-   \\centerslidestrue
-   \\begin{slide}
-   \\date{}
-   \\maketitle
-   \\end{slide}
-   \\slideframe{none}
-   \\centerslidesfalse")
+(define-public &slide-load-options (skribe-load-options))
 
-;*---------------------------------------------------------------------*/
-;*    &slide-prosper-predocument ...                                   */
-;*---------------------------------------------------------------------*/
-(define &slide-prosper-predocument
-   "\\slideCaption{}\n")
 
 ;*---------------------------------------------------------------------*/
 ;*    %slide-the-slides ...                                            */
 ;*---------------------------------------------------------------------*/
 (define %slide-the-slides '())
 (define %slide-the-counter 0)
-(define %slide-initialized #f)
-(define %slide-latex-mode 'seminar)
 
 ;*---------------------------------------------------------------------*/
 ;*    %slide-initialize! ...                                           */
 ;*---------------------------------------------------------------------*/
-(define (%slide-initialize!)
-   (unless %slide-initialized
-      (set! %slide-initialized #t)
-      (case %slide-latex-mode
-	 ((seminar)
-	  (%slide-seminar-setup!))
-	 ((advi)
-	  (%slide-advi-setup!))
-	 ((prosper)
-	  (%slide-prosper-setup!))
-	 (else
-	  (skribe-error 'slide "Illegal latex mode" %slide-latex-mode)))))
+(format (current-error-port) "Slides initializing...~%")
+
+;; Register specific implementations for lazy loading.
+(when-engine-is-loaded 'latex
+  (lambda ()
+    (%slide-latex-initialize!)))
+(when-engine-is-loaded 'html
+  (lambda ()
+    (%slide-html-initialize!)))
+(when-engine-is-loaded 'lout
+  (lambda ()
+    (%slide-lout-initialize!)))
+
 
 ;*---------------------------------------------------------------------*/
 ;*    slide ...                                                        */
@@ -89,7 +67,6 @@
 		      (vspace #f) (vfill #f)
 		      (transition #f)
 		      (bg #f) (image #f))
-   (%slide-initialize!)
    (let ((s (new container
 	       (markup 'slide)
 	       (ident (if (not ident)
@@ -288,403 +265,12 @@
       :action (lambda (n e)
 		 (output (markup-option n :alt) e))))
 
-;*---------------------------------------------------------------------*/
-;*    slide-body-width ...                                             */
-;*---------------------------------------------------------------------*/
-(define (slide-body-width e)
-   (let ((w (engine-custom e 'body-width)))
-      (if (or (number? w) (string? w)) w 95.)))
-
-;*---------------------------------------------------------------------*/
-;*    html-slide-title ...                                             */
-;*---------------------------------------------------------------------*/
-(define (html-slide-title n e)
-   (let* ((title (markup-body n))
-	  (authors (markup-option n 'author))
-	  (tbg (engine-custom e 'title-background))
-	  (tfg (engine-custom e 'title-foreground))
-	  (tfont (engine-custom e 'title-font)))
-      (printf "<center><table cellspacing='0' cellpadding='0' width=\"~a\" class=\"skribetitle\"><tbody>\n<tr>"
-	      (html-width (slide-body-width e)))
-      (if (string? tbg)
-	  (printf "<td bgcolor=\"~a\">" tbg)
-	  (display "<td>"))
-      (if (string? tfg)
-	  (printf "<font color=\"~a\">" tfg))
-      (if title
-	  (begin
-	     (display "<center>")
-	     (if (string? tfont)
-		 (begin
-		    (printf "<font ~a><strong>" tfont)
-		    (output title e)
-		    (display "</strong></font>"))
-		 (begin
-		    (printf "<div class=\"skribetitle\"><strong><big><big><big>")
-		    (output title e)
-		    (display "</big></big></big></strong</div>")))
-	     (display "</center>\n")))
-      (if (not authors)
-	  (display "\n")
-	  (html-title-authors authors e))
-      (if (string? tfg)
-	  (display "</font>"))
-      (display "</td></tr></tbody></table></center>\n")))
 
 ;*---------------------------------------------------------------------*/
 ;*    slide-number ...                                                 */
 ;*---------------------------------------------------------------------*/
-(define (slide-number)
+(define-public (slide-number)
    (length (filter (lambda (n)
 		      (and (is-markup? n 'slide)
 			   (markup-option n :number)))
 		   %slide-the-slides)))
-
-;*---------------------------------------------------------------------*/
-;*    html                                                             */
-;*---------------------------------------------------------------------*/
-(let ((he (find-engine 'html)))
-   (skribe-message "HTML slides setup...\n")
-   ;; &html-page-title
-   (markup-writer '&html-document-title he
-      :predicate (lambda (n e) %slide-initialized)
-      :action html-slide-title)
-   ;; slide
-   (markup-writer 'slide he
-      :options '(:title :number :transition :toc :bg)
-      :before (lambda (n e)
-		 (printf "<a name=\"~a\">" (markup-ident n))
-		 (display "<br>\n"))
-      :action (lambda (n e)
-		 (let ((nb (markup-option n :number))
-		       (t (markup-option n :title)))
-		    (skribe-eval
-		     (center
-			(color :width (slide-body-width e)
-			   :bg (or (markup-option n :bg) "#ffffff")
-			   (table :width 100.
-			      (tr (th :align 'left
-				     (list
-				      (if nb
-					  (format "~a / ~a -- " nb
-						  (slide-number)))
-				      t)))
-			      (tr (td (hrule)))
-			      (tr (td :width 100. :align 'left
-				     (markup-body n))))
-			   (linebreak)))
-		     e)))
-      :after "<br>")
-   ;; slide-vspace
-   (markup-writer 'slide-vspace he
-      :action (lambda (n e) (display "<br>"))))
-
-;*---------------------------------------------------------------------*/
-;*    latex                                                            */
-;*---------------------------------------------------------------------*/
-(define &latex-slide #f)
-(define &latex-pause #f)
-(define &latex-embed #f)
-(define &latex-record #f)
-(define &latex-play #f)
-(define &latex-play* #f)
-
-;;; FIXME: We shouldn't load `latex.scm' from here.  Instead, we should
-;;; register a hook on its load.
-(let ((le (find-engine 'latex)))
-   ;; slide-vspace
-   (markup-writer 'slide-vspace le
-      :options '(:unit)
-      :action (lambda (n e)
-		 (display "\n\\vspace{")
-		 (output (markup-body n) e)
-		 (printf " ~a}\n\n" (markup-option n :unit))))
-   ;; slide-slide
-   (markup-writer 'slide le
-      :options '(:title :number :transition :vfill :toc :vspace :image)
-      :action (lambda (n e)
-		 (if (procedure? &latex-slide)
-		     (&latex-slide n e))))
-   ;; slide-pause
-   (markup-writer 'slide-pause le
-      :options '()
-      :action (lambda (n e)
-		 (if (procedure? &latex-pause)
-		     (&latex-pause n e))))
-   ;; slide-embed
-   (markup-writer 'slide-embed le
-      :options '(:alt :command :geometry-opt :geometry
-		      :rgeometry :transient :transient-opt)
-      :action (lambda (n e)
-		 (if (procedure? &latex-embed)
-		     (&latex-embed n e))))
-   ;; slide-record
-   (markup-writer 'slide-record le
-      :options '(:tag :play)
-      :action (lambda (n e)
-		 (if (procedure? &latex-record)
-		     (&latex-record n e))))
-   ;; slide-play
-   (markup-writer 'slide-play le
-      :options '(:tag :color)
-      :action (lambda (n e)
-		 (if (procedure? &latex-play)
-		     (&latex-play n e))))
-   ;; slide-play*
-   (markup-writer 'slide-play* le
-      :options '(:tag :color :scolor)
-      :action (lambda (n e)
-		 (if (procedure? &latex-play*)
-		     (&latex-play* n e)))))
-
-;*---------------------------------------------------------------------*/
-;*    %slide-seminar-setup! ...                                        */
-;*---------------------------------------------------------------------*/
-(define (%slide-seminar-setup!)
-   (skribe-message "Seminar slides setup...\n")
-   (let ((le (find-engine 'latex))
-	 (be (find-engine 'base)))
-      ;; latex configuration
-      (define (seminar-slide n e)
-	 (let ((nb (markup-option n :number))
-	       (t (markup-option n :title)))
-	    (display "\\begin{slide}\n")
-	    (if nb (printf "~a/~a -- " nb (slide-number)))
-	    (output t e)
-	    (display "\\hrule\n"))
-	 (output (markup-body n) e)
-	 (if (markup-option n :vill) (display "\\vfill\n"))
-	 (display "\\end{slide}\n"))
-      (engine-custom-set! le 'documentclass
-	 "\\documentclass[landscape]{seminar}\n")
-      (let ((o (engine-custom le 'predocument)))
-	 (engine-custom-set! le 'predocument
-	    (if (string? o)
-		(string-append &slide-seminar-predocument o)
-		&slide-seminar-predocument)))
-      (engine-custom-set! le 'maketitle
-	 &slide-seminar-maketitle)
-      (engine-custom-set! le 'hyperref-usepackage
-	 "\\usepackage[setpagesize=false]{hyperref}\n")
-      ;; slide-slide
-      (set! &latex-slide seminar-slide)))
-
-;*---------------------------------------------------------------------*/
-;*    %slide-advi-setup! ...                                           */
-;*---------------------------------------------------------------------*/
-(define (%slide-advi-setup!)
-   (skribe-message "Generating `Advi Seminar' slides...\n")
-   (let ((le (find-engine 'latex))
-	 (be (find-engine 'base)))
-      (define (advi-geometry geo)
-	 (let ((r (pregexp-match "([0-9]+)x([0-9]+)" geo)))
-	    (if (pair? r)
-		(let* ((w (cadr r))
-		       (w' (string->integer w))
-		       (w'' (number->string (/ w' *skribe-slide-advi-scale*)))
-		       (h (caddr r))
-		       (h' (string->integer h))
-		       (h'' (number->string (/ h' *skribe-slide-advi-scale*))))
-		   (values "" (string-append w "x" h "+!x+!y")))
-		(let ((r (pregexp-match "([0-9]+)x([0-9]+)[+](-?[0-9]+)[+](-?[0-9]+)" geo)))
-		   (if (pair? r)
-		       (let ((w (number->string (/ (string->integer (cadr r))
-						   *skribe-slide-advi-scale*)))
-			     (h (number->string (/ (string->integer (caddr r))
-						   *skribe-slide-advi-scale*)))
-			     (x (cadddr r))
-			     (y (car (cddddr r))))
-			  (values (string-append "width=" w "cm,height=" h "cm")
-				  "!g"))
-		       (values "" geo))))))
-      (define (advi-transition trans)
-	 (cond
-	    ((string? trans)
-	     (printf "\\advitransition{~s}" trans))
-	    ((and (symbol? trans)
-		  (memq trans '(wipe block slide)))
-	     (printf "\\advitransition{~s}" trans))
-	    (else
-	     #f)))
-      ;; latex configuration
-      (define (advi-slide n e)
-	 (let ((i (markup-option n :image))
-	       (n (markup-option n :number))
-	       (t (markup-option n :title))
-	       (lt (markup-option n :transition))
-	       (gt (engine-custom e 'transition)))
-	    (if (and i (engine-custom e 'advi))
-		(printf "\\advibg[global]{image=~a}\n"
-			(if (and (pair? i)
-				 (null? (cdr i))
-				 (string? (car i)))
-			    (car i)
-			    i)))
-	    (display "\\begin{slide}\n")
-	    (advi-transition (or lt gt))
-	    (if n (printf "~a/~a -- " n (slide-number)))
-	    (output t e)
-	    (display "\\hrule\n"))
-	 (output (markup-body n) e)
-	 (if (markup-option n :vill) (display "\\vfill\n"))
-	 (display "\\end{slide}\n\n\n"))
-      ;; advi record
-      (define (advi-record n e)
-	 (display "\\advirecord")
-	 (when (markup-option n :play) (display "[play]"))
-	 (printf "{~a}{" (markup-option n :tag))
-	 (output (markup-body n) e)
-	 (display "}"))
-      ;; advi play
-      (define (advi-play n e)
-	 (display "\\adviplay")
-	 (let ((c (markup-option n :color)))
-	    (when c
-	       (display "[")
-	       (display (skribe-get-latex-color c))
-	       (display "]")))
-	 (printf "{~a}" (markup-option n :tag)))
-      ;; advi play*
-      (define (advi-play* n e)
-	 (let ((c (skribe-get-latex-color (markup-option n :color)))
-	       (d (skribe-get-latex-color (markup-option n :scolor))))
-	    (let loop ((lbls (markup-body n))
-		       (last #f))
-	       (when last
-		  (display "\\adviplay[")
-		  (display d)
-		  (printf "]{~a}" last))
-	       (when (pair? lbls)
-		  (let ((lbl (car lbls)))
-		     (match-case lbl
-			((?id ?col)
-			 (display "\\adviplay[")
-			 (display (skribe-get-latex-color col))
-			 (printf "]{" ~a "}" id)
-			 (skribe-eval (slide-pause) e)
-			 (loop (cdr lbls) id))
-			(else
-			 (display "\\adviplay[")
-			 (display c)
-			 (printf "]{~a}" lbl)
-			 (skribe-eval (slide-pause) e)
-			 (loop (cdr lbls) lbl))))))))
-      (engine-custom-set! le 'documentclass
-	 "\\documentclass{seminar}\n")
-      (let ((o (engine-custom le 'predocument)))
-	 (engine-custom-set! le 'predocument
-	    (if (string? o)
-		(string-append &slide-seminar-predocument o)
-		&slide-seminar-predocument)))
-      (engine-custom-set! le 'maketitle
-	 &slide-seminar-maketitle)
-      (engine-custom-set! le 'usepackage
-	 (string-append "\\usepackage{advi}\n"
-			(engine-custom le 'usepackage)))
-      ;; slide
-      (set! &latex-slide advi-slide)
-      (set! &latex-pause
-	    (lambda (n e) (display "\\adviwait\n")))
-      (set! &latex-embed
-	    (lambda (n e)
-	       (let ((geometry-opt (markup-option n :geometry-opt))
-		     (geometry (markup-option n :geometry))
-		     (rgeometry (markup-option n :rgeometry))
-		     (transient (markup-option n :transient))
-		     (transient-opt (markup-option n :transient-opt))
-		     (cmd (markup-option n :command)))
-		  (let* ((a (string-append "ephemeral="
-					   (symbol->string (gensym))))
-			 (c (cond
-			       (geometry
-				(string-append cmd " "
-					       geometry-opt " "
-					       geometry))
-			       (rgeometry
-				(multiple-value-bind (aopt dopt)
-				   (advi-geometry rgeometry)
-				   (set! a (string-append a "," aopt))
-				   (string-append cmd " "
-						  geometry-opt " "
-						  dopt)))
-			       (else
-				cmd)))
-			 (c (if (and transient transient-opt)
-				(string-append c " " transient-opt " !p")
-				c)))
-		     (printf "\\adviembed[~a]{~a}\n" a c)))))
-      (set! &latex-record advi-record)
-      (set! &latex-play advi-play)
-      (set! &latex-play* advi-play*)))
-
-;*---------------------------------------------------------------------*/
-;*    %slide-prosper-setup! ...                                        */
-;*---------------------------------------------------------------------*/
-(define (%slide-prosper-setup!)
-   (skribe-message "Generating `Prosper' slides...\n")
-   (let ((le (find-engine 'latex))
-	 (be (find-engine 'base))
-	 (overlay-count 0))
-      ;; transitions
-      (define (prosper-transition trans)
-	 (cond
-	    ((string? trans)
-	     (printf "[~s]" trans))
-	    ((eq? trans 'slide)
-	     (printf "[Blinds]"))
-	    ((and (symbol? trans)
-		  (memq trans '(split blinds box wipe dissolve glitter)))
-	     (printf "[~s]"
-		     (string-upcase (symbol->string trans))))
-	    (else
-	     #f)))
-      ;; latex configuration
-      (define (prosper-slide n e)
-	 (let* ((i (markup-option n :image))
-		(t (markup-option n :title))
-		(lt (markup-option n :transition))
-		(gt (engine-custom e 'transition))
-		(pa (search-down (lambda (x) (is-markup? x 'slide-pause)) n))
-		(lpa (length pa)))
-	    (set! overlay-count 1)
-	    (if (>= lpa 1) (printf "\\overlays{~a}{%\n" (+ 1 lpa)))
-	    (display "\\begin{slide}")
-	    (prosper-transition (or lt gt))
-	    (display "{")
-	    (output t e)
-	    (display "}\n")
-	    (output (markup-body n) e)
-	    (display "\\end{slide}\n")
-	    (if (>= lpa 1) (display "}\n"))
-	    (newline)
-	    (newline)))
-      (engine-custom-set! le 'documentclass "\\documentclass[pdf,skribe,slideColor,nototal]{prosper}\n")
-      (let* ((cap (engine-custom le 'slide-caption))
-	     (o (engine-custom le 'predocument))
-	     (n (if (string? cap)
-		    (format "~a\\slideCaption{~a}\n"
-			    &slide-prosper-predocument
-			    cap)
-		    &slide-prosper-predocument)))
-	 (engine-custom-set! le 'predocument
-	    (if (string? o) (string-append n o) n)))
-      (engine-custom-set! le 'hyperref-usepackage "\\usepackage{hyperref}\n")
-      ;; writers
-      (set! &latex-slide prosper-slide)
-      (set! &latex-pause
-	    (lambda (n e)
-	       (set! overlay-count (+ 1 overlay-count))
-	       (printf "\\FromSlide{~s}%\n" overlay-count)))))
-
-;*---------------------------------------------------------------------*/
-;*    Setup ...                                                        */
-;*---------------------------------------------------------------------*/
-(let* ((opt &slide-load-options)
-       (p (memq :prosper opt)))
-   (if (and (pair? p) (pair? (cdr p)) (cadr p))
-       ;; prosper
-       (set! %slide-latex-mode 'prosper)
-       (let ((a (memq :advi opt)))
-	  (if (and (pair? a) (pair? (cdr a)) (cadr a))
-	      ;; advi
-	      (set! %slide-latex-mode 'advi)))))