;;; html4.scm -- HTML 4.01 engine.
;;; -*- coding: iso-8859-1 -*-
;;;
;;; Copyright 2004 Erick Gallesio - I3S-CNRS/ESSI
;;; Copyright 2007 Ludovic Courtès
;;;
;;;
;;; This file is part of Skribilo.
;;;
;;; Skribilo 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 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Skribilo 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 Skribilo. If not, see .
(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:)))
(skribilo-module-syntax)
(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 "