html.scm
;;; html.scm  --  Jens Axel S√łgaard

;; TODO:
;    html-icon
;      - return sensible default, when icon not found
;      - add #size

(module html mzscheme
  (provide (all-defined))
  
  (require (lib "kw.ss")
           "default.scm")
  
  (define-default current-page-title         "A title" )
  (define-default current-page-header        '(h1 "A Header"))
  (define-default current-page-body          "A body")
  (define-default current-page-content-type  "text/html;charset=UTF-8")
  (define-default current-page-style-sheet   "")
  
  ; html-page
  ;   Puts all the pieces together to make a complete html page.
  ;   Defaults are taken from site-wide parameters
  (define/kw 
    (html-page #:key 
               (title         (current-page-title))
               (title-atts    #f)
               (header        (current-page-header))
               (head-atts     #f)
               (body          (current-page-body))
               (body-atts     #f)
               (style-sheet   (current-page-style-sheet))
               (inline-style-sheet   #f)
               (content-type  (current-page-content-type)))
    (let ([title-atts (if title-atts (list title-atts) '())]
          [head-atts  (if head-atts  (list head-atts)  '())]
          [body-atts  (if body-atts  (list body-atts)  '())])
      `(html (head  (title ,@title-atts ,title)
                    ; external stylesheet
                    (link ((rel "stylesheet") 
                           (type "text/css")
                           (href ,style-sheet)))
                    (meta ((http-equiv "Content-Type")
                           (content ,content-type)))
                    ,@head-atts
                    ,@(if inline-style-sheet
                          (list `(style ,inline-style-sheet))
                          (list))
                    )
             (body ,@body-atts
                   ,header
                   ,body))))
  
  ; html-a-submit
  ;   Makes a "submitting text link". Since links normally can't submit
  ;   the values of a form, a little JavaScript is needed.
  ;   To support several text links in a form, each links has an "id",
  ;   which is stored in the "formitem" field of the enclosing form.
  (define (html-a-submit formname formitem id text)
    `(a ((href ,(string-append 
                 (format "javascript:document.~a.~a.value='~a';" formname formitem id)
                 (format "document.~a.submit();" formname))))
        ,text))
  
  ; html-form
  ;  Makes an html form. Name and action are required.
  (define/kw (html-form name action #:key (method "post") (atts '()) #:body body)
    `(form ((name ,name) (action ,action) (method ,method) ,@atts)
           ,@body))
  
  ; html-input
  ;   TODO: This is a bit ad hoc for now
  (define/kw (html-input name #:key (type 'submit) (value "none") (src ""))
    (let* ([atts '()])
      (set! atts (cons `(name  ,name)  atts))
      (set! atts (cons `(value ,value) atts))
      (case type
        [(image)  `(input ((type "image") (src ,src) ,@atts))]
        [(text)   `(input ((type "text")   ,@atts))]
        [(submit) `(input ((type "submit") ,@atts))]
        [(hidden) `(input ((type "hidden") ,@atts))])))
  
  ; html-div
  (define/kw (html-div #:key (class #f) #:body body)
    (if class
        `(div ((class ,class)) ,@body)
        `(div ,@body)))
  
  (define/kw (html-ul #:key (class #f) #:body body)
    (if class
        `(ul ((class ,class)) ,@body)
        `(ul ,@body)))
  
  (define/kw (html-li #:key (class #f) #:body body)
    (if class
        `(li ((class ,class)) ,@body)
        `(li ,@body)))
  
  (define/kw (html-a url text)
    `(a ((href ,url)) ,text))
  
  (define (html-p . forms) `(p ,@forms))
  (define (html-p*  forms) `(p ,@forms))
  
  (define (html-h1 . forms) `(h1 ,@forms))
  (define (html-h1*  forms) `(h1 ,@forms))
  
  (define (html-table . forms) `(table ,@forms))
  
  (define/kw (html-table* #:key (class #f) #:body forms)
    (let ([forms (car forms)])
      (if class
          `(table ((class ,class)) ,@forms)
          `(table ,@forms))))
  
  (define (html-tr . forms) `(tr ,@forms))
  (define (html-tr*  forms) `(tr ,@forms))
  
  (define/kw (html-td #:key (class #f) #:body  forms) 
    (if class
        `(td ((class ,class)) ,@forms)
        `(td ,@forms)))
        
  (define (html-td*  forms) `(td ,@forms))
  
  (define (html-br) '(br))
  
  
  )