WiLiKiでAJAXな感じの編集
WiLiKiを普段メモ書きに使ってるんやが、ちょっと席を立つ前に保存…とかやるとページ遷移があってウザい。この記法使えたっけ…？と思って表示を確認したいときもページ遷移があってウザい。というわけで、プレビューとコミットをページ遷移なしでやれるようにした。なかなか快適。
しかし、だいぶやっつけで書いたんで、フォームにゴリゴリ書いたJavascriptを埋め込み、AJAX用のactionは普通のコミット用のをコピーしてごにょごにょ弄って仕上げたんで、自分で見ても相当コードが汚い…。今回は晒すのはやめとこう一応晒してみる。
本当はシームレスな編集画面移行とか自動保存とかも付けようかと思ってたが、実はそんなに必要ないような気がしたんで付けず。
以下、wiliki/edit.scmをパクりまくったソース。
;;; Copyright (c) 2000-2004 Shiro Kawai, All rights reserved. ;;; ;;; Permission is hereby granted, free of charge, to any person ;;; obtaining a copy of this software and associated documentation ;;; files (the "Software"), to deal in the Software without restriction, ;;; including without limitation the rights to use, copy, modify, ;;; merge, publish, distribute, sublicense, and/or sell copies of ;;; the Software, and to permit persons to whom the Software is ;;; furnished to do so, subject to the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be ;;; included in all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES ;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS ;;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN ;;; AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF ;;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. ;;; (select-module wiliki) (use text.diff) (define (ajax-edit-form preview pagename content mtime logmsg donttouch) (define (buttons) `((input (@ (type button) (onclick "getPreview(document.getElementById('edit-content').value)" ) (value ,($$ "Preview" )))) (input (@ (type button) (onclick "saveContent()") (value ,($$ "Commit without preview")))) )) (define (donttouch-checkbox) `((input (@ (type checkbox) (name donttouch) (value on) (id donttouch) ,@(if donttouch '((checked checked)) '()))) (label (@ (for donttouch)) ,($$ "Don't update 'Recent Changes'")))) `((stree ,#`"<script type=\"text/javascript\"> function createXMLHttpRequest() { return this.XMLHttpRequest ? new XMLHttpRequest() : new ActiveXObject('Microsoft.XMLHTTP'); } function sendXMLHttpRequest(param, callback){ document.getElementById('condition').innerHTML = \',($$ \"Corresponding...\")\'; var req = createXMLHttpRequest(); req.onreadystatechange = onLoaded(req, callback); req.open('POST'\, ',(cgi-name-of (wiliki))'\, true); req.setRequestHeader('Content-Type', 'application/x-www-form-urlencoded'); req.send(param); } function getPreview(text){ sendXMLHttpRequest('c=ac&logmsg=&content='+encodeURIComponent(text), processPreview); } function saveContent(){ var param = 'commit=on&c=ac&l='+document.getElementById('language').value + '&p=' + encodeURIComponent(document.getElementById('pagename').value) + '&mtime=' + document.getElementById('modtime').value + '&logmsg='+ encodeURIComponent(document.getElementById('edit-logmsg').value) + '&content='+encodeURIComponent(document.getElementById('edit-content').value); if(document.getElementById('donttouch').checked) param += '&donttouch=' + document.getElementById('donttouch').value; sendXMLHttpRequest(param, processCommit); } function onLoaded(req, func){ return function(){ if(req.readyState == 4 && req.status == 200){ func(req); } } } function processCommit(req){ var doc = req.responseXML; var cond; if( cond = doc.getElementsByTagName('condition')[0].childNodes[0].nodeValue ){ switch(cond){ case 'updated': var mtime = doc.getElementsByTagName('mtime')[0].childNodes[0].nodeValue; document.getElementById('modtime').value = mtime; mtime -= 0; var date = new Date(); date.setUTCFullYear(1970); date.setUTCMonth(0); date.setUTCDate(1); date.setUTCHours(0); date.setUTCMinutes(0); date.setUTCSeconds(mtime); cond = ',($$ \"Updated.\")' + ' (' + date.toString() + ')'; break; case 'noupdated': cond = ',($$ \"No need to update.\")'; break; case 'spam': cond = ',($$ \"Your post seems a spam.\")'; break; case 'conflict': cond = ',($$ \"Your post conflicted.\")'; // TODO conflict var node = document.getElementById('preview'); node.innerHTML = doc.getElementsByTagName('conflict')[0].childNodes[0].nodeValue; } document.getElementById('condition').innerHTML = cond; } } function processPreview(req){ var doc = req.responseText; var node = document.getElementById('preview'); node.innerHTML = doc; document.getElementById('condition').innerHTML = ''; } </script><div id=\"preview\"></div>") (form (@ (method POST) (action ,(cgi-name-of (wiliki)))) (input (@ (type hidden) (name c) (value c))) (input (@ (type hidden) (name p) (id pagename) (value ,pagename))) (input (@ (type hidden) (name l) (id language)(value ,(wiliki:lang)))) (input (@ (type hidden) (name mtime) (id modtime) (value ,mtime))) (div (@ (id condition))) ,@(buttons) ,@(donttouch-checkbox) (br) (textarea (@ (name content) (class content) (id edit-content) (rows ,(textarea-rows-of (wiliki))) (cols ,(textarea-cols-of (wiliki)))) ,content) (br) (p ,($$ "ChangeLog (brief summary of your edit for later reference):")) (textarea (@ (name logmsg) (class logmsg) (id edit-logmsg) (rows 2) (cols ,(textarea-cols-of (wiliki)))) ,logmsg) (br) ,@(buttons) (br) (stree ,($$ "<h2>Text Formatting Rules</h2> <p>No HTML.</p> <p>A line begins with \";;\" doesn't appear in the output (comment).</p> <p>A line begins with \"~\" is treated as if it is continued from the previous line, except comments. (line continuation).</p> <p>Empty line to separating paragraphs (<p>)</p> <p>\"<tt>- </tt>\", \"<tt>-- </tt>\" and \"<tt>--- </tt>\" ... at the beginning of a line for an item of unordered list (<ul>). Put a space after dash(es).</p> <p>\"<tt># </tt>\", \"<tt>## </tt>\", \"<tt>### </tt>\" ... at the beginning of a line for an item of ordered list (<ol>). Put a space after <tt>#</tt>'s.</p> <p>A line with only \"<tt>----</tt>\" is <hr>.</p> <p>\"<tt>:item:description</tt>\" at the beginning of a line is <dl>. The item includes all colons but the last one. If you want to include a colon in the description, put it in the next line.</p> <p><tt>[[Name]]</tt> to make \"Name\" a WikiName. Note that a simple mixed-case word doesn't become a WikiName. \"Name\" beginning with \"$\" has special meanings (e.g. \"[[$date]]\" is replaced for the time at the editing.)</p> <p>A URL-like string beginning with \"<tt>http:</tt>\" becomes a link. \"<tt>[URL name]</tt>\" becomes a <tt>name</tt> that linked to <tt>URL</tt>.</p> <p>Surround words by two single quotes (<tt>''foo''</tt>) to emphasize.</p> <p>Surround words by three single quotes (<tt>'''foo'''</tt>) to emphasize more.</p> <p>\"<tt>*</tt>\", \"<tt>**</tt>\" and \"<tt>***</tt>\"' ... at the beginning of a line is a header. Put a space after the asterisk(s).</p> <p>Whitespace(s) at the beginning of line for preformatted text.</p> <p>A line of \"{{{\" starts verbatim text, which ends with a line of \"}}}\". No formatting is done in verbatim text. Even comments and line continuation don't have effect.</p> <p>A line begins with \"||\" and also ends with \"||\" becomes a row of a table. Consecutive rows forms a table. Inside a row, \"||\" delimits columns.</p> <p>\"~%\" is replaced for \"<br>\".</p> <p>If you want to use special characters at the beginning of line, put six consecutive single quotes. It emphasizes a null string, so it's effectively nothing.</p>")) ))) (define (cmd-ajax-edit pagename time) (define (get-old-content page) (and-let* ((time) (lines (wiliki-log-recover-content pagename (log-file-path (wiliki)) (ref page 'content) time))) (string-join lines "\n"))) (unless (editable? (wiliki)) (errorf "Can't edit the page ~s: the database is read-only" pagename)) (let* ((page (wiliki-db-get pagename #t)) (content (or (get-old-content page) (ref page 'content))) ) (html-page (make <wiliki-page> :title pagename :content (ajax-edit-form #f pagename content (ref page 'mtime) "" #f))))) (define (ajax-page page . args) (list (cgi-header :content-type #`"text/xml; charset=,(output-charset)") (wiliki:sxml->stree page))) (define (cmd-ajax-preview pagename content mtime logmsg donttouch) (ajax-page `(div ,@(wiliki:format-content content))) ) (define (cmd-ajax-commit-edit pagename content mtime logmsg donttouch) (ajax-page (let ((p (wiliki-db-get pagename #t)) (now (sys-time))) (define (erase-page) (write-log (wiliki) pagename (ref p 'content) "" now logmsg) (set! (ref p 'content) "") (wiliki-db-delete! pagename) '(commit (condition "erased"))) ; result (define (update-page content) (when (page-changed? content (ref p 'content)) (let1 new-content (expand-writer-macros content) (write-log (wiliki) pagename (ref p 'content) new-content now logmsg) (set! (ref p 'mtime) now) (set! (ref p 'content) new-content) (wiliki-db-put! pagename p :donttouch donttouch))) `(commit (condition "updated") (mtime ,#`",(ref p 'mtime)"))) ;; check if page has been changed. we should ignore the difference ;; of line terminators. (define (page-changed? c1 c2) (not (equal? (call-with-input-string c1 port->string-list) (call-with-input-string c2 port->string-list)))) (define (handle-conflict) ;; let's see if we can merge changes (or (and-let* ((logfile (log-file-path (wiliki))) (picked (wiliki-log-pick-from-file pagename logfile))) (let ((common (wiliki-log-revert* (wiliki-log-entries-after picked mtime) (ref p 'content)))) (receive (merged success?) (wiliki-log-merge common (ref p 'content) content) (if success? (update-page (string-join merged "\n" 'suffix)) `(commit (condition "conflict") (conflict ,(wiliki:format-diff-pre (conflict->diff merged)))) )))) (if (equal? (ref p 'content) content) '(commit (condition "noupdate")) ;; no need to update (let1 diff '() (diff-report (ref p 'content) content :writer (lambda (line type) (push! diff (if type (cons type line) line)))) `(commit (condition "conflict") (conflict ,(wiliki:format-diff-pre (reverse! diff)) )))))) (define (conflict->diff merged) (let1 difflist '() (dolist (chunk merged) (if (pair? chunk) (let1 k (if (eq? (car chunk) 'b) '+ '-) (dolist (line (cdr chunk)) (push! difflist (cons k line)))) (push! difflist chunk))) (reverse! difflist))) ;; The body of cmd-commit-edit ;; If content is empty and the page is not the top page, we erase ;; the page. (unless (editable? (wiliki)) (errorf "Can't edit the page ~s: the database is read-only" pagename)) (cond ;; A very ad-hoc filter for mechanical spams. Normal wiliki content ;; never includes explicit HTML tags (strictly speaking, the content ;; may have HTML tag within verbatim block. let's see if it becomes ;; a problem or not.) ((or (and (string? content) (#/<a\s+href=[\"']?http/i content)) (and (string? logmsg) (#/<a\s+href=[\"']?http/i logmsg))) '(commit (condition "spam"))) ;; Another ad-hoc filter: some (probably automated) spammer put ;; the same string in content and logmsg ((and (not (equal? content "")) (equal? content logmsg)) '(commit (condition "spam"))) ((or (not (ref p 'mtime)) (eqv? (ref p 'mtime) mtime)) (if (and (not (equal? pagename (top-page-of (wiliki)))) (string-every #[\s] content)) (erase-page) (update-page content))) (else (handle-conflict))) )) ) (provide "wiliki/ajax")
これをwiliki/ajax.scmとでもして、wiliki.scmで
(autoload "wiliki/ajax" cmd-ajax-edit cmd-ajax-preview cmd-ajax-commit-edit)
して呼びつつ、eアクションのcmd-editをcmd-ajax-editに書換え、以下を追加して終わり。
;; ;; AJAX Commit ;; (define-wiliki-action ac :write (pagename (commit :default #f) (content :convert cv-in) (mtime :convert x->integer :default 0) (logmsg :convert cv-in) (donttouch :default #f)) ((if commit cmd-ajax-commit-edit cmd-ajax-preview) pagename content mtime logmsg donttouch))
ああ、そういえばconflict時の挙動が作りかけやわ…。
[12/28追記]一応conflict時の最低限の表示を付けた。
