aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--configure.ac2
-rw-r--r--src/guile/skribilo/engine/lout.scm105
-rw-r--r--src/guile/skribilo/package/Makefile.am1
-rw-r--r--src/guile/skribilo/package/eq.scm152
-rw-r--r--src/guile/skribilo/package/eq/Makefile.am4
-rw-r--r--src/guile/skribilo/package/eq/lout.scm184
-rw-r--r--src/guile/skribilo/package/slide.scm494
-rw-r--r--src/guile/skribilo/package/slide/Makefile.am4
-rw-r--r--src/guile/skribilo/package/slide/html.scm106
-rw-r--r--src/guile/skribilo/package/slide/latex.scm385
-rw-r--r--src/guile/skribilo/package/slide/lout.scm131
-rw-r--r--src/guile/skribilo/utils/compat.scm46
12 files changed, 897 insertions, 717 deletions
diff --git a/configure.ac b/configure.ac
index 17f914d..90ae155 100644
--- a/configure.ac
+++ b/configure.ac
@@ -35,6 +35,8 @@ AC_OUTPUT([Makefile
src/guile/skribilo/engine/Makefile
src/guile/skribilo/reader/Makefile
src/guile/skribilo/package/Makefile
+ src/guile/skribilo/package/slide/Makefile
+ src/guile/skribilo/package/eq/Makefile
src/guile/skribilo/skribe/Makefile
src/guile/skribilo/coloring/Makefile
doc/Makefile
diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm
index de6fb3e..17eb237 100644
--- a/src/guile/skribilo/engine/lout.scm
+++ b/src/guile/skribilo/engine/lout.scm
@@ -28,10 +28,11 @@
:autoload (ice-9 rdelim) (read-line))
+
;*---------------------------------------------------------------------*/
;* lout-verbatim-encoding ... */
;*---------------------------------------------------------------------*/
-(define lout-verbatim-encoding
+(define-public lout-verbatim-encoding
'((#\/ "\"/\"")
(#\\ "\"\\\\\"")
(#\| "\"|\"")
@@ -48,7 +49,7 @@
;*---------------------------------------------------------------------*/
;* lout-encoding ... */
;*---------------------------------------------------------------------*/
-(define lout-encoding
+(define-public lout-encoding
`(,@lout-verbatim-encoding
(#\ç "{ @Char ccedilla }")
(#\Ç "{ @Char Ccdeilla }")
@@ -349,7 +350,7 @@
(current-error-port))))
#t))
-(define (lout-tagify ident)
+(define-public (lout-tagify ident)
;; Return an "clean" identifier (a string) based on `ident' (a string),
;; suitable for Lout as an `@Tag' value.
(let ((tag-encoding '((#\, "-")
@@ -776,7 +777,7 @@
`(,node ,engine ,@children)))))
nodes))))
-(define (lout-embedded-postscript-code postscript)
+(define-public (lout-embedded-postscript-code postscript)
;; Return a string embedding PostScript code `postscript' into Lout code.
(string-append "\n"
"{ @BackEnd @Case {\n"
@@ -785,7 +786,7 @@
" }\n"
"} } @Graphic { }\n"))
-(define (lout-pdf-docinfo doc engine)
+(define-public (lout-pdf-docinfo doc engine)
;; Produce PostScript code that will produce PDF document information once
;; converted to PDF.
(let* ((filter-string (make-string-replace `(,@lout-verbatim-encoding
@@ -845,7 +846,7 @@
extra-fields)))
"\"/\"DOCINFO pdfmark\n")))
-(define (lout-output-pdf-meta-info doc engine)
+(define-public (lout-output-pdf-meta-info doc engine)
;; Produce PDF bookmarks (aka. "outline") for document `doc', as well as
;; document meta-information (or "docinfo"). This function makes sure that
;; both are only produced once, and only if the relevant customs ask for
@@ -2872,98 +2873,6 @@
(image :file output alt))))))
-
-;*---------------------------------------------------------------------*/
-;* Slides */
-;* */
-;* At some point, we might want to move this to `slide.scm'. */
-;*---------------------------------------------------------------------*/
-
-(use-modules (skribilo package slide))
-
-(markup-writer 'slide
- :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
- :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
- ;; 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
- :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))))))))
-
;*---------------------------------------------------------------------*/
;* Restore the base engine */
;*---------------------------------------------------------------------*/
diff --git a/src/guile/skribilo/package/Makefile.am b/src/guile/skribilo/package/Makefile.am
index 781b1aa..6cb30b9 100644
--- a/src/guile/skribilo/package/Makefile.am
+++ b/src/guile/skribilo/package/Makefile.am
@@ -4,3 +4,4 @@ dist_guilemodule_DATA = acmproc.scm french.scm jfp.scm letter.scm \
slide.scm web-article.scm web-book.scm \
eq.scm
+SUBDIRS = slide eq
diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
index 9be8f61..410f04f 100644
--- a/src/guile/skribilo/package/eq.scm
+++ b/src/guile/skribilo/package/eq.scm
@@ -44,6 +44,7 @@
(fluid-set! current-reader %skribilo-module-reader)
+
;;;
;;; Utilities.
@@ -140,147 +141,6 @@
;;;
-;;; Lout implementation
-;;;
-
-(let ((lout (find-engine 'lout)))
- (if (not lout)
- (skribe-error 'eq "Lout engine not found" lout)
- (let ((includes (engine-custom lout 'includes)))
- ;; Append the `eq' include file
- (engine-custom-set! lout 'includes
- (string-append includes "\n"
- "@SysInclude { eq }\n")))))
-
-;; FIXME: Reimplement the `symbol' writer so that `@Sym' is not used within
-;; equations (e.g. output `alpha' instead of `{ @Sym alpha }').
-
-(markup-writer 'eq (find-engine 'lout)
- :before "\n@Eq { "
- :action (lambda (node engine)
- (let ((eq (markup-body node)))
- ;(fprint (current-error-port) "eq=" eq)
- (output eq engine)))
- :after " }\n")
-
-
-;;
-;; `+' and `-' have lower precedence than `*', `/', `=', etc., so their
-;; operands do not need to be enclosed in braces.
-;;
-
-(markup-writer 'eq:+ (find-engine 'lout)
- :action (lambda (node engine)
- (let loop ((operands (markup-body node)))
- (if (null? operands)
- #t
- (begin
- ;; no braces
- (output (car operands) engine)
- (if (pair? (cdr operands))
- (display " + "))
- (loop (cdr operands)))))))
-
-(markup-writer 'eq:- (find-engine 'lout)
- :action (lambda (node engine)
- (let loop ((operands (markup-body node)))
- (if (null? operands)
- #t
- (begin
- ;; no braces
- (output (car operands) engine)
- (if (pair? (cdr operands))
- (display " - "))
- (loop (cdr operands)))))))
-
-(define-macro (simple-lout-markup-writer sym . lout-name)
- `(markup-writer ',(symbol-append 'eq: sym)
- (find-engine 'lout)
- :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 ,(string-append " "
- (if (null? lout-name)
- (symbol->string sym)
- (car lout-name))
- " ")))
- (loop (cdr operands))))))))
-
-(simple-lout-markup-writer * "times")
-(simple-lout-markup-writer / "over")
-(simple-lout-markup-writer =)
-(simple-lout-markup-writer <)
-(simple-lout-markup-writer >)
-(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)))))
-
-
-;;;
-;;; Sums, products, integrals, etc.
-;;;
-
-(define-macro (range-lout-markup-writer sym lout-name)
- `(markup-writer ',(symbol-append 'eq: sym) (find-engine 'lout)
- :action (lambda (node engine)
- (let ((from (markup-option node :from))
- (to (markup-option node :to))
- (body (markup-body node)))
- (display ,(string-append " { big " lout-name
- " from { "))
- (output from engine)
- (display " } to { ")
- (output to engine)
- (display " } { ")
- (output body engine)
- (display " } } ")))))
-
-(range-lout-markup-writer sum "sum")
-(range-lout-markup-writer product "prod")
-
-(markup-writer 'eq:script (find-engine 'lout)
- :action (lambda (node engine)
- (let ((body (markup-body node))
- (sup (markup-option node :sup))
- (sub (markup-option node :sub)))
- (display " { { ")
- (output body engine)
- (display " } ")
- (if sup
- (begin
- (display (if sub " supp { " " sup { "))
- (output sup engine)
- (display " } ")))
- (if sub
- (begin
- (display " on { ")
- (output sub engine)
- (display " } ")))
- (display " } "))))
-
-
-;;;
;;; Text-only implementation.
;;;
@@ -301,6 +161,16 @@
(display " / "))
(loop (cdr operands)))))))
+
+;;;
+;;; Initialization.
+;;;
+
+(when-engine-is-loaded 'lout
+ (lambda ()
+ (resolve-module '(skribilo package eq lout))))
+
+
;;; arch-tag: 58764650-2684-47a6-8cc7-6288f2b474da
;;; eq.scm ends here
diff --git a/src/guile/skribilo/package/eq/Makefile.am b/src/guile/skribilo/package/eq/Makefile.am
new file mode 100644
index 0000000..c7b4f93
--- /dev/null
+++ b/src/guile/skribilo/package/eq/Makefile.am
@@ -0,0 +1,4 @@
+guilemoduledir = $(GUILE_SITE)/skribilo/package/eq
+dist_guilemodule_DATA = lout.scm
+
+## arch-tag: 3e816c9a-7989-4baa-b38b-a095a5428ba1
diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm
new file mode 100644
index 0000000..30a6d39
--- /dev/null
+++ b/src/guile/skribilo/package/eq/lout.scm
@@ -0,0 +1,184 @@
+;;; lout.scm -- Lout implementation of the `eq' package.
+;;;
+;;; Copyright 2005, 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-module (skribilo package eq lout)
+ :use-module (skribilo package eq)
+ :use-module (skribilo ast)
+ :autoload (skribilo output) (output)
+ :use-module (skribilo writer)
+ :use-module (skribilo engine)
+ :use-module (skribilo lib)
+ :use-module (skribilo utils syntax)
+ :use-module (skribilo skribe utils) ;; `the-options', etc.
+ :use-module (ice-9 optargs))
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+
+;;;
+;;; Initialization.
+;;;
+
+(let ((lout (find-engine 'lout)))
+ (if (not lout)
+ (skribe-error 'eq "Lout engine not found" lout)
+ (let ((includes (engine-custom lout 'includes)))
+ ;; Append the `eq' include file
+ (engine-custom-set! lout 'includes
+ (string-append includes "\n"
+ "@SysInclude { eq }\n")))))
+
+
+;;;
+;;; Simple markup writers.
+;;;
+
+
+;; FIXME: Reimplement the `symbol' writer so that `@Sym' is not used within
+;; equations (e.g. output `alpha' instead of `{ @Sym alpha }').
+
+(markup-writer 'eq (find-engine 'lout)
+ :before "\n@Eq { "
+ :action (lambda (node engine)
+ (let ((eq (markup-body node)))
+ ;(fprint (current-error-port) "eq=" eq)
+ (output eq engine)))
+ :after " }\n")
+
+
+;;
+;; `+' and `-' have lower precedence than `*', `/', `=', etc., so their
+;; operands do not need to be enclosed in braces.
+;;
+
+(markup-writer 'eq:+ (find-engine 'lout)
+ :action (lambda (node engine)
+ (let loop ((operands (markup-body node)))
+ (if (null? operands)
+ #t
+ (begin
+ ;; no braces
+ (output (car operands) engine)
+ (if (pair? (cdr operands))
+ (display " + "))
+ (loop (cdr operands)))))))
+
+(markup-writer 'eq:- (find-engine 'lout)
+ :action (lambda (node engine)
+ (let loop ((operands (markup-body node)))
+ (if (null? operands)
+ #t
+ (begin
+ ;; no braces
+ (output (car operands) engine)
+ (if (pair? (cdr operands))
+ (display " - "))
+ (loop (cdr operands)))))))
+
+(define-macro (simple-lout-markup-writer sym . lout-name)
+ `(markup-writer ',(symbol-append 'eq: sym)
+ (find-engine 'lout)
+ :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 ,(string-append " "
+ (if (null? lout-name)
+ (symbol->string sym)
+ (car lout-name))
+ " ")))
+ (loop (cdr operands))))))))
+
+(simple-lout-markup-writer * "times")
+(simple-lout-markup-writer / "over")
+(simple-lout-markup-writer =)
+(simple-lout-markup-writer <)
+(simple-lout-markup-writer >)
+(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)))))
+
+
+
+;;;
+;;; Sums, products, integrals, etc.
+;;;
+
+(define-macro (range-lout-markup-writer sym lout-name)
+ `(markup-writer ',(symbol-append 'eq: sym) (find-engine 'lout)
+ :action (lambda (node engine)
+ (let ((from (markup-option node :from))
+ (to (markup-option node :to))
+ (body (markup-body node)))
+ (display ,(string-append " { big " lout-name
+ " from { "))
+ (output from engine)
+ (display " } to { ")
+ (output to engine)
+ (display " } { ")
+ (output body engine)
+ (display " } } ")))))
+
+(range-lout-markup-writer sum "sum")
+(range-lout-markup-writer product "prod")
+
+(markup-writer 'eq:script (find-engine 'lout)
+ :action (lambda (node engine)
+ (let ((body (markup-body node))
+ (sup (markup-option node :sup))
+ (sub (markup-option node :sub)))
+ (display " { { ")
+ (output body engine)
+ (display " } ")
+ (if sup
+ (begin
+ (display (if sub " supp { " " sup { "))
+ (output sup engine)
+ (display " } ")))
+ (if sub
+ (begin
+ (display " on { ")
+ (output sub engine)
+ (display " } ")))
+ (display " } "))))
+
+
+;;; arch-tag: 2a1410e5-977e-4600-b781-3d57f4409b35
diff --git a/src/guile/skribilo/package/slide.scm b/src/guile/skribilo/package/slide.scm
index 5b39239..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 #f "~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 #f "~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)))))
diff --git a/src/guile/skribilo/package/slide/Makefile.am b/src/guile/skribilo/package/slide/Makefile.am
new file mode 100644
index 0000000..e5fb908
--- /dev/null
+++ b/src/guile/skribilo/package/slide/Makefile.am
@@ -0,0 +1,4 @@
+guilemoduledir = $(GUILE_SITE)/skribilo/package/slide
+dist_guilemodule_DATA = latex.scm html.scm lout.scm
+
+## arch-tag: 56b5fa5c-bb6a-4692-b929-74bdd032431c
diff --git a/src/guile/skribilo/package/slide/html.scm b/src/guile/skribilo/package/slide/html.scm
new file mode 100644
index 0000000..5398fbf
--- /dev/null
+++ b/src/guile/skribilo/package/slide/html.scm
@@ -0,0 +1,106 @@
+;;; html.scm -- HTML implementation of the `slide' package.
+;;;
+;;; Copyright 2003, 2004 Manuel Serrano
+;;;
+;;;
+;;; 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 html)
+ :use-module (skribilo package slide))
+
+
+(define-public (%slide-html-initialize!)
+ (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 #f "~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>")))))
+
+;*---------------------------------------------------------------------*/
+;* 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")))
+
+
+;;; 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
new file mode 100644
index 0000000..15f4535
--- /dev/null
+++ b/src/guile/skribilo/package/slide/latex.scm
@@ -0,0 +1,385 @@
+;;; latex.scm -- LaTeX implementation of the `slide' package.
+;;;
+;;; Copyright 2003, 2004 Manuel Serrano
+;;;
+;;;
+;;; 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 latex)
+ :use-module (skribilo package slide))
+
+
+(define-public %slide-latex-mode 'seminar)
+
+(define-public (%slide-latex-initialize!)
+ (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))))
+
+;*---------------------------------------------------------------------*/
+;* &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")
+
+;*---------------------------------------------------------------------*/
+;* &slide-prosper-predocument ... */
+;*---------------------------------------------------------------------*/
+(define &slide-prosper-predocument
+ "\\slideCaption{}\n")
+
+;*---------------------------------------------------------------------*/
+;* 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 #f "~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)))))
+
+
+;;; 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
new file mode 100644
index 0000000..f816469
--- /dev/null
+++ b/src/guile/skribilo/package/slide/lout.scm
@@ -0,0 +1,131 @@
+;;; lout.scm -- Lout implementation of the `slide' package.
+;;;
+;;; Copyright 2005, 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 lout)
+ :use-module (skribilo utils syntax)
+
+ ;; FIXME: For some reason, changing the following `autoload' in
+ ;; `use-modules' doesn't work.
+
+ :autoload (skribilo engine lout) (lout-tagify lout-output-pdf-meta-info)
+ )
+
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+;;; TODO:
+;;;
+;;; 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 "
+[ {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
+
+[ /Type /Action
+ /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
diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm
index 3fce068..9ed9f3e 100644
--- a/src/guile/skribilo/utils/compat.scm
+++ b/src/guile/skribilo/utils/compat.scm
@@ -136,30 +136,28 @@
("acmproc.skr" . (skribilo package acmproc))))
(define*-public (skribe-load file :rest args)
- (call/cc
- (lambda (return)
- (guard (c ((file-search-error? c)
- ;; Regular file loading failed. Try built-ins.
- (let ((mod-name (assoc-ref %skribe-known-files file)))
- (if mod-name
- (begin
- (if (> (*verbose*) 1)
- (format (current-error-port)
- " skribe-load: `~a' -> `~a'~%"
- file mod-name))
- (let ((mod (false-if-exception
- (resolve-module mod-name))))
- (if (not mod)
- (raise c)
- (begin
- (set-module-uses!
- (current-module)
- (cons mod (module-uses (current-module))))
- (return #t)))))
- (raise c)))))
-
- ;; Try a regular `load-document'.
- (apply load-document file args)))))
+ (guard (c ((file-search-error? c)
+ ;; Regular file loading failed. Try built-ins.
+ (let ((mod-name (assoc-ref %skribe-known-files file)))
+ (if mod-name
+ (begin
+ (if (> (*verbose*) 1)
+ (format (current-error-port)
+ " skribe-load: `~a' -> `~a'~%"
+ file mod-name))
+ (let ((mod (false-if-exception
+ (resolve-module mod-name))))
+ (if (not mod)
+ (raise c)
+ (begin
+ (set-module-uses!
+ (current-module)
+ (cons mod (module-uses (current-module))))
+ #t))))
+ (raise c)))))
+
+ ;; Try a regular `load-document'.
+ (apply load-document file args)))
(define-public skribe-include include-document)