(module special-template mzscheme
        (require "hwikireq.scm")
        (require "page.scm")
        (require "config.scm")
        (require "context.scm")
        (require "users.scm")
        (require "template.scm")


        (def-class
         (this (special:template context))
         (supers (page-base))
         (private
          (define _template (template 'context context 'name "admin"))
          (define _users    (users context))
          (define _title    (_ "HWiki Templates"))
          )
         (public
          (define (get-template) _template)
          (define (css)          (-> _template css))
          (define (title)        _title)
          (define (title! t)     (set! _title t))

          (define (create-new-template name)
            (debug "create new template" name)
            (if (not (good-name? name))
                (-> this do-error
                    (_ "A template must be given a valid name (please provide a valid name)")
                    create-html)
                (begin
                  (let ((T (template 'context context 'name name)))
                    (-> T store))
                  (edit-template name))))

          (define (edit-template template-name)
            (let ((T (template 'context context 'name template-name)))
              (let ((form (lambda (url)
                            (adjust-timeout! (form-timeout))
                            (title! (_ "HWiki Templates - Edit Template"))
                            (-> context make-response/xhtml
                             `(html
                               ,(-> supers create-header context)
                               (body
                                (div ((class "templates"))
                                     (h1 ,(_ "HWiki templates - edit '~a'" template-name))
                                     (form ((action ,url) (method "post"))
                                           (table ((class "css"))
                                                  (tr (td ,(_ "CSS:")) (td (input ((type "text") (name "cssname") (value ,(-> T css-name)))))
                                                      (td ((class "tdbutton")) (input ((type "submit") (class "button") (name "css") (value ,(_ "edit")))))
                                                      (td ((class "tdbutton")) (input ((type "submit") (class "button") (name "css") (value ,(_ "change")))))))
                                           ,(append `(table ((class "parts")))
                                                    (map (lambda (part)
                                                           `(tr (td (input ((type "text") (name ,(string-append "name" (car part))) (value ,(car part)))))
                                                                (td (input ((type "text") (name ,(string-append "file" (car part))) (value ,(if (eq? (cadr part) #f)
                                                                                                                                                ""
                                                                                                                                                (cadr part))))))
                                                                (td ((class "tdbutton")) (input ((type "submit") (class "button") (name ,(car part)) (value ,(_ "change")))))
                                                                (td ((class "tdbutton")) (input ((type "submit") (class "button") (name ,(car part)) (value ,(_ "remove")))))))
                                                         (-> T parts))
                                                    `((tr (td (input ((type "text") (name "%namenew%") (value ""))))
                                                          (td (input ((type "text") (name "%filenew%") (value ""))))
                                                          (td ((class "tdbutton")) (input ((type "submit") (class "button") (name "%add%") (value ,(_ "add")))))
                                                          (td ((class "tdbutton")) )))
                                                    `((tr ((class "done")) (td) (td) (td) (td ((class "tdbutton")) (input ((type "submit") (class "button") (name "%done%") (value ,(_ "done"))))))))))))))))
                (let ((bindings (request-bindings (send/suspend form))))
                  (let ((css (extract-binding/choice '(css) bindings (cons "" "")))
                        (action (extract-binding/choice (map car (-> T parts)) bindings (cons "" "")))
                        (add (extract-binding/choice '(%add%) bindings (cons "" "")))
                        (done (extract-binding/choice '(%done%) bindings (cons "" ""))))
                    (debug "action:" action)
                    (cond ((string-ci=? (cdr css) (_ "edit")) (edit-css T))
                          ((string-ci=? (cdr css) (_ "change")) (change-css-name T (extract-binding/single 'cssname bindings)))
                          ((string-ci=? (cdr action) (_ "change")) (set-part T
                                                                             (car action)
                                                                             (extract-binding/single (string->symbol (format "name~a" (car action))) bindings)
                                                                             (extract-binding/single (string->symbol (format "file~a" (car action))) bindings)))
                          ((string-ci=? (cdr action) (_ "remove")) (remove-part T (car action)))
                          ((string-ci=? (cdr add) (_ "add")) (set-part T
                                                                       (car action)
                                                                       (extract-binding/single '%namenew% bindings)
                                                                       (extract-binding/single '%filenew% bindings)))
                          (else (create-html))))))))

          (define (set-part template part new-part new-file)
            (if (not (good-name? new-part))
                (-> this do-error (_ "Not a good part name: '~a'" new-part) (lambda () (edit-template (-> template name))))
                (if (and (not (good-name? new-file)) (not (string-ci=? (normalize new-file) "")))
                    (-> this do-error (_ "Not a good template name '~a' for part '~a'" new-file new-part) (lambda () (edit-template (-> template name))))
                    (begin
                      (-> template set-part! part new-part new-file)
                      (edit-template (-> template name))))))

          (define (remove-part template part)
            (-> template remove-part! part)
            (edit-template (-> template name)))

          (define (change-css-name template name)
            (if (not (good-name? name))
                (-> this do-error (_ "Not a good name for a css file: '~a'" name) (lambda () (edit-template (-> template name))))
                (begin
                  (-> template css! (normalize name))
                  (edit-template (-> template name)))))

          (define (edit-css template)
            (let ((form (lambda (url)
                          (adjust-timeout! (edit-timeout))
                          (title! (_ "HWiki Templates - Edit CSS"))
                          (-> context make-response/xhtml
                           `(html
                             ,(-> supers create-header context)
                             (body
                              (div ((class "editcss"))
                                   (h1 ,(_ "HWiki templates - edit CSS '~a'" (-> template css-name)))
                                   (form ((action ,url) (method "post") (name "cssedit"))
                                         (textarea ((name "cssedit"))
                                                   ,(-> template css-contents))
                                         (p)
                                         (input ((type "submit") (class "button") (name "submit") (value ,(_ "cancel"))))
                                         (input ((type "submit") (class "button") (name "submit") (value ,(_ "commit"))))))))))))
              (let ((bindings (request-bindings (send/suspend form))))
                (let ((submit (extract-binding/single 'submit bindings)))
                  (if (string-ci=? submit (_ "commit"))
                      (-> template css-contents! (extract-binding/single 'cssedit bindings)))
                  (edit-template (-> template name))))))


          (define (remove-template template-name)
            (let ((T (template 'context context 'name template-name)))
              (-> T remove)
              (create-html)))

          (define (create-html)
            (let ((form (lambda (url)
                          (adjust-timeout! (form-timeout))
                          (title! (_ "HWiki Templates"))
                          (let* ((P (page context (-> context from-where)))
                                 (T (-> P get-template)))
                            (-> context make-response/xhtml
                             `(html
                               ,(-> supers create-header context)
                               (body
                                (div ((class "templates"))
                                     (h1 ,(_ "HWiki templates"))
                                     (div ((class "info"))
                                          (table ((class "current-template"))(tr (td ,(_ "Current template :")) (td ,(-> T name)))))
                                     (form ((action ,url) (method "post"))
                                           (div ((class "choose"))
                                                ,(append `(table ((class "choose-template")))
                                                         `((tr (th ,(_ "Name")) (th) (th)))
                                                         `((tr (td (input ((type "text") (name "%newtemplate%"))))
                                                               (td (input ((type "submit") (class "button") (name "%new%") (value "new"))))
                                                               (td)))
                                                         (map (lambda (template-name)
                                                                (debug "template-name:" template-name)
                                                                `(tr (td ,template-name)
                                                                     (td ((class "tdbutton")) (input ((type "submit") (class "button") (name ,template-name) (value "edit"))))
                                                                     (td ((class "tdbutton")) (input ((type "submit") (class "button") (name ,template-name) (value "remove"))))))
                                                              (sort (-> T template-names) string-ci<?))
                                                         `((tr ((class "done")) (td " ") (td " ") (td (input ((type "submit") (class "button") (name "submit") (value ,(_ "done"))))))))))))))))))
              (let ((bindings (request-bindings (send/suspend form))))
                (let ((submit (extract-binding/choice '(submit) bindings (cons "" "")))
                      (action (extract-binding/choice (cons "%new%" (-> _template template-names)) bindings (cons "" ""))))
                  (if (string-ci=? (cdr submit) (_ "done"))
                      (begin
                        (-> context to-from-where))
                      (if (string-ci=? (cdr action) "new")
                          (create-new-template (extract-binding/single '%newtemplate% bindings))
                          (if (string-ci=? (cdr action) "edit")
                              (edit-template (car action))
                              (if (string-ci=? (cdr action) "remove")
                                  (remove-template (car action))
                                  (-> this do-error (_ "Unknown error") 
                                      (lambda () (let ((P (page context (-> context from-where))))
                                                   (-> P create-html))))))))))))


          )
         (constructor
          (-> supers special!)
          )
         )


        (register-page "special:template" special:template)


        )