From 6a06d0449967e85c3aa806736e1a27c9db99db71 Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Wed, 25 Oct 2006 15:04:52 +0000 Subject: slide: Improved HTML output, especially wrt. the use of CSS. * src/guile/skribilo/package/slide.scm (slide-topic): Pass CLASS as the `class' slot rather than as an option. (slide-subtopic): Likewise. * src/guile/skribilo/package/slide/base.scm (make-outline-slide): Use `(markup-class topic)' instead of `(markup-option topic :class)'. * src/guile/skribilo/package/slide/html.scm: Use a native Guile module. Use `format' instead of `printf'. (%slide-html-initialize): Simply issue `div' tags when a class is specified. git-archimport-id: skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-10 --- src/guile/skribilo/package/slide.scm | 10 ++- src/guile/skribilo/package/slide/base.scm | 2 +- src/guile/skribilo/package/slide/html.scm | 123 +++++++++++++++++++++--------- 3 files changed, 96 insertions(+), 39 deletions(-) (limited to 'src/guile') diff --git a/src/guile/skribilo/package/slide.scm b/src/guile/skribilo/package/slide.scm index c0a8473..898f105 100644 --- a/src/guile/skribilo/package/slide.scm +++ b/src/guile/skribilo/package/slide.scm @@ -228,13 +228,14 @@ ;*---------------------------------------------------------------------*/ (define-markup (slide-topic #!rest opt #!key title (outline? #t) - (ident #f) (class "slide-topic")) + (ident #f) (class #f)) (new container (markup 'slide-topic) (required-options '(:title :outline?)) (ident (or ident (symbol->string (gensym 'slide-topic)))) + (class class) (options `((:outline? ,outline?) - ,@(the-options opt :outline?))) + ,@(the-options opt :outline? :class))) (body (the-body opt)))) ;*---------------------------------------------------------------------*/ @@ -242,13 +243,14 @@ ;*---------------------------------------------------------------------*/ (define-markup (slide-subtopic #!rest opt #!key title (outline? #f) - (ident #f) (class "slide-subtopic")) + (ident #f) (class #f)) (new container (markup 'slide-subtopic) (required-options '(:title :outline?)) (ident (or ident (symbol->string (gensym 'slide-subtopic)))) + (class class) (options `((:outline? ,outline?) - ,@(the-options opt :outline?))) + ,@(the-options opt :outline? :class))) (body (the-body opt)))) diff --git a/src/guile/skribilo/package/slide/base.scm b/src/guile/skribilo/package/slide/base.scm index c8e652c..1eeb25f 100644 --- a/src/guile/skribilo/package/slide/base.scm +++ b/src/guile/skribilo/package/slide/base.scm @@ -155,7 +155,7 @@ (is-markup? n 'slide-topic)) topic)))) (output (slide :title %slide-outline-title :toc #f - :class (markup-option topic :class) + :class (markup-class topic) ;; The mark below is needed for cross-referencing by PDF ;; bookmarks. (if (markup-ident topic) (mark (markup-ident topic)) "") diff --git a/src/guile/skribilo/package/slide/html.scm b/src/guile/skribilo/package/slide/html.scm index d47ef82..8fcbfed 100644 --- a/src/guile/skribilo/package/slide/html.scm +++ b/src/guile/skribilo/package/slide/html.scm @@ -18,43 +18,77 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. -(define-skribe-module (skribilo package slide html) - :use-module (skribilo package slide)) +(define-module (skribilo package slide html) + :use-module (skribilo utils syntax) + :use-module (skribilo ast) + :use-module (skribilo engine) + :use-module (skribilo writer) + :autoload (skribilo resolve) (resolve!) + :autoload (skribilo output) (output) + :autoload (skribilo evaluator) (evaluate-document) + :autoload (skribilo engine html) (html-width html-title-authors) + :use-module (skribilo package slide) + :use-module ((skribilo package base) :select (ref))) + + +(fluid-set! current-reader %skribilo-module-reader) + + + (define-public (%slide-html-initialize!) (let ((he (find-engine 'html))) - (skribe-message "HTML slides setup...\n") + (display "HTML slides setup...\n" (current-error-port)) + ;; &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 "" (markup-ident n)) + (format #t "" (markup-ident n)) (display "
\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))) + (t (markup-option n :title)) + (class (markup-class n))) + (if class + (let ((title-class (string-append class "-title"))) + ;; When a class is specified, let the user play + ;; with CSS. + (format #t "\n
" class) + (format #t "\n\n" + (markup-ident n)) + (format #t "
" title-class) + (format #t "~a / ~a -- " nb (slide-number)) + (output t e) + (display "
\n") + (output (markup-body n) e) + (display "\n
\n")) + ;; When no class is specified, do HTML tricks. + (evaluate-document + (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 "
") + ;; slide-vspace (markup-writer 'slide-vspace he :action (lambda (n e) (display "
"))))) @@ -76,23 +110,23 @@ (tbg (engine-custom e 'title-background)) (tfg (engine-custom e 'title-foreground)) (tfont (engine-custom e 'title-font))) - (printf "
\n" + (format #t "
\n" (html-width (slide-body-width e))) (if (string? tbg) - (printf "
" tbg) + (format #t "" tbg) (display "")) (if (string? tfg) - (printf "" tfg)) + (format #t "" tfg)) (if title (begin (display "
") (if (string? tfont) (begin - (printf "" tfont) + (format #t "" tfont) (output title e) (display "")) (begin - (printf "
") + (display "
") (output title e) (display ""))) (display "
\n"))) @@ -113,22 +147,43 @@ :options '(:title :outline? :class :ident) :action (lambda (n e) (let ((title (markup-option n :title)) - (body (markup-body n))) - (display "\n

") + (body (markup-body n)) + (class (markup-class n))) + ;; top-level class + (if class (format #t "\n
" class)) + + ;; the title + (if class + (format #t "\n
" class) + (display "\n

")) (if (markup-ident n) - (printf "" (markup-ident n))) + (format #t "" (markup-ident n))) (output title e) - (display "


\n") - (display "\n
") + (if class + (display "
\n") + (display "


\n")) + + ;; pointers to the slides + (if class + (format #t "\n
" + class) + (display "\n
")) (for-each (lambda (s) - (output (markup-option s :title) e) - (display " -- ")) + (let* ((title (markup-option s :title)) + (ident (markup-ident s)) + (sref (ref :text title :ident ident)) + (sref* (resolve! sref e `((parent ,n))))) + (output sref* e) + (display " -- "))) (filter (lambda (n) (or (is-markup? n 'slide-subtopic) (is-markup? n 'slide))) (markup-body n))) (display "\n
") - (display "\n

\n") + + (if class + (display "\n
\n") + (display "\n

\n")) ;; the slides (output (markup-body n) e)))) -- cgit v1.2.3