;;; xhtml-tree.scm

;; Copyright (C) 2007, 2008 Thien-Thi Nguyen
;;
;; This file is part of ttn-do, released under the terms of the
;; GNU General Public License as published by the Free Software
;; Foundation; either version 3, or (at your option) any later
;; version.  There is NO WARRANTY.  See file COPYING for details.

;;; Code:

(define-module (ttn-do zzz xhtml-tree)
  #:export (~?xml
            ~!DOCTYPE
            ~html
            ~head ~title ~base ~meta ~link ~style
            ~script ~noscript
            ~body
            ~div ~p ~h1 ~h2 ~h3 ~h4 ~h5 ~h6
            ~ul ~ol ~li ~dl ~dt ~dd
            ~address
            ~hr
            ~pre ~blockquote
            ~ins ~del
            ~a
            ~span
            ~bdo
            ~br
            ~em ~strong
            ~dfn ~code ~samp ~kbd ~var ~cite ~abbr ~acronym
            ~q ~sub ~sup
            ~tt ~i ~b ~big ~small
            ~object ~param
            ~img ~map ~area
            ~form ~label ~input ~select ~optgroup ~option
            ~textarea ~fieldset ~legend ~button
            ~table ~caption ~thead ~tfoot ~tbody ~colgroup ~col
            ~tr ~th ~td
            ~simple-strict-xhtml)
  #:use-module ((ttn-do zzz publishing) #:select (symbol<-kw/sym
                                                  (expand . <>)
                                                  :LF :NULL)))

;;; internal

(define (<>/empty elem)
  (<> elem #:xbsc #t #:end-tag :NULL))

;;; exported

;; Return the tree:
;; @lisp
;; ("<?xml version=\"1.0\" encoding=\""
;;  @var{encoding}
;;  "\"?>" :LF)
;; @end lisp
;;
(define (~?xml encoding)
  (list "<?xml version=\"1.0\" encoding=\""
        encoding
        "\"?>"
        :LF))

;; Return the tree:
;; @lisp
;; ("<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 "
;;  @var{type}-as-capitalized-string
;;  "//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-"
;;  @var{type}-as-string
;;  ".dtd\">" :LF)
;; @end lisp
;;
;; @var{type} is one of @code{#:strict}, @code{#:transitional},
;; @code{#:frameset}; or a symbol with the same name.
;;
(define ~!DOCTYPE
  (let* ((com-1 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 ")
         (com-2 "//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-")
         (com-3 ".dtd\">")
         (ok (map (lambda (sym)
                    (let ((str (symbol->string sym)))
                      (list sym
                            com-1 (string-capitalize str)
                            com-2 str com-3
                            :LF)))
                  '(strict
                    transitional
                    frameset))))
    (lambda (type)
      (or (assq-ref ok (symbol<-kw/sym type))
          (error "bad DOCTYPE type:" type)))))

(define ~html
  ;; <!ELEMENT html (head, body)>
  (<> "html" #:tail :LF))

(define ~head
  ;; <!ELEMENT head (%head.misc;,
  ;;   ((title, %head.misc;, (base, %head.misc;)?) |
  ;;    (base, %head.misc;, (title, %head.misc;))))>
  (<> "head" #:tail :LF))

(define ~title
  ;; <!ELEMENT title (#PCDATA)>
  (<> "title"))

(define ~base
  ;; <!ELEMENT base EMPTY>
  (<>/empty "base"))

(define ~meta
  ;; <!ELEMENT meta EMPTY>
  (<>/empty "meta"))

(define ~link
  ;; <!ELEMENT link EMPTY>
  (<>/empty "link"))

(define ~style
  ;; <!ELEMENT style (#PCDATA)>
  (<> "style"))

(define ~script
  ;; <!ELEMENT script (#PCDATA)>
  (<> "script"))

(define ~noscript
  ;; <!ELEMENT noscript %Block;>
  (<> "noscript"))

(define ~body
  ;; <!ELEMENT body %Block;>
  (<> "body"))

(define ~div
  ;; <!ELEMENT div %Flow;>
  (<> "div"))

(define ~p
  ;; <!ELEMENT p %Inline;>
  (<> "p"))

(define ~h1
  ;; <!ELEMENT h1  %Inline;>
  (<> "h1"))

(define ~h2
  ;; <!ELEMENT h2  %Inline;>
  (<> "h2"))

(define ~h3
  ;; <!ELEMENT h3  %Inline;>
  (<> "h3"))

(define ~h4
  ;; <!ELEMENT h4  %Inline;>
  (<> "h4"))

(define ~h5
  ;; <!ELEMENT h5  %Inline;>
  (<> "h5"))

(define ~h6
  ;; <!ELEMENT h6  %Inline;>
  (<> "h6"))

(define ~ul
  ;; <!ELEMENT ul (li)+>
  (<> "ul"))

(define ~ol
  ;; <!ELEMENT ol (li)+>
  (<> "ol"))

(define ~li
  ;; <!ELEMENT li %Flow;>
  (<> "li"))

(define ~dl
  ;; <!ELEMENT dl (dt|dd)+>
  (<> "dl"))

(define ~dt
  ;; <!ELEMENT dt %Inline;>
  (<> "dt"))

(define ~dd
  ;; <!ELEMENT dd %Flow;>
  (<> "dd"))

(define ~address
  ;; <!ELEMENT address %Inline;>
  (<> "address"))

(define ~hr
  ;; <!ELEMENT hr EMPTY>
  (<>/empty "hr"))

(define ~pre
  ;; <!ELEMENT pre %pre.content;>
  (<> "pre"))

(define ~blockquote
  ;; <!ELEMENT blockquote %Block;>
  (<> "blockquote"))

(define ~ins
  ;; <!ELEMENT ins %Flow;>
  (<> "ins"))

(define ~del
  ;; <!ELEMENT del %Flow;>
  (<> "del"))

(define ~a
  ;; <!ELEMENT a %a.content;>
  (<> "a"))

(define ~span
  ;; <!ELEMENT span %Inline;>
  (<> "span"))

(define ~bdo
  ;; <!ELEMENT bdo %Inline;>
  (<> "bdo"))

(define ~br
  ;; <!ELEMENT br EMPTY>
  (<>/empty "br"))

(define ~em
  ;; <!ELEMENT em %Inline;>
  (<> "em"))

(define ~strong
  ;; <!ELEMENT strong %Inline;>
  (<> "strong"))

(define ~dfn
  ;; <!ELEMENT dfn %Inline;>
  (<> "dfn"))

(define ~code
  ;; <!ELEMENT code %Inline;>
  (<> "code"))

(define ~samp
  ;; <!ELEMENT samp %Inline;>
  (<> "samp"))

(define ~kbd
  ;; <!ELEMENT kbd %Inline;>
  (<> "kbd"))

(define ~var
  ;; <!ELEMENT var %Inline;>
  (<> "var"))

(define ~cite
  ;; <!ELEMENT cite %Inline;>
  (<> "cite"))

(define ~abbr
  ;; <!ELEMENT abbr %Inline;>
  (<> "abbr"))

(define ~acronym
  ;; <!ELEMENT acronym %Inline;>
  (<> "acronym"))

(define ~q
  ;; <!ELEMENT q %Inline;>
  (<> "q"))

(define ~sub
  ;; <!ELEMENT sub %Inline;>
  (<> "sub"))

(define ~sup
  ;; <!ELEMENT sup %Inline;>
  (<> "sup"))

(define ~tt
  ;; <!ELEMENT tt %Inline;>
  (<> "tt"))

(define ~i
  ;; <!ELEMENT i %Inline;>
  (<> "i"))

(define ~b
  ;; <!ELEMENT b %Inline;>
  (<> "b"))

(define ~big
  ;; <!ELEMENT big %Inline;>
  (<> "big"))

(define ~small
  ;; <!ELEMENT small %Inline;>
  (<> "small"))

(define ~object
  ;; <!ELEMENT object (#PCDATA | param | %block; | form | %inline; | %misc;)*>
  (<> "object"))

(define ~param
  ;; <!ELEMENT param EMPTY>
  (<> "param"))

(define ~img
  ;; <!ELEMENT img EMPTY>
  (<> "img"))

(define ~map
  ;; <!ELEMENT map ((%block; | form | %misc;)+ | area+)>
  (<> "map"))

(define ~area
  ;; <!ELEMENT area EMPTY>
  (<> "area"))

(define ~form
  ;; <!ELEMENT form %form.content;>
  (<> "form"))

(define ~label
  ;; <!ELEMENT label %Inline;>
  (<> "label"))

(define ~input
  ;; <!ELEMENT input EMPTY>
  (<>/empty "input"))

(define ~select
  ;; <!ELEMENT select (optgroup|option)+>
  (<> "select"))

(define ~optgroup
  ;; <!ELEMENT optgroup (option)+>
  (<> "optgroup"))

(define ~option
  ;; <!ELEMENT option (#PCDATA)>
  (<> "option"))

(define ~textarea
  ;; <!ELEMENT textarea (#PCDATA)>
  (<> "textarea"))

(define ~fieldset
  ;; <!ELEMENT fieldset (#PCDATA | legend | %block; | form | %inline; | %misc;)*>
  (<> "fieldset"))

(define ~legend
  ;; <!ELEMENT legend %Inline;>
  (<> "legend"))

(define ~button
  ;; <!ELEMENT button %button.content;>
  (<> "button"))

(define ~table
  ;; <!ELEMENT table
  ;;   (caption?, (col*|colgroup*), thead?, tfoot?, (tbody+|tr+))>
  (<> "table"))

(define ~caption
  ;; <!ELEMENT caption  %Inline;>
  (<> "caption"))

(define ~thead
  ;; <!ELEMENT thead    (tr)+>
  (<> "thead"))

(define ~tfoot
  ;; <!ELEMENT tfoot    (tr)+>
  (<> "tfoot"))

(define ~tbody
  ;; <!ELEMENT tbody    (tr)+>
  (<> "tbody"))

(define ~colgroup
  ;; <!ELEMENT colgroup (col)*>
  (<> "colgroup"))

(define ~col
  ;; <!ELEMENT col      EMPTY>
  (<> "col"))

(define ~tr
  ;; <!ELEMENT tr       (th|td)+>
  (<> "tr"))

(define ~th
  ;; <!ELEMENT th       %Flow;>
  (<> "th"))

(define ~td
  ;; <!ELEMENT td       %Flow;>
  (<> "td"))

;;; notes:

;; prohibitions:
;; a
;;     must not contain other a elements.
;; pre
;;     must not contain the img, object, big, small, sub, or sup elements.
;; button
;;     must not contain the input, select, textarea, label, button, form,
;;     fieldset, iframe or isindex elements.
;; label
;;     must not contain other label elements.
;; form
;;     must not contain other form elements.

;; Basically:
;; @example
;; (list (~?xml "utf-8")
;;       (~!DOCTYPE #:strict)
;;       (~html 'xmlns "http://www.w3.org/1999/xhtml"
;;              'xml:lang "en"
;;              'lang "en"
;;              x))
;; @end example
;;
(define (~simple-strict-xhtml . x)
  (list (~?xml "utf-8")
        (~!DOCTYPE #:strict)
        (~html 'xmlns "http://www.w3.org/1999/xhtml"
               'xml:lang "en"
               'lang "en"
               x)))

;;; xhtml-tree.scm ends here