(module special-edit mzscheme
        (require "hwikireq.scm")
        (require "page.scm")
        (require "config.scm")
        (require "context.scm")
        (require "users.scm")
        (require "template.scm")
        (require "plugins.scm")
        (provide special:edit)
        
        (define DB-CREATED #f)
        
        (define ON-GOING-EDITS  (make-hash-table 'equal))
        
        (define (create-db)
          (if (not DB-CREATED)
              (let* ((sqli  (sqli-provider)))
                (if (not (eq? sqli #f))
                    (begin
                      (hlog (format "sqli: after connect to database: ~a" (sqli-error-message sqli)))
                      (sqli-query sqli "create table register(context varchar,account varchar, page varchar,title varchar,part varchar, file varchar,time timestamp)")
                      (sqli-query sqli "create index reg_idx_1 on register(context,page,time)")
                      (sqli-query sqli "create index reg_idx_2 on register(context,account,time)")
                      (sqli-query sqli "create index reg_idx_3 on register(context,page,part,time)")
                      (sqli-query sqli "create index reg_idx_4 on register(context,page,part,file,time)")
                      (sqli-disconnect sqli)
                      ))))
          (set! DB-CREATED #t))

        
        (def-class
         (this (special:edit context))
         (supers (page-base))
         (private
          (define _template (template 'context context 'name "admin"))

          (define (editor part)
            (part-editor part))

          (define (register-edit page part)
            (create-db)
            (let* ((sqli  (sqli-provider)))
              (hlog (format "sqli: after connect to: ~a" (sqli-error-message sqli)))
              (sqli-query sqli "insert into register(context,account,page,title,part,file,time) values($1,$2,$3,$4,$5,$6,$7)"
                          (-> context context)
                          (-> context user) 
                          (-> page name) (-> page title) (part-name part) (-> page get-part-file part) 
                          (current-date))))
          
          (define (set-edit!)
            (hash-table-put! ON-GOING-EDITS 
                             (string-append 
                              (-> context context) "." (-> context from-where))
                             (list (-> context user) (current-date) (-> context session-id) )))
          
          (define (get-edit)
            (hash-table-get ON-GOING-EDITS
                            (string-append
                             (-> context context) "." (-> context from-where))
                            (lambda () #f)))
          
          (define (clear-edit!)
            (hash-table-remove! ON-GOING-EDITS
                                (string-append 
                                 (-> context context) "." (-> context from-where))))
          
          (define (my-edit?)
            (let ((e (get-edit)))
              (if (string=? (caddr e) (-> context session-id))
                  #t
                  #f)))
          
          )
         (public
          (define (get-template) _template)
          (define (css)          (-> _template css))
          (define (title)        (_ "HWiki Page Edit"))
          
          (define (edit-page-part P T part)
            (debug "page:" (-> P name))
            (let ((form (lambda (url)
                          (adjust-timeout! (edit-timeout))
                          (let ((form-name "editarea")
                                (action-name "editsave")
                                (CSS       (-> T css))
                                (css-classes (apply string-append
                                                    (map (lambda (C)
                                                           (format "~a=~a;" C C))
                                                         (-> T css-classes))))
                                (contents (-> P contents part 'no-languages)))
                            (-> context make-response/xhtml
                             `(html
                               ,(-> supers create-header context)
                               (body
                                (form ((enctype "multipart/form-data") (action ,url) (method "post") (name ,form-name))
                                      ,(if (eq? (editor part) 'html)
                                           `(input ((type "hidden") (name "editsave") (value "cancel")))
                                           (make-comment "editsave not a hidden thing here")
                                           )
                                      (textarea ((class "editarea") (name "text") ) ,(if (eq? contents #f) "<p></p>" contents) )
                                      ,(if (eq? (editor part) 'html)
                                           `(script ((language "javascript") (type "text/javascript") (src "/tinymce/jscripts/tiny_mce/tiny_mce.js")) "")
                                           `(input ((type "submit") (name ,action-name) (value "cancel")))
                                           )
                                      ,(if (eq? (editor part) 'html)
                                           `(script ((language "javascript") (type "text/javascript"))
                                                    ,(string-append "function tinymce_save() { document." form-name "." action-name ".value=\"commit\";document." form-name ".submit(); }"
                                                                    "function tinymce_cancel() { document." form-name "." action-name ".value=\"cancel\";document." form-name ".submit(); }"
                                                                    "function setEditorCSS() { tinyMCE.getInstanceById('mce_editor_0').getWin().document.body.className='" (-> context mkdiv (part-name part)) "'; }"
                                                                    "tinyMCE.init({ theme : \"advanced\", "
                                                                    "mode : \"textareas\", "
                                                                    "plugins : \"print,save,table,cancel,media,wikilink\", " ;,fullscreen
                                                                    "save_enablewhendirty : true, "
                                                                    "save_onsavecallback : \"tinymce_save\", "
                                                                    "cancel_oncancelcallback : \"tinymce_cancel\", "
                                                                    "theme_advanced_toolbar_location : \"top\", "
                                                                    "theme_advanced_toolbar_align    : \"left\", "
                                                                    "theme_advanced_buttons2 : \"separator,formatselect,fontselect,fontsizeselect,removeformat,separator,bold,italic,underline,istriketrhough,sub,sup,separator,justifyleft,justifycenter,justifyright,justifyfull,separator,bullist,numlist,indent,outdent\", "
                                                                    "theme_advanced_buttons1 : \"separator,save,cancel,separator,print,fullscreen,separator,cut,copy,paste,separator,undo,redo,separator,wikilink,link,unlink,anchor,image,media,hr,separator,code,separator,tablecontrols\", "
                                                                    "theme_advanced_buttons3 : \"\", "
                                                                    "theme_advanced_statusbar_location : \"bottom\", "
                                                                    "fullscreen_new_window : false, "
                                                                    "fullscreen_settings : { theme_advanced_path_location : \"top\" }, "
                                                                    "inline_styles : true, "
                                                                    "oninit : \"setEditorCSS\", "
                                                                    "apply_source_formatting : true, "
                                                                    "relative_urls : true, "
                                                                    "extended_valid_elements : \"script[charset|defer|language|src|type]\", "
                                                                    "content_css : \"" CSS "\" "
                                                                    "});"))
                                           `(input ((type "submit") (name ,action-name) (value "save")))
                                           )
                                      )
                                )))))))
              (let ((bindings (request-bindings (send/suspend form))))
                (let ((action (extract-binding/single 'editsave bindings)))
                  (if (string-ci=? action "cancel")
                      (create-html)
                      (if (not (my-edit?))
                          (-> supers message context
                              (_ "HWiki Edit - Overriden")
                              (_ "This edit session has been overridden by user '~a'" (car (get-edit))))
                          (begin
                            (-> P contents! part (extract-binding/single 'text bindings))
                            (register-edit P part)
                            (create-html))))))))
          
          (define (page-being-edited?)
            (let ((e (get-edit)))
              (if (or (eq? e #f) (my-edit?))
                  #f
                  (let ((account    (car e))
                        (begintime  (cadr e))
                        (sessionid  (caddr e)))
                    (let ((form (lambda (url)
                                  (adjust-timeout! (form-timeout))
                                  (-> context make-response/xhtml
                                      `(html
                                        ,(-> supers create-header context)
                                        (body
                                         (div ((class "msgdlg"))
                                              (h1, (_ "HWiki Editing - Collision"))
                                              (form ((action ,url) (method "post"))
                                                    (tr (td ((collspan "2"))
                                                            (p ,(_ "Page '~a' is being edited by account '~a'"
                                                                           (-> context page-name) account)
                                                               (br)
                                                               ,(_ "Begintime of edit: ~a" (date->string begintime))
                                                               (br)
                                                               ,(_ "Session id of editor: ~a, your session id: ~a"
                                                                   sessionid (-> context session-id)  )
                                                               )))
                                                    (tr (td (input ((type "submit") (name "action") (value ,(_ "cancel")))))
                                                        (td (input ((type "submit") (name "action") (value ,(_ "override"))))))
                                                    ))))))))
                      (let ((bindings (request-bindings (send/suspend form))))
                        (let ((action (extract-binding/single 'action bindings)))
                          (if (string-ci=? action (_ "cancel"))
                              #t
                              #f))))))))

          (define (create-html)
            (debug "create-html:from-where=" (-> context from-where))
            (if (or (not (-> context role-editor?)) (page-being-edited?))
                (if (not (-> context role-editor?))
                    (-> supers not-autorized context
                        `(p ,(_ "You must login with 'editor' rights to edit pages")))
                    (-> context to-from-where))
                (begin
                  (set-edit!)
                  (let ((P (page context (-> context from-where))))
                    (debug "create-html:P:" (-> P name) (-> P title))
                    (let ((T (-> P get-template)))
                      (let ((form (lambda (url)
                                    (adjust-timeout! (form-timeout))
                                    (-> context make-response/xhtml
                                        `(html
                                          ,(-> supers create-header context)
                                          (body
                                           (div ((class "edit"))
                                                (h1 ,(_ "HWiki Editing"))
                                                (form ((action ,url) (method "post"))
                                                      ,(append `(table ((class "choose"))
                                                                       (tr (td ,(_ "Editing: "))  (td (input ((size "40") (type "text") (name "name") (value ,(-> P name)))))
                                                                           (td (input ((type "submit") (name "%change-page%") (value ,(_ "change name"))))))
                                                                       (tr (td ,(_ "Template: ")) (td ,(append `(select ((name "template")))
                                                                                                               (map (lambda (name)
                                                                                                                      (if (string-ci=? name (-> T name))
                                                                                                                          `(option ((value ,name) (selected "selected")) ,name)
                                                                                                                          `(option ((value ,name)) ,name)))
                                                                                                                    (-> _template template-names))))
                                                                           (td (input ((type "submit") (name "%change-template%") (value ,(_ "change template"))))) (td " "))
                                                                       (tr (td ,(_ "Title: "))
                                                                           (td ((colspan "2")) (input ((size "40") (type "text") (name "title") (value ,(-> P title)))))
                                                                           (td (input ((type "submit") (name "%change-title%") (value ,(_ "change title")))))))
                                                               (map (lambda (part)
                                                                      `(tr (td ,(car part)) (td (input ((type "submit") (name ,(car part)) (value ,(_ "edit")))) (td " "))))
                                                                    (-> T parts))
                                                               `((tr ((class "done")) (td " ") (td " ") (td " ") (td (input ((type "submit") (name "%done%") (value ,(_ "done")))))))
                                                               )))))))))
                        (let ((bindings (request-bindings (send/suspend form))))
                          (let ((done (extract-binding/choice '(%done%) bindings (cons "" "")))
                                (action (extract-binding/choice (cons '%change-page% (cons '%change-template% (cons '%change-title% (map car (-> T parts))))) bindings (cons "" ""))))
                            (debug "done:" done)
                            (debug "action:" action)
                            (debug "from-where:" (-> context from-where))
                            (if (not (my-edit?))
                                (-> supers message context
                                    (_ "HWiki Edit - Overriden")
                                    (_ "This edit session has been overridden by user '~a'" (car (get-edit))))
                                (cond ((string-ci=? (cdr done) (_ "done"))          (begin
                                                                                      (clear-edit!)
                                                                                      (-> context to-from-where)))
                                      ((string-ci=? (cdr action) (_ "edit"))         (edit-page-part P T (-> T get-part (car action))))
                                      ((string-ci=? (cdr action) (_ "change title")) (begin
                                                                                       (-> P title! (extract-binding/single 'title bindings))
                                                                                       (create-html)))
                                      ((string-ci=? (cdr action) (_ "change template")) (begin
                                                                                          (-> P template! (extract-binding/single 'template bindings))
                                                                                          (create-html)))
                                      ((string-ci=? (cdr action) (_ "change name")) (begin
                                                                                      (clear-edit!)                                                                                   (clear-edit!)
                                                                                      (create-html)))
                                      (else (create-html))))
                            ))))))
                ))

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


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

        )