;;;
;;; pukiwiki-mode.l
;;;

;;;
;;; $HeadURL$
;;; $LastChangedDate$
;;; $LastChangedRivision$
;;;

;;; code

; using elxa
(require "elxa/elxa")

(provide "wiki-mode")

(defvar *wiki-frame-name* "*wiki*" "Wiki edit frame name")
(defvar *wiki-winconf* nil)
(defvar *wiki-mode* nil)

(defvar *wiki-quit-hook* nil)
(defvar *wiki-mode-hook* nil)

(defvar *wiki-local-variable-list*
  '(wiki-mode
    wiki-regexp-keyword-list
    need-not-save
    wiki-cmd
    wiki-page
    wiki-action
    wiki-submit-list
    wiki-notimestamp
    wiki-original
    wiki-digest
    wiki-encodehint
    ))

;; color setting
(defvar *wiki-headline-color* '(:color 9 12 :line :bold))
(defvar *wiki-line-color* '(:color 2 3 :line))
(defvar *wiki-strong-color* '(:keyword 0))
(defvar *wiki-strike-color* '(:keyword 2 :strike-out))
(defvar *wiki-footnote-color* '(:color 4 5))
(defvar *wiki-pagename-color* '(:color 0 0 :underline))
(defvar *wiki-entity-color* '(:keyword 2 :bold))
(defvar *wiki-comment-color* '(:keyword :comment))
(defvar *wiki-attached-color* '(:keyword 2 :underline))
(defvar *wiki-bold-color* '(:color 0 0 :bold))
(defvar *wiki-textattributes-color* '(:keyword 2 :bold))

(defvar *wiki-mode-prefix* '(#\C-c #\w)
  "Key prefix for wiki-mode-map"
  )

(defvar *wiki-mode-map* nil)
(unless *wiki-mode-map*
  (setq *wiki-mode-map* (make-sparse-keymap))
  (define-key *wiki-mode-map* `(,@*wiki-mode-prefix* #\p) 'wiki-preview)
  (define-key *wiki-mode-map* `(,@*wiki-mode-prefix* #\c) 'wiki-submit)
  (define-key *wiki-mode-map* `(,@*wiki-mode-prefix* #\e) 'user::wiki-open-edit-link)
  (define-key *wiki-mode-map* `(,@*wiki-mode-prefix* #\q) 'wiki-exit))

(defun wiki-preview ()
  (interactive)
  (let ((data nil) (buf nil))
    (pushnew (cons "encode_hint" (elxa::www-url-form-encode wiki-encodehint)) data :test 'equal)
    (pushnew (cons "cmd" wiki-cmd) data :test 'eql)
    (pushnew (cons "page" wiki-page) data :test 'eql)
    (pushnew (cons "digest" wiki-digest) data :test 'eql)
    (pushnew (cons "msg" (elxa::www-url-form-encode (buffer-substring (point-min) (point-max)))) data :test 'eql)
    (pushnew (cons "notimestamp" wiki-notimestamp) data :test 'eql)
    (pushnew (cons "original" (elxa::www-url-form-encode wiki-original)) data :test 'eql)
    (pushnew (cons "preview" (elxa::www-url-form-encode "プレビュー")) data :test 'eql)
    (multiple-value-bind (buf)
        (elxa::http-get-response-buffer wiki-action data)
      (let ((location nil))
        (save-window-excursion
          (set-buffer buf)
          (goto-char (point-min))
          (scan-buffer "^$" :regexp t :limit (point-max))
          (delete-region (point-min) (match-end 0))
          ;; if you does not use browserex preview, comment out lines
          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
          (when (find "browserex" *modules* :test 'string=)
            (bx::navigate-current-buffer))
          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
          )
        (delete-buffer buf)
        ))
    ))

(defun wiki-submit ()
  (interactive)
  (let ((data nil) (buf nil))
    (pushnew (cons "encode_hint" (elxa::www-url-form-encode wiki-encodehint)) data :test 'equal)
    (pushnew (cons "cmd" wiki-cmd) data :test 'eql)
    (pushnew (cons "page" wiki-page) data :test 'eql)
    (pushnew (cons "digest" wiki-digest) data :test 'eql)
    (pushnew (cons "msg" (elxa::www-url-form-encode (buffer-substring (point-min) (point-max)))) data :test 'eql)
    (pushnew (cons "notimestamp" wiki-notimestamp) data :test 'eql)
    (pushnew (cons "original" (elxa::www-url-form-encode wiki-original)) data :test 'eql)
    (pushnew (cons "write" (elxa::www-url-form-encode "ページの更新")) data :test 'eql)
    (multiple-value-bind (buf)
        (elxa::http-get-response-buffer wiki-action data)
      (delete-buffer buf))
    ))

(defun get-edit-contents (buf)
  (get-element-innertext buf "textarea name=\"msg\".+" "textarea"))
(defun get-wiki-original (buf)
  (get-element-innertext buf "textarea name=\"original\".+" "textarea"))
(defun get-page-title (buf)
  (get-element-innertext buf "title"))
(defun get-wiki-cmd (buf)
  (get-element-property-value buf "input" "cmd"))
(defun get-wiki-page (buf)
  (get-element-property-value buf "input" "page"))
(defun get-wiki-digest (buf)
  (get-element-property-value buf "input" "digest"))
(defun get-wiki-notimestamp (buf)
  (get-element-property-value buf "input" "notimestamp"))
(defun get-wiki-encodehint (buf)
  (get-element-property-value buf "input" "encode_hint"))

(defun get-element-property-value (buf element property &optional (pname "name"))
  (let ((head nil) (tail nil) (val nil))
    (save-window-excursion
      (set-buffer buf)
      (goto-char (point-min))
      (loop
        (if (scan-buffer (ed::compile-regexp (format nil "<~A" element))
                       :limit (point-max))
          (setq head (match-beginning 0))
        (setq head nil))
        (if (scan-buffer ">" :no-dup t :regexp t :limit (point-max))
            (setq tail (match-end 0))
          (setq tail nil))
        (unless (or head tail)
          (return))
        (when (and head tail)
          (let ((val-list nil))
            (setq val-list (split-string (buffer-substring head tail) " " nil "<>/"))
            (setq val-list (remove-if #'(lambda (x) (string-equal x element)) val-list :count 1))
            (setq val-list (mapcar #'(lambda (x)
                                       (split-string x "=" nil "\"'"))
                                   val-list))
            (when (string-equal property (cadr (assoc pname val-list :test 'string=)))
              (setq val (cadr (assoc "value" val-list :test 'string=))))
            )))
      val)))
  
(defun get-element-innertext (buf stag &optional etag)
  (let ((stag (ed::compile-regexp (format nil "<~A>" stag)))
        (etag (ed::compile-regexp (format nil "</~A>" (or etag stag))))
        head tail str)
    (save-window-excursion
      (set-buffer buf)
      (goto-char (point-min))
      (when (scan-buffer stag :no-dup t :limit (point-max))
        (setq head (match-end 0)))
      (when (scan-buffer etag :no-dup t :limit (point-max))
        (setq tail (match-beginning 0)))
      (if (and head tail)
          (setq str (buffer-substring head tail))
        (setq str nil))
      str)))

(defun wiki-mode (&optional (arg nil sv))
  "wiki-mode"
  (interactive "*p")
  (kill-all-local-variables)
  (setq *wiki-winconf* (current-window-configuration))
  (mapc 'make-local-variable *wiki-local-variable-list*)
  (setq need-not-save t)
  (setq mode-name "wiki")
  (setq buffer-mode 'wiki-mode)
  (make-local-variable 'regexp-keyword-list)
  (setq wiki-regexp-keyword-list
        (compile-regexp-keyword-list
  `(
      ("^\\*\\{1,3\\}.+$" nil ((0 . ,*wiki-headline-color*)))
      ("^----$" nil ((0 . ,*wiki-line-color*)))
      ("^#hr$" nil ((0 . ,*wiki-line-color*)))
      ("''\\(.+\\)''" nil ((1 . ,*wiki-strong-color*)))
      ("%%\\(.+\\)%%" nil ((1 . ,*wiki-strike-color*)))
      ("((\\(.+\\)))" nil ((1 . ,*wiki-footnote-color*)))
      ("\\[\\[\\(.+\\)\\]\\]" nil ((1 . ,*wiki-pagename-color*)))
      ("&#x?[0-9a-f]\\{5\\};" nil ((0 . ,*wiki-entity-color*)))
      ("^//.*$" nil ((0 . ,*wiki-comment-color*)))
      ("&ref(.+);" nil ((0 . ,*wiki-attached-color*)))
      ("^#ref(.+)" nil ((0 . ,*wiki-attached-color*)))
      ("^\\(LEFT\\|CENTER\\|RIGHT\\):\\(.+\\)" nil ((1 . ,*wiki-textattributes-color*)
                                                    (2 . ,*wiki-bold-color*)))
      ("&size(\\([0-9]+\\)){\\(.+\\)};" nil ((1 . ,*wiki-textattributes-color*)
                                           (2 . ,*wiki-bold-color*)))
      ("&color(\\([#a-z0-9,]+\\)){\\(.+\\)};" nil ((1 . ,*wiki-textattributes-color*)
                                                  (2 . ,*wiki-bold-color*)))
      )))
  (setq regexp-keyword-list wiki-regexp-keyword-list)
  (use-keymap *wiki-mode-map*)
  (run-hooks '*wiki-mode-hook*))

(defun wiki-exit ()
  (interactive)
  (delete-buffer (selected-buffer))
  (set-window-configuration *wiki-winconf*)
  (run-hooks '*wiki-quit-hook*))

(defun user::wiki-open-edit-link (&optional url data)
  (interactive "*p")
  (let* ((url (or url
                  (read-string "URL: ")))
         (data (or data
                   (multiple-value-bind (scheme server port path searchpart anchor user password)
                       (elxa::http-parse-url url)
                     (mapcar #'(lambda (x)
                                 (let (l a b)
                                   (setq l (split-string x "="))
                                   (setq a (car l))
                                   (setq b (cadr l))
                                   (cons a b)))
                             (split-string (substring searchpart 1) "&" nil)))))
         (buf nil) (editbuffer nil)
         )
    (multiple-value-bind (buf)
        (elxa::http-get-response-buffer url data)
      (setq editbuffer (get-buffer-create (get-page-title buf)))
      (set-buffer editbuffer)
      (delete-region (point-min) (point-max))
      (set-buffer-fileio-encoding (buffer-fileio-encoding buf))
      (set-buffer-eol-code (buffer-eol-code buf))
      (insert (elxa::replace-entity-refs (get-edit-contents buf)))
      (wiki-mode)
      (setq wiki-action url)
      (setq wiki-cmd (get-wiki-cmd buf))
      (setq wiki-original (get-wiki-original buf))
      (setq wiki-page (get-wiki-page buf))
      (setq wiki-digest (get-wiki-digest buf))
      (setq wiki-encodehint (get-wiki-encodehint buf))
      (delete-buffer buf)
      )
    (switch-to-buffer editbuffer)
    (set-buffer-modified-p nil))
  )

(global-set-key `(,@*wiki-mode-prefix* #\e) 'user::wiki-open-edit-link)