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


        (def-class
         (this (special:upload context))
         (supers (page-base))
         (private
          (define _template (template 'context context 'name "admin"))
          )
         (public
          (define (get-template)  _template)
          (define (css)           (-> _template css))
          (define (title)         (_ "HWiki Upload"))

          (define (create-html . uploaded-as)
            (if (not (-> context role-editor?))
                (-> supers not-autorized context 
                    `(p ,(_ "You must login as 'editor' to upload images and files")))
                (let ((P (page context (-> context from-where))))
                  (debug "create-html:P:" (-> P name))
                  (let ((T (-> P get-template)))
                    (let ((form (lambda (url)
                                  (adjust-timeout! (form-timeout))
                                  (-> context add-extra-header `(script ((language "javascript") (type "text/javascript"))
                                                                        "function updateName() { var s1=String(document.upload.upload1.value.match(/[^/\\\\]+$/));document.upload.rename1.value=s1.replace(/\\s/g,'_'); }")
                                      )
                                  (-> context make-response/xhtml
                                      `(html
                                        ,(-> supers create-header context)
                                        (body ((onLoad "focusOnLoad('a1')"))
                                         (div ((class "upload"))
                                              (h1 ,(_ "Upload file"))
                                              ,(if (not (null? uploaded-as)) `(p "file uploaded as :" (code ,(car uploaded-as))) (make-comment "nothing uploaded"))
                                              (form ((enctype "multipart/form-data") (name "upload") (action ,url) (method "post"))
                                                    (table
                                                     (tr (td ,(_ "File: "))  (td ((colspan "2")) (input ((id "a1") (type "file") (name "upload1") (onkeypress "return enterSubmit(event,'s1');") (size "75") (maxlength ,MAX-UPLOAD-SIZE) (onchange "updateName()")))))
                                                     (tr (td ,(_ "Rename to:")) (td ((colspan "2")) (input ((type "text") (name "rename1") (onkeypress "return enterSubmit(event,'s1');") ))))
                                                     (tr (td)
                                                         (td ((class "tdbutton")) (input ((type "submit") (name "submit") (value ,(_ "done")))))
                                                         (td ((class "tdbutton")) (input ((id "s1") (type "submit") (name "submit") (value ,(_ "upload"))))))))
                                              )))))))
                      (let ((bindings (request-bindings (send/suspend form))))
                        (let ((done (extract-binding/single 'submit bindings))
                              (file (extract-binding/single 'upload1 bindings))
                              (rename (extract-binding/single 'rename1 bindings)))
                          (if (string-ci=? done (_ "upload"))
                              (begin
                                (if (bytes=? file #"")
                                    (create-html (_ "Empty file to upload, cannot upload this"))
                                    (if (string=? rename "")
                                        (create-html (_ "Empty rename, cannot upload file"))
                                        (begin
                                          (-> context store-file file rename)
                                          (create-html rename)))))
                              (-> context to-from-where))
                          )))))
                ))

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


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

        )