summaryrefslogtreecommitdiff
path: root/src/guile
diff options
context:
space:
mode:
Diffstat (limited to 'src/guile')
-rw-r--r--src/guile/skribilo/package/slide.scm10
-rw-r--r--src/guile/skribilo/package/slide/base.scm2
-rw-r--r--src/guile/skribilo/package/slide/html.scm123
3 files changed, 96 insertions, 39 deletions
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 "<a name=\"~a\">" (markup-ident n))
+ (format #t "<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)))
+ (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<div class=\"~a\">" class)
+ (format #t "\n<a name=\"~a\"></a>\n"
+ (markup-ident n))
+ (format #t "<div class=\"~a\">" title-class)
+ (format #t "~a / ~a -- " nb (slide-number))
+ (output t e)
+ (display "</div>\n")
+ (output (markup-body n) e)
+ (display "\n</div>\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 "<br>")
+
;; slide-vspace
(markup-writer 'slide-vspace he
:action (lambda (n e) (display "<br>")))))
@@ -76,23 +110,23 @@
(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>"
+ (format #t "<center><table cellspacing='0' cellpadding='0' width=\"~a\" class=\"skribilo-title\"><tbody>\n<tr>"
(html-width (slide-body-width e)))
(if (string? tbg)
- (printf "<td bgcolor=\"~a\">" tbg)
+ (format #t "<td bgcolor=\"~a\">" tbg)
(display "<td>"))
(if (string? tfg)
- (printf "<font color=\"~a\">" tfg))
+ (format #t "<font color=\"~a\">" tfg))
(if title
(begin
(display "<center>")
(if (string? tfont)
(begin
- (printf "<font ~a><strong>" tfont)
+ (format #t "<font ~a><strong>" tfont)
(output title e)
(display "</strong></font>"))
(begin
- (printf "<div class=\"skribetitle\"><strong><big><big><big>")
+ (display "<div class=\"skribilo-title\"><strong><big><big><big>")
(output title e)
(display "</big></big></big></strong</div>")))
(display "</center>\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<h2 class=\"slide-topic:title\">")
+ (body (markup-body n))
+ (class (markup-class n)))
+ ;; top-level class
+ (if class (format #t "\n<div class=\"~a\">" class))
+
+ ;; the title
+ (if class
+ (format #t "\n<div class=\"~a-title\">" class)
+ (display "\n<h2 class=\"slide-topic:title\">"))
(if (markup-ident n)
- (printf "<a name=\"~a\"></a>" (markup-ident n)))
+ (format #t "<a name=\"~a\"></a>" (markup-ident n)))
(output title e)
- (display "</h2> <br>\n")
- (display "\n<div class=\"slide-topic:slide-list\">")
+ (if class
+ (display "</div>\n")
+ (display "</h2> <br>\n"))
+
+ ;; pointers to the slides
+ (if class
+ (format #t "\n<div class=\"~a-slide-list\">"
+ class)
+ (display "\n<div class=\"slide-topic:slide-list\">"))
(for-each (lambda (s)
- (output (markup-option s :title) e)
- (display "&nbsp;--&nbsp;"))
+ (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 "&nbsp;--&nbsp;")))
(filter (lambda (n)
(or (is-markup? n 'slide-subtopic)
(is-markup? n 'slide)))
(markup-body n)))
(display "\n</div> <!-- slide-topic:slide-list -->")
- (display "\n<hr><br>\n")
+
+ (if class
+ (display "\n</div> <!-- slide-topic -->\n")
+ (display "\n<hr><br>\n"))
;; the slides
(output (markup-body n) e))))
generated by cgit v1.2.3 (git 2.45.2) at 2024-11-06 09:27:36 +0000