wiliki関係

案内文

;;; ;;; WiLiKi - SchemeによるWiki ;;; ;;; Copyright (c) 2000-2006 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. ;;; ;;; $Id: wiliki.scm,v 1.141 2007-11-05 22:26:40 shirok Exp $ ;;;

モジュールのロードなど

(define-module wiliki (use srfi-1) (use srfi-11) (use srfi-13) (use text.html-lite) (use text.tree) (use text.tr) (use text.gettext) (use util.match) (use util.list) (use www.cgi) (use rfc.uri) (use dbm) (use gauche.charconv) (use gauche.version) (use gauche.parameter) (use gauche.sequence) (use wiliki.format) (use wiliki.page) (use wiliki.db) (use wiliki.macro) (extend wiliki.core) (export <wiliki> wiliki-main wiliki:language-link wiliki:make-navi-button wiliki:top-link wiliki:edit-link wiliki:history-link wiliki:all-link wiliki:recent-link wiliki:search-box wiliki:menu-links wiliki:page-title wiliki:breadcrumb-links wiliki:wikiname-anchor wiliki:wikiname-anchor-string wiliki:get-formatted-page-content wiliki:recent-changes-alist wiliki:page-lines-fold wiliki:lang wiliki:version ) ) (select-module wiliki) ;; Load extra code only when needed. (autoload wiliki.rss rss-page) (autoload wiliki.pasttime how-long-since) (autoload wiliki.log wiliki-log-create wiliki-log-pick wiliki-log-pick-from-file wiliki-log-parse-entry wiliki-log-entries-after wiliki-log-diff wiliki-log-diff* wiliki-log-revert wiliki-log-revert* wiliki-log-recover-content wiliki-log-merge) ;; Less frequently used commands are separated to subfiles. (autoload "wiliki/history" cmd-history cmd-diff cmd-viewold) (autoload wiliki.edit cmd-edit cmd-preview cmd-commit-edit) (autoload "wiliki/version" wiliki:version)

定義など

;; Some constants (define *lwp-version* "1.0") ;''lightweight protocol'' version (define $$ gettext) ;; compatibility stuff ;; wiliki accessors. They're now obsolete; using ref is recommended. (define (db-path-of w) (ref w'db-path)) (define (db-type-of w) (ref w'db-type)) (define (title-of w) (if w (ref w'title) "")) (define (top-page-of w) (ref w'top-page)) (define (language-of w) (if w (ref w'language) 'en)) (define (charsets-of w) (ref w'charsets)) (define (editable? w) (ref w'editable?)) (define (style-sheet-of w) (ref w'style-sheet)) (define (image-urls-of w) (ref w'image-urls)) (define (description-of w) (ref w'description)) (define (protocol-of w) (ref w'protocol)) (define (server-name-of w) (ref w'server-name)) (define (server-port-of w) (ref w'server-port)) (define (script-name-of w) (ref w'script-name)) (define (debug-level w) (if w (ref w'debug-level) 0)) (define (gettext-paths w) (ref w'gettext-paths)) (define (textarea-rows-of w) (ref w'textarea-rows)) ;; obsoleted (define (textarea-cols-of w) (ref w'textarea-cols)) ;; obsoleted (define redirect-page wiliki:redirect-page) (define log-file-path wiliki:log-file-path) ;; NB: compatibility kludge - this may return wrong answer ;; if W is not the current wiliki, but I bet switching two ;; wiliki instances are pretty rare. (define (cgi-name-of w) (and w (wiliki:url))) (define (full-script-path-of w) (and w (wiliki:url :full))) (define (url fmt . args) (apply wiliki:url fmt args)) (define (url-full fmt . args) (apply wiliki:url :full fmt args)) (define wiliki:self-url url)

動作（Actions）

ページ閲覧（View page）

(define-wiliki-action v :read (pagename) ;; NB: see the comment in format-wikiname about the order of ;; wiliki-db-get and virtual-page? check. (cond ((wiliki:db-get pagename) => html-page) ((virtual-page? pagename) (html-page (handle-virtual-page pagename))) ((equal? pagename (top-page-of (wiliki))) (let ((toppage (make <wiliki-page> :title pagename :key pagename :mtime (sys-time)))) ;; Top page is non-existent, or its name may be changed. ;; create it automatically. We need to ensure db is writable. (if (editable? (wiliki)) (wiliki:with-db (lambda () (wiliki:db-put! (ref (wiliki)'top-page) toppage) (html-page toppage)) :rwmode :write) (errorf"Top-page #f (~a) doesn't exist, and the database is read-only" toppage)))) ((or (string-index pagename #[\[\]]) (#/^\s|\s$/ pagename) (string-prefix? "$" pagename)) (error "Invalid page name" pagename)) (else (html-page (make <wiliki-page> :title (string-append ($$ "Nonexistent page: ") pagename) :content `((p ,($$ "Create a new page: ") ,@(wiliki:format-wikiname pagename)))))) )) (define-wiliki-action lv :read (pagename) (let ((page (wiliki:db-get pagename #f))) `(,(cgi-header :content-type #`"text/plain; charset=,(output-charset)") ,#`"title: ,|pagename|\n" ,#`"wiliki-lwp-version: ,|*lwp-version*|\n" ,(if page `(,#`"mtime: ,(ref page 'mtime)\n" "\n" ,(ref page 'content)) `(,#`"mtime: 0\n" "\n")))))

ページ一覧、最近の更新、RSS（All pages, recent changes, RSS）

(define-wiliki-action a :read (_) (html-page (make <wiliki-page> :title (string-append (title-of (wiliki))": "($$ "All Pages")) :command "c=a" :content `((ul ,@(map (lambda (k) `(li ,(wiliki:wikiname-anchor k))) (sort (wiliki:db-map (lambda (k v) k)) string<?)))) ))) (define-wiliki-action r :read (_) (html-page (make <wiliki-page> :title (string-append (title-of (wiliki))": "($$ "Recent Changes")) :command "c=r" :content `((table ,@(map (lambda (p) `(tr (td ,(wiliki:format-time (cdr p))) (td "(" ,(how-long-since (cdr p)) " ago)") (td ,(wiliki:wikiname-anchor (car p))))) (wiliki:db-recent-changes)))) ))) (define-wiliki-action rss :read (_) (rss-page))

検索（Search）

(define-wiliki-action s :read (_ (key :convert cv-in)) (html-page (make <wiliki-page> :title (string-append (title-of (wiliki))": " (format ($$ "Search results of \"~a\"") key)) :command (format #f "c=s&key=~a" (html-escape-string key)) :content `((ul ,@(map (lambda (p) `(li ,(wiliki:wikiname-anchor (car p)) ,(or (and-let* ((mtime (get-keyword :mtime (cdr p) #f))) #`"(,(how-long-since mtime))") ""))) (wiliki:db-search-content key)))) )))

編集と登録（Edit and commit）

URL引数に「ページ名&c=e」を指定すると編集ページ (define-wiliki-action e :read (pagename (t :convert x->integer :default #f)) (cmd-edit pagename t)) URL引数に「ページ名&c=c」を指定すると登録・更新実行 (define-wiliki-action c :write (pagename (commit :default #f) commitが#fの場合確認ページ、#tなら確認なしで登録 (content :convert cv-in) (mtime :convert x->integer :default 0) (logmsg :convert cv-in) (donttouch :default #f)) ((if commit cmd-commit-edit cmd-preview) pagename content mtime logmsg donttouch))

履歴（History）

(define-wiliki-action h :read (pagename (s :convert x->integer :default 0)) (cmd-history pagename s)) (define-wiliki-action hd :read (pagename (t :convert x->integer :default 0) (t1 :convert x->integer :default 0)) (cmd-diff pagename t t1)) (define-wiliki-action hv :read (pagename (t :convert x->integer :default 0)) (cmd-viewold pagename t))

wiliki.scm

最初の注釈文書

案内文