(module html mzscheme
  (provide (all-defined))
  
  (require (lib "servlets/private/search-util.ss" "help")
           (lib "servlet.ss" "web-server")
           (lib "etc.ss")
           (lib "kw.ss")
           (lib "port.ss")
           "url.ss")

  ;;;
  ;;; STYLESHEET
  ;;;
  
  ; css : -> string
  ;   fetch stylesheet from disk
  ;   (convenient during development)
  (define (css)
    (define (port->string port)
      (let ([os (open-output-string)])
        (copy-port port os)
        (get-output-string os)))  
    (call-with-input-file 
        (build-path (this-expression-source-directory)
                    "helpdesk.css")
      port->string))
  
  ;;;
  ;;; GENERATE XML FOR THE ENTIRE PAGE
  ;;;

  ; html-page : xexpr (list xml) (list xml) -> xexpr
  (define/kw (html-page #:key title (top '()) (bodies '()) body)
    (let ([bodies (if body (append bodies (list body)) bodies)])
      `(html
        (meta ((http-equiv "Content-Type") (content "text/html;charset=UTF-8")))
        (meta ((name "generator") (content "PLT Scheme")))
        ; TODO: Ask Eli what exactly to put here in the online version
        ;(script ((src "http://www.google-analytics.com/urchin.js") (type "text/javascript")))
        ;(script ((type "text/javascript")) "_uacct=\"UA-808258-1\";_udn=\"plt-scheme.org\";urchinTracker();")
        (head (title ,title)
              (style ((type "text/css")) "\n"
                     ,(css))
              ; TODO: Check the icons work in online version
              (link ([rel "icon"] [href "/help/servlets/plticon.ico"] [type "image/ico"]))
              (link ([rel "shortcut icon"] [href "/help/servlets/plticon.ico"])))
        (body 
         ,@top 
         ,@bodies))))
    
  ; html-select : string (list string) natural -> xexpr
  (define (html-select name descriptions selected-index)
    `(select ((name ,name))
             ,@(let loop ([i 0] [ds descriptions] [xexprs '()])
                 (cond
                   [(null? ds)           (reverse! xexprs)]
                   [(= i selected-index) (loop (+ i 1) (cdr ds)
                                               (cons (car ds)
                                                     (cons `(option ((selected "selected")))
                                                           xexprs)))]
                   [else                 (loop (+ i 1) (cdr ds)
                                               (cons (car ds)
                                                     (cons `(option)
                                                           xexprs)))]))))
  
  ;;;
  ;;; THE TOP SEARCH BAR
  ;;; (online version online)
  
  ; html-top : requrest -> (list xml)
  (define (html-top request)
    (let* ([bindings      (request-bindings request)]
           [search-string (get-binding bindings 'search-string "")]
           [search-type   (get-binding bindings 'search-type search-type-default)]
           [match-type    (get-binding bindings 'match-type  match-type-default)])
      `((div ((style "border: 1px solid black; padding: 3px; background-color: #74ca56; "))
             (table ((width "98%"))
                    (tr (td ((align "right")) 
                            (img ((class "image") 
                                  (src "http://www.plt-scheme.org/plt-green.jpg")
                                  (width "133") (height "128") (alt "[icon]"))))
                        (td ((align "center"))
                            (form ((method "GET") (action ,url-helpdesk-results))
                                  (table (tr (td ((align "center") (class "sansa")) 
                                                 "Search the Help Desk for documentation on: " ))
                                         (tr (td (input ((name "search-string") (type "text") (size "70") 
                                                                                (value ,search-string))))
                                             (td 'nbsp 'nbsp (button "Search")))
                                         (tr (td ((align "center"))
                                                 ,(html-select "search-type"
                                                               search-type-descriptions
                                                               (search-type->index search-type))
                                                 'nbsp 'nbsp 'nbsp 'nbsp 
                                                 ,(html-select "match-type"
                                                               match-type-descriptions
                                                               (match-type->index match-type)))))))
                        (td 'nbsp) (td 'nbsp) (td 'nbsp)
                        (td (table (tr (td ((align "center")) 
                                           (a ((href ,url-helpdesk-home) (class "sansa")) "HOME")))
                                   (tr (td ((align "center")) 
                                           (a ((href ,url-helpdesk-manuals) (class "sansa")) "MANUALS")))))
                        )))
        (p " "))))
  
  
  ;;;
  ;;; BINDINGS
  ;;;
  
  (define (get-binding bindings name default-value)
    (if (exists-binding? name bindings)
        (extract-binding/single name bindings)
        default-value))
  
  (define (delete-binding id bindings)
    (cond
      [(null? bindings) 
       '()]
      [(equal? (binding-id (car bindings)) id)
       (cdr bindings)]
      [else
       (cons (car bindings)
             (delete-binding id (cdr bindings)))]))
  
  (define (delete-bindings ids bindings)
    (cond [(null? ids) bindings]
          [else        (delete-bindings (cdr ids)
                                        (delete-binding (car ids)
                                                        bindings))]))
  
  (define (display-binding binding)
    ; for debugging
    (display "binding: ")
    (display (binding-id binding))
    (display "=")
    (write (binding:form-value binding))
    (newline))
  
  ;;;
  ;;; SEARCH DESCRIPTIONS AND SHORT NAMES
  ;;;
  
  (define (search-type-description i)
    (cadr (list-ref search-types i)))
  
  (define (match-type-description i)
    (cadr (list-ref match-types i)))
  
  (define reversed-search-types
    (map reverse search-types))
  
  (define reversed-match-types
    (map reverse match-types))
  
  (define (search-type-description->search-type desc)
    (cond [(assoc desc reversed-search-types) => cadr]
          [else search-type-default]))
  
  (define (match-type-description->match-type desc)
    (cond [(assoc desc reversed-match-types) => cadr]
          [else match-type-default]))
  
  (define search-type->index
    (let* ([types (map car search-types)]
           [len   (length types)])
      (lambda (t)
        (cond
          [(member t types)
           => (lambda (tail) (- len (length tail)))]
          [else -1]))))
  
  (define match-type->index
    (let* ([types (map car match-types)]
           [len   (length types)])
      (lambda (t)
        (cond
          [(member t types)
           => (lambda (tail) (- len (length tail)))]
          [else -1]))))
  
  (define search-type-descriptions
    (map cadr search-types))
  
  (define match-type-descriptions
    (map cadr match-types))
  
  )