special-edit.scm
(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 (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))))
          )
         (public
          (define (get-template)
            _template)

          (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)))
                            (make-response/xhtml
                             `(html
                               (head (link ((rel "stylesheet") (href ,(-> _template css)) (type "text/css")))
                                     (title ,(_ "HWiki Editing")))
                               (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)
                      (begin
                        (-> P contents! part (extract-binding/single 'text bindings))
                        (register-edit P part)
                        (create-html)))))))


          (define (create-html)
            (debug "create-html:from-where=" (-> context from-where))
            (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))
                              (make-response/xhtml
                               `(html
                                 (head (link ((rel "stylesheet") (href ,(-> _template css)) (type "text/css")))
                                       (title ,(_ "HWiki Editing")))
                                 (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))
                      (cond ((string-ci=? (cdr done) (_ "done")) (-> 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
                                                                            (-> context from-where! (extract-binding/single 'name bindings))
                                                                            (create-html)))
                            (else (create-html)))))))))

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


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

        )