;;; html4.scm -- HTML 4.01 engine.
;;;
;;; Copyright 2004 Erick Gallesio - I3S-CNRS/ESSI
;;; Copyright 2007 Ludovic Courtès
;;;
;;;
;;; 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;; USA.
(define-module (skribilo engine html4)
:use-module (skribilo ast)
:use-module (skribilo config)
:use-module (skribilo engine)
:use-module (skribilo writer)
:use-module (skribilo utils syntax)
:use-module (skribilo package base)
:use-module (skribilo engine html)
:autoload (skribilo evaluator) (evaluate-document)
:autoload (skribilo output) (output)
:autoload (skribilo lib) (skribe-error)
:use-module (srfi srfi-1)
:use-module ((srfi srfi-19) :renamer (symbol-prefix-proc 's19:)))
(fluid-set! current-reader %skribilo-module-reader)
(define (find-children node)
(define (flat l)
(cond
((null? l) l)
((pair? l) (append (flat (car l))
(flat (cdr l))))
(else (list l))))
(if (markup? node)
(flat (markup-body node))
node))
;;; ======================================================================
(let ((le (find-engine 'html)))
;;----------------------------------------------------------------------
;; Customizations
;;----------------------------------------------------------------------
(engine-custom-set! le 'html-variant "html4")
(engine-custom-set! le 'html4-logo "http://www.w3.org/Icons/valid-html401")
(engine-custom-set! le 'html4-validator "http://validator.w3.org/check/referer")
;;----------------------------------------------------------------------
;; &html-html ...
;;----------------------------------------------------------------------
(markup-writer '&html-html le
:before "
\n"
:after "")
;;----------------------------------------------------------------------
;; &html-ending
;;----------------------------------------------------------------------
(let* ((img (engine-custom le 'html4-logo))
(url (engine-custom le 'html4-validator))
(bottom (list (hrule)
(table :width 100.
(tr
(td :align 'left
(font :size -1
"This HTML page was produced by "
(ref :url (skribilo-url)
:text "Skribilo") ". "
(linebreak)
"Last update: "
(s19:date->string
(s19:current-date))))
(td :align 'right :valign 'top
(ref :url url
:text (image :url img :width 88
:height 31))))))))
(markup-writer '&html-ending le
:before "
"
:action (lambda (n e)
(let ((body (markup-body n)))
(if body
(output body #t)
(evaluate-document bottom e))))
:after "
\n"))
;;----------------------------------------------------------------------
;; color ...
;;----------------------------------------------------------------------
(markup-writer 'color le
:options '(:bg :fg :width :margin)
:before (lambda (n e)
(let ((m (markup-option n :margin))
(w (markup-option n :width))
(bg (markup-option n :bg))
(fg (markup-option n :fg)))
(when bg
(display "