diff options
author | Ludovic Court`es | 2006-02-17 17:24:51 +0000 |
---|---|---|
committer | Ludovic Court`es | 2006-02-17 17:24:51 +0000 |
commit | 02d1bf3d462a8356ec62a1c3aa07cb72cd58ea2b (patch) | |
tree | 0eafc06b63644d9adaadf8501b243a9a27231b27 /src/guile/skribilo/package/slide/html.scm | |
parent | b5e6483d3823d197e5c20d574487db5e916a8555 (diff) | |
download | skribilo-02d1bf3d462a8356ec62a1c3aa07cb72cd58ea2b.tar.gz skribilo-02d1bf3d462a8356ec62a1c3aa07cb72cd58ea2b.tar.lz skribilo-02d1bf3d462a8356ec62a1c3aa07cb72cd58ea2b.zip |
`slide' and `eq': moved engine-specific code in separate modules.
* src/guile/skribilo/package/slide.scm: Moved engine-specific code to
`slide/ENGINE.scm'.
* src/guile/skribilo/package/eq.scm: Likewise.
* configure.ac: Produce the new Makefiles.
* src/guile/skribilo/engine/lout.scm: Export more stuff.
Moved the slide-related things out of here.
* src/guile/skribilo/utils/compat.scm (skribe-load): Removed `call/cc'
(not needed).
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-51
Diffstat (limited to 'src/guile/skribilo/package/slide/html.scm')
-rw-r--r-- | src/guile/skribilo/package/slide/html.scm | 106 |
1 files changed, 106 insertions, 0 deletions
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 |