WiLiKi-0.6.2/0000755000076400007640000000000011501274533011712 5ustar shiroshiroWiLiKi-0.6.2/po/0000755000076400007640000000000011501274533012330 5ustar shiroshiroWiLiKi-0.6.2/po/ja.po0000644000076400007640000002077610741672224013302 0ustar shiroshiro# WiLiKi message catalog for Japanese # Copyright (C) 2006 Shiro Kawai # This file is distributed under the same license as the PACKAGE package. # Shiro Kawai , 2006. # #, fuzzy msgid "" msgstr "" "Project-Id-Version: WiLiKi-0.6_pre1\n" "Report-Msgid-Bugs-To: shiro@acm.org\n" "POT-Creation-Date: 2007-05-02 02:49-1000\n" "PO-Revision-Date: 2006-04-26 19:08-1000\n" "Last-Translator: Shiro Kawai Text Formatting Rules\n" "

No HTML.

\n" "

A line begins with \";;\" doesn't appear in the output (comment).\n" "

A line begins with \"~\" is treated as if it is continued\n" " from the previous line, except comments. (line continuation).

\n" "

Empty line to separating paragraphs (<p>)

\n" "

\"- \", \"-- \" and \"--- \" ... at the\n" " beginning of a line for an item of unordered list (<ul>).\n" " Put a space after dash(es).

\n" "

\"# \", \"## \", \"### \" ... at the\n" " beginning of a line for an item of ordered list (<ol>).\n" " Put a space after #'s.

\n" "

A line with only \"----\" is <hr>.

\n" "

\":item:description\" at the beginning of a line is <" "dl>.\n" " The item includes all colons but the last one. If you want to " "include\n" " a colon in the description, put it in the next line.

\n" "

[[Name]] to make \"Name\" a WikiName. Note that\n" " a simple mixed-case word doesn't become a WikiName.\n" " \"Name\" beginning with \"$\" has special meanings (e.g. \n" " \"[[$date]]\" is replaced for the time at the editing.)

\n" "

A URL-like string beginning with \"http:\" becomes\n" " a link. \"[URL name]\" becomes a name that " "linked\n" " to URL.

\n" "

Surround words by two single quotes (''foo'')\n" " to emphasize.

\n" "

Surround words by three single quotes ('''foo''')\n" " to emphasize more.

\n" "

\"*\", \"**\" and \"***\"' ... \n" " at the beginning of a line is a header. Put a space\n" " after the asterisk(s).

\n" "

Whitespace(s) at the beginning of line for preformatted text.

\n" "

A line of \"{{{\" starts verbatim text, which ends with\n" " a line of \"}}}\".\n" " No formatting is done in verbatim text. Even comments and line\n" " continuation don't have effect.

\n" "

A line begins with \"||\" and also ends with \"||\" becomes a\n" " row of a table. Consecutive rows forms a table. Inside a row,\n" " \"||\" delimits columns.

\n" "

\"~%\" is replaced for \"<br>\".

\n" "

If you want to use special characters at the\n" " beginning of line, put six consecutive single quotes.\n" " It emphasizes a null string, so it's effectively nothing.

" msgstr "" "

テキスト整形ルール

\n" "

HTMLは使えない。

\n" "

\";;\" で始まる行は出力に現れない (コメント)

\n" "

\"~\" で始まる行はコメントを除いた前の行に連結される (行の継続)

\n" "

空行は段落の区切り (<p>)

\n" "

行頭の\"- \", \"-- \", \"--- \" …\n" " は順序無しリスト (<ul>)。ダッシュの後に空白が必要。

\n" "

行頭の\"# \", \"## \", \"### \" …\n" " は順序つきリスト (<ol>)。#の後に空白が必要。

\n" "

\"----\" だけの行は <hr>

\n" "

行頭の \":項目:説明\" は <dl>。\n" " 項目は最後に現われるコロンまで取られる。説明中にコロンを入れたければ次" "の行に。

\n" "

[[名前]] と書くと \"名前\" がWikiNameになる。\n" " 名前が \"$\" で始まっていると特殊な意味(例: \"[[$date]]\" は書き込み時" "に\n" " その時間を表す文字列に変換される)。

\n" "

\"http:\"で始まるURLはリンクになる。\n" " \"[URL name]\" と書くとnameに対してURLへの\n" " リンクが貼られる。

\n" "

2つのシングルクオートで囲む (''ほげ'') と\n" " 強調 (<em>)

\n" "

3つのシングルクオートで囲む ('''ほげ''') と\n" " もっと強調 (<strong>)

\n" "

行頭の \"*\", \"**\", \"***\" …\n" " は見出し。アスタリスクの後に空白が必要。

\n" "

行頭に空白があるとプレフォーマットテキスト(<pre>)。\n" " 文字強調やWikiNameの変換は行われる。

\n" "

\"{{{\"だけの行から\"}}}\"だけの行は文字通りの(varbatim)テキスト。\n" " <pre> と似ているが、一切の変換が行われない。\n" " コメントや行の継続も無効になる。ソースコード等を貼りつけるのに便利。\n" "

\"||\" で始まり \"||\" で終る行はテーブルの一行となる。\n" " 連続する行でテーブルが構成される。行の中では \"||\" でカラムが区切られ" "る。\n" "

\"~%\" は \"<br>\"。

\n" "

行頭に上記の特殊な文字をそのまま入れたい場合は、ダミーの強調項目\n" " (6つの連続するシングルクオート)を行頭に入れると良い。

" #: ../src/wiliki/edit.scm:137 #, scheme-format msgid "Preview of ~a" msgstr "~a のプレビュー" #: ../src/wiliki/edit.scm:236 msgid "lines you added (or somebody else deleted)" msgstr "あなたが追加した行、もしくは他の人が削除した行" #: ../src/wiliki/edit.scm:238 msgid "lines somebody else added (or you deleted)" msgstr "他の人が追加した行、もしくはあなたが削除した行" #: ../src/wiliki/edit.scm:241 msgid "" "

The following shows what you are about to submit. Please re-edit the " "content and submit again.

" msgstr "" "

以下に示すのがあなたが更新しようとした内容です。再編集して再び更新して下さ" "い。

" #: ../src/wiliki/history.scm:117 msgid "Edit History" msgstr "編集履歴" #: ../src/wiliki/history.scm:129 #, scheme-format msgid "Edit history of ~a" msgstr "~aの編集履歴" #: ../src/wiliki/history.scm:141 msgid "added lines" msgstr "追加された行" #: ../src/wiliki/history.scm:142 msgid "deleted lines" msgstr "削除された行" #: ../src/wiliki/history.scm:146 #, scheme-format msgid "Changes of ~a since ~a" msgstr "~1@*~a以来の~0@*~aの変更箇所" #: ../src/wiliki/history.scm:164 #, scheme-format msgid "Changes of ~a between ~a and ~a" msgstr "~1@*~aと~2@*~a間の~0@*~aの変更箇所" #: ../src/wiliki/history.scm:174 msgid "Edit History:Diff" msgstr "編集履歴:差分" #: ../src/wiliki/history.scm:192 msgid "Edit History:View" msgstr "編集履歴:過去のバージョン" #: ../src/wiliki/history.scm:201 #, scheme-format msgid "Content of ~a at ~a" msgstr "~1@*~a時点での~0@*~aの内容" #: ../src/wiliki/history.scm:207 msgid "View diff from current version" msgstr "現在のバージョンとの差分を見る" #: ../src/wiliki/history.scm:211 msgid "Edit this version" msgstr "このバージョンを編集する" #: ../src/wiliki/history.scm:218 #, scheme-format msgid "No edit history available for page ~a" msgstr "~aのページには編集履歴情報がありません" #: ../src/wiliki/history.scm:224 msgid "Return to the edit history" msgstr "編集履歴ページに戻る" WiLiKi-0.6.2/po/Makefile.in0000644000076400007640000000477511501262210014377 0ustar shiroshiro# # $Id: Makefile.in,v 1.2 2006-04-27 08:53:26 shirok Exp $ # # General info SHELL = @SHELL@ prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ srcdir = @srcdir@ datadir = @datadir@ datarootdir = @datarootdir@ VPATH = $(srcdir) top_srcdir = @top_srcdir@ # These may be overridden by make invocators DESTDIR = GOSH = "@GOSH@" GAUCHE_CONFIG = "@GAUCHE_CONFIG@" GAUCHE_PACKAGE = "@GAUCHE_PACKAGE@" GAUCHE_CESCONV = "@GAUCHE_CESCONV@" INSTALL = "@GAUCHE_INSTALL@" # Other parameters ALL_LINGUAS = @ALL_LINGUAS@ PO_FILES = $(addsuffix .po,$(ALL_LINGUAS)) MO_FILES = $(addsuffix .gmo,$(ALL_LINGUAS)) MSGDIR = "$(DESTDIR)$(datadir)/locale/$$lingua/LC_MESSAGES/" POTFILES = $(top_srcdir)/src/wiliki.scm \ $(top_srcdir)/src/wiliki/db.scm \ $(top_srcdir)/src/wiliki/edit.scm \ $(top_srcdir)/src/wiliki/format.scm \ $(top_srcdir)/src/wiliki/history.scm \ $(top_srcdir)/src/wiliki/log.scm \ $(top_srcdir)/src/wiliki/macro.scm \ $(top_srcdir)/src/wiliki/page.scm \ $(top_srcdir)/src/wiliki/parse.scm \ $(top_srcdir)/src/wiliki/pasttime.scm \ $(top_srcdir)/src/wiliki/rss.scm \ $(top_srcdir)/src/wiliki/rssmix.scm \ $(top_srcdir)/src/wiliki/util.scm # Module-specific stuff PACKAGE = WiLiKi # Rules TARGET = $(MO_FILES) .SUFFIXES: .po .gmo .po.gmo: msgfmt -o $@ $< all : $(TARGET) $(PACKAGE).pot : $(POTFILES) xgettext -d$(PACKAGE) -LScheme -k'$$$$' -o$(PACKAGE).pot \ --copyright-holder='Shiro Kawai' \ --msgid-bugs-address='@PACKAGE_BUGREPORT@' \ $(POTFILES) update-po: $(PACKAGE).pot for lingua in $(ALL_LINGUAS); do \ if [ ! -r $$lingua.po ]; \ then cp $(PACKAGE).pot $$lingua.po; \ else msgmerge -U $$lingua.po $(PACKAGE).pot; \ fi; \ done install : $(MO_FILES) for lingua in $(ALL_LINGUAS); do \ $(INSTALL) -d $(MSGDIR); \ $(INSTALL) -m 444 $$lingua.gmo $(MSGDIR)/$(PACKAGE).mo; \ done uninstall : for lingua in $(ALL_LINGUAS); do \ $(INSTALL) -U $(MSGDIR) $(PACKAGE).mo; \ done # NB: We don't remove *.gmo files by 'clean', since we want to # include them in the distribution tarball---the target environment # may not have msgfmt, or have an older version which might cause # a problem. (msgfmt 0.10.40 doesn't handle encoding info well.) clean: rm -f $(PACKAGE).pot *~ distclean: clean rm -f Makefile maintainer-clean: clean rm -f Makefile *.gmo WiLiKi-0.6.2/po/ja.gmo0000644000076400007640000001553711501274501013434 0ustar shiroshiro%D5l@ Af D H ;R        ) .;M_r%  *1HL k w** ~U{""!>G`{    &!H _j}   ..0 #  !$"% 

Text Formatting Rules

No HTML.

A line begins with ";;" doesn't appear in the output (comment).

A line begins with "~" is treated as if it is continued from the previous line, except comments. (line continuation).

Empty line to separating paragraphs (<p>)

"- ", "-- " and "--- " ... at the beginning of a line for an item of unordered list (<ul>). Put a space after dash(es).

"# ", "## ", "### " ... at the beginning of a line for an item of ordered list (<ol>). Put a space after #'s.

A line with only "----" is <hr>.

":item:description" 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.

[[Name]] 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.)

A URL-like string beginning with "http:" becomes a link. "[URL name]" becomes a name that linked to URL.

Surround words by two single quotes (''foo'') to emphasize.

Surround words by three single quotes ('''foo''') to emphasize more.

"*", "**" and "***"' ... at the beginning of a line is a header. Put a space after the asterisk(s).

Whitespace(s) at the beginning of line for preformatted text.

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.

A line begins with "||" and also ends with "||" becomes a row of a table. Consecutive rows forms a table. Inside a row, "||" delimits columns.

"~%" is replaced for "<br>".

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.

The following shows what you are about to submit. Please re-edit the content and submit again.

AllAll PagesChangeLog (brief summary of your edit for later reference):Changes of ~a between ~a and ~aChanges of ~a since ~aCommitCommit without previewContent of ~a at ~aCreate a new page: Don't update 'Recent Changes'EditEdit HistoryEdit History:DiffEdit History:ViewEdit history of ~aEdit this versionEpochHistoryLast modified : No edit history available for page ~aNonexistent page: PreviewPreview againPreview of ~aRecent ChangesReturn to the edit historySearchSearch results of "~a"TopView diff from current versionadded linesdeleted lineslines somebody else added (or you deleted)lines you added (or somebody else deleted)Project-Id-Version: WiLiKi-0.6_pre1 Report-Msgid-Bugs-To: shiro@acm.org POT-Creation-Date: 2007-05-02 02:49-1000 PO-Revision-Date: 2006-04-26 19:08-1000 Last-Translator: Shiro Kawai テキスト整形ルール

HTMLは使えない。

";;" で始まる行は出力に現れない (コメント)

"~" で始まる行はコメントを除いた前の行に連結される (行の継続)

空行は段落の区切り (<p>)

行頭の"- ", "-- ", "--- " … は順序無しリスト (<ul>)。ダッシュの後に空白が必要。

行頭の"# ", "## ", "### " … は順序つきリスト (<ol>)。#の後に空白が必要。

"----" だけの行は <hr>

行頭の ":項目:説明" は <dl>。 項目は最後に現われるコロンまで取られる。説明中にコロンを入れたければ次の行に。

[[名前]] と書くと "名前" がWikiNameになる。 名前が "$" で始まっていると特殊な意味(例: "[[$date]]" は書き込み時に その時間を表す文字列に変換される)。

"http:"で始まるURLはリンクになる。 "[URL name]" と書くとnameに対してURLへの リンクが貼られる。

2つのシングルクオートで囲む (''ほげ'') と 強調 (<em>)

3つのシングルクオートで囲む ('''ほげ''') と もっと強調 (<strong>)

行頭の "*", "**", "***" … は見出し。アスタリスクの後に空白が必要。

行頭に空白があるとプレフォーマットテキスト(<pre>)。 文字強調やWikiNameの変換は行われる。

"{{{"だけの行から"}}}"だけの行は文字通りの(varbatim)テキスト。 <pre> と似ているが、一切の変換が行われない。 コメントや行の継続も無効になる。ソースコード等を貼りつけるのに便利。

"||" で始まり "||" で終る行はテーブルの一行となる。 連続する行でテーブルが構成される。行の中では "||" でカラムが区切られる。

"~%" は "<br>"。

行頭に上記の特殊な文字をそのまま入れたい場合は、ダミーの強調項目 (6つの連続するシングルクオート)を行頭に入れると良い。

以下に示すのがあなたが更新しようとした内容です。再編集して再び更新して下さい。

一覧一覧ChangeLog (変更箇所の簡単なメモ)：~1@*~aと~2@*~a間の~0@*~aの変更箇所~1@*~a以来の~0@*~aの変更箇所コミットコミット(プレビュー無し)~1@*~a時点での~0@*~aの内容新規ページ作製: 「最近の更新」に登録しない編集編集履歴編集履歴:差分編集履歴:過去のバージョン~aの編集履歴このバージョンを編集する記録開始編集履歴最終更新 : ~aのページには編集履歴情報がありませんページが存在しません: プレビューもう一度プレビュー~a のプレビュー最近の更新編集履歴ページに戻る検索"~a"の検索結果トップ現在のバージョンとの差分を見る追加された行削除された行他の人が追加した行、もしくはあなたが削除した行あなたが追加した行、もしくは他の人が削除した行WiLiKi-0.6.2/bin/0000755000076400007640000000000010741672224012466 5ustar shiroshiroWiLiKi-0.6.2/bin/wiliki0000755000076400007640000002201510741672224013704 0ustar shiroshiro#!/usr/bin/env gosh ;;; ;;; wiliki - managing wiliki database ;;; ;;; Copyright (c) 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. ;;; ;;; $Id: wiliki,v 1.2 2004-04-04 11:12:14 shirok Exp $ ;; NB: This is just a quick hack. The next version of wiliki ;; will provide enough APIs so that users can create applications ;; like this by just "use"-ing wiliki, instead of overriding ;; internal procedures. Please do not think this as an example ;; of wiliki-based applications! (use srfi-2) (use srfi-13) (use gauche.sequence) (use gauche.uvector) (use gauche.parseopt) (use gauche.parameter) (use util.list) (use text.tree) (use file.filter) (use file.util) (use wiliki.db) (use wiliki.format) (require "wiliki/macro") ;;;===================================================== ;;; Utilities ;;; (define (p . args) (for-each print args)) (define (usage) (p "Usage: wiliki [options] [args ...]" "Commands:" " export Exports the content of a wiliki database to a set of" " HTML, SXML or text files." " format Takes wiliki-marked up text file(s) and generates" " HTML or SXML file(s)." "Type wiliki help for the detailed usage of each command.") (exit 0)) (define (app-error . args) (apply format (current-error-port) args) (newline (current-error-port)) (exit 70)) (define (pagename->path pagename) (with-string-io pagename (lambda () (let loop ((ch (read-char))) (cond ((eof-object? ch)) ((char-set-contains? #[[:alpha:][:digit:]] ch) (display ch) (loop (read-char))) (else (for-each (cut format #t "_~2,'0X" <>) (string->u8vector (string ch))) (loop (read-char)))))))) ;; Loads wiliki.cgi. Returns object. (define (load-wiliki.cgi path) (let ((mod (make-module #f))) (with-error-handler (lambda (e) (app-error "Loading ~a failed: ~a" path (ref e 'message))) (lambda () (eval '(define wiliki-main values) mod) (load path :paths '(".") :environment mod) (eval '(main '()) mod))))) ;;;===================================================== ;;; Export ;;; (define (usage-export) (p "Usage: wiliki export [-t type][-s style][-l scm] source.cgi dest-dir") ) ;;;===================================================== ;;; Format ;;; (define (usage-format) (p "Usage: wiliki format [-t type][-s style][-l scm][-o output] [file.txt]" " wiliki format [-t type][-s style][-l scm] source-dir dest-dir" "Options:" " -t type : specifies output type, which should be either html or sxml." " (Default html)." " -s style : uses style as a style sheet path." " -l scm : is a Scheme source, which is loaded before" " start processing the inpu file. You can define your own" " formatter in it." " -o output : specifies an output file name." "Description:" " Takes a text file with wiliki markup, or a directory that contains" " such text files, and generates html or sxml file(s)." " The first line of each text file will be the page name; its content" " begins from the second line." "" " The first format takes a single text file and writes out HTML or" " SXML as specified by -t option to stdout. If an input file name is" " omitted, input is taken from stdin. If -o option is given, the" " output goes to the specified file. Note that this wouldn't handle" " WikiNames nor macros, unless you set your own formatter by -l option." "" " The second format converts all files with .txt suffix inside a " " directory , and puts the output files in a directory" " , which will be created if it doesn't exist." " The WikiNames are handled as far as it refers to the file in the" " same directory. You can customize it by setting your own formatter" " by -l option.")) (define-class () ((suffix :init-value 'html))) (define the-style (make-parameter '())) (define file-page-alist (make-parameter '())) ;; filename - pagename alist (define-method wiliki:format-wikiname ((f ) name) (cond ((rassoc-ref (file-page-alist) name) => (lambda (file) `((a (@ (href ,#`",|file|.,(ref f 'suffix)")) ,name)))) (else `(,#`"[[,|name|]]")))) (define-method wiliki:format-head-elements ((f ) page) `((title ,(ref page 'title)) ,@(the-style))) (define-method wiliki:format-page-header ((f ) page) `((h1 ,(ref page 'title)))) (define (cmd-format args) (let-args args ((type "t|type=y" 'html) (style "s|style=s" #f) (loadfile "l|load=s" #f) (outfile "o|output=s" #f) . args) (define emitter (case type ((html) (lambda (s o) (write-tree (wiliki:sxml->stree s) o))) ((sxml) (lambda (s o) (write s o))) (else (app-error "type must be either html or sxml: ~a" type)))) (when (> (length args) 2) (usage-format)) (when style (the-style `((link (@ (ref "stylesheet") (href ,style) (type "text/css")))))) (let-optionals* args ((src #f) (dst #f)) (wiliki:formatter (make )) (when loadfile (load loadfile)) (cond ((and dst (file-is-directory? src)) (format-dir src dst type emitter)) ((or (not src) (file-is-regular? src)) (file-filter (cut format-single <> <> emitter) :input (or src (current-input-port)) :output (or outfile (current-output-port)))) (else (app-error "input is not a regular file: ~a" src)))) )) (define (format-single in out emitter) (receive (title content) (get-text-content in) (emitter (wiliki:format-page (make :title title :content content)) out))) (define (format-dir src dst type emitter) (define (get-title path) (call-with-input-file path (lambda (p) (string-trim-both (read-line p))))) (define (process path file&page) (receive (title content) (call-with-input-file path get-text-content) (call-with-output-file (build-path dst #`",(car file&page).,type") (lambda (out) (emitter (wiliki:format-page (make :title title :content content)) out))))) (unless (file-exists? dst) (make-directory* dst)) (let* ((paths (directory-list src :children? #t :add-path? #t :filter #/\.txt$/)) (file&page (map (lambda (path) (cons (regexp-replace #/\.txt$/ (sys-basename path) "") (get-title path))) paths)) ) (parameterize ((file-page-alist file&page)) (for-each process paths file&page)))) (define (get-text-content in) (let1 s (port->string-list in) (when (null? s) (app-error "input file is empty: ~a" (port-name in))) (values (string-trim-both (car s)) (string-join (cdr s) "\n" 'suffix)))) ;;;===================================================== ;;; Help ;;; (define (cmd-help args) (cond ((null? args) (usage)) ((string=? (car args) "export") (usage-export)) ((string=? (car args) "format") (usage-format)) (else (usage)))) ;;;===================================================== ;;; Main ;;; (define (main args) (unless (> (length args) 2) (usage)) (let ((cmd (cadr args)) (args (cddr args))) (cond ((string=? cmd "help") (cmd-help args)) ((string=? cmd "export") (cmd-export args)) ((string=? cmd "format") (cmd-format args)) (else (usage))) 0)) ;; Local variables: ;; mode: scheme ;; end: WiLiKi-0.6.2/doc/0000755000076400007640000000000011501274533012457 5ustar shiroshiroWiLiKi-0.6.2/doc/Makefile.in0000644000076400007640000000125511501262126014522 0ustar shiroshiroSHELL = @SHELL@ prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ srcdir = @srcdir@ VPATH = $(srcdir) top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ GOSH = "@GOSH@" GAUCHE_CONFIG = "@GAUCHE_CONFIG@" INSTALL_TYPE = @INSTALL_TYPE@ INSTALL = @INSTALL@ WILIKI = $(GOSH) -I../src $(top_srcdir)/bin/wiliki TEXTDIR = manual-ja HTMLDIR = manual-html-ja GENERATED = $(HTMLDIR) all : $(HTMLDIR)/index.html : $(WILIKI) format manual-ja manual-html-ja install : uninstall : clean : rm -rf core *~ manual-ja/*~ $(GENERATED) distclean : clean rm -f Makefile maintainer-clean : rm -f Makefile check : test : WiLiKi-0.6.2/doc/manual-ja/0000755000076400007640000000000010741672223014327 5ustar shiroshiroWiLiKi-0.6.2/doc/manual-ja/api-db.txt0000644000076400007640000000122010741672223016217 0ustar shiroshirowiliki.db * [Module] wiliki.db WiLiKiのデータベースのアクセス手続きをまとめたモジュールです。 * [Procedure] wiliki-with-db ''path'' ''type'' ''thunk'' &keyword ''rwmode'' * [Procedure] wiliki-db-record->page ''key'' ''record'' * [Procedure] wiliki-db-exists? ''key'' * [Procedure] wiliki-db-get ''key'' &optional ''create-new'' * [Procedure] wiliki-db-put! ''key'' ''page'' &keyword ''donttouch'' * [Procedure] wiliki-db-delete! ''key'' * [Procedure] wiliki-db-recent-changes * [Procedure] wiliki-db-map ''proc'' * [Procedure] wiliki-db-search ''pred'' &optional ''sorter'' * [Procedure] wiliki-db-search-content ''key'' &optional ''sorter'' WiLiKi-0.6.2/doc/manual-ja/api.txt0000644000076400007640000000007610741672223015644 0ustar shiroshiroAPIリファレンス - [[wiliki.format]] [[$$toc wiliki.format]] WiLiKi-0.6.2/doc/manual-ja/api-format.txt0000644000076400007640000000616310741672223017135 0ustar shiroshirowiliki.format * [Module] wiliki.format テキスト中のWiLiKi形式のマークアップを解釈し、SXMLを生成する機能を 提供するモジュールです。このモジュールはwilikiの他の部分とは独立して 使うことができます。例えば、アプリケーション中に容易にwiliki互換の フォーマッティング機能を含めることができます。 アプリケーション側から呼ぶ主要なフォーマッティングルーチンは、 wiliki:format-pageおよびwiliki:format-contentです。 - wiliki:format-contentはwilikiマークアップされたテキストを 文字列として取り、フォーマットされたSXMLノードのリストを返します。 - wiliki:format-pageはページを表現するクラスの インスタンスを取り、完全なHTMLページを表現するSXML式を返します。 フォーマッティングのカスタマイズは、クラスの サブクラスを作成し、メソッドを適宜オーバロードすることで可能です。 例えば、マークアップ中のWikiNameの解釈は、メソッド wiliki:format-wikinameによって行われます。 クラスのデフォルトメソッドの多くは、 ほとんど何もしないことに注意して下さい。WikiNameのリンクやマクロ等、 wiliki.cgiで実現される機能の多くはモジュール[[wiliki]]や [[wiliki.macro]]で実装されています。 wiliki.formatモジュールを単独でアプリケーションに用いる場合は、 アプリケーションの方針に従って、WikiNameの解釈方法を設計して下さい。 * 高レベルフォーマッティング機構 ** [Procedure] wiliki:format-content ''content'' wilikiマークアップされた文字列を ''content''として受け取り、 フォーマットしたSXMLノードのリストを返します。 {{{ (wiliki:format-content "abc\n- def\n") => ((p "abc\n") (ul (li "def\n"))) }}} なお、オブジェクトを''content''に渡すことも できます。その場合は、ページの内容 (contentスロットの値) を wilikiマークアップされたテキストとしてフォーマットします。 contentスロットの値が既にSXML式であった場合は、 ** [Procedure] wiliki:format-page ''page'' [''options'' ...] ''Page''にオブジェクトを受け取り、 HTMLページを表現するSXML式を返します。 ** [Class] ページを表現するクラスです。ページはデータベースに格納されたもの (persistent page)であっても、一時的にプロセス内で作成されたもの (transient page)であっても構いません。wiliki.formatモジュール自身は データベースとのやりとりは行いません。モジュールを使うアプリケーションが 適切な方法でのインスタンスを作成し、フォーマットルーチンに 渡します。アプリケーションは必要に応じてクラスの サブクラスを作成することもできます。 *** [Slot] title ページタイトル文字列。デフォルトでページフォーマット時にtitle要素および bodyのヘッダ部分に使われます。 *** [Slot] key これがpersistent pageの場合、それを一意に同定するための文字列。 transient pageでは#fにしておきます。 ページフォーマットルーチン内では、この値はincludeされたページの 循環を検出するのに使われます。 *** [Slot] command transient pageの場合、そのページを再生成するためのURLのquery string。 これはwiliki本体で使われるもので、フォーマッタだけを利用 * 低レベルフォーマッティング機構 ** [Class] WiLiKiのフォーマッティングを行うモジュールです。 このクラス、もしくはそのサブクラスのインスタンスが、 グローバルなパラメータwiliki:formatterに格納されており、 WiLiKiのフォーマッティングルーチンは フォーマッティングをカスタマイズする場合は、このクラスの サブクラスを作り WiLiKi-0.6.2/old/0000755000076400007640000000000011157576137012504 5ustar shiroshiroWiLiKi-0.6.2/old/README0000644000076400007640000000056210741672224013357 0ustar shiroshiroThis directory contains the original "quick and dirty" version of WiLiKi script. The first version is 131 lines of code (without comments & blank lines), which is simple enough for those who want to grasp the basic idea of Wiki engine. Note that the scripts contain EUC-JP characters, so it won't run unless your Gauche is compiled with EUC-JP as the native encoding. WiLiKi-0.6.2/old/wiliki1.cgi0000755000076400007640000001166610741672224014546 0ustar shiroshiro#!/usr/local/bin/gosh (use srfi-13) (use gauche.regexp) (use text.html-lite) (use text.tree) (use www.cgi) (use rfc.uri) (use dbm) (use dbm.gdbm) (use gauche.charconv) (define *dbpath* "wikidata.dbm") (define *topname* "TopPage") (define *db* #f) (define *cgi* (sys-basename *program-name*)) ;; Character conv --------------------------------- (define (ccv str) (if (string-null? str) "" (ces-convert string "*JP"))) ;; DB part ---------------------------------------- (define (with-db path thunk) (let ((db (dbm-open :path path :rwmode :write))) (dynamic-wind (lambda () (set! *db* db)) (lambda () (thunk)) (lambda () (set! *db* #f) (dbm-close db))))) ;; Formatting html -------------------------------- (define (url fmt . args) (apply format #f (string-append "~a?" fmt) *cgi* (map uri-encode-string args))) (define (pick-wiki-name line) (regexp-replace-all #/\[\[(([^\]\s]|\][^\]\s])+)\]\]/ line (lambda (match) (let ((name (rxmatch-substring match 1))) (tree->string (if (dbm-exists? *db* name) (html:a :href (url "~a" name) name) `(,name ,(html:a :href (url "p=~a&c=e" name) "?"))))))) ) (define (format-content content) (with-input-from-string content (lambda () (port-fold-right (lambda (line result) (if (string-null? line) (cons "

" result) (cons (pick-wiki-name (html-escape-string line)) result))) '("

") read-line)))) (define (page->html title content . args) (let ((show-edit? (get-keyword :show-edit? args #t)) (show-all? (get-keyword :show-all? args #t))) `(,(html-doctype) ,(html:html (html:head (html:title title)) (html:body (html:h1 title) (html:div :align "right" (if (string=? title *topname*) "" (html:a :href *cgi* "[トップ]")) (if show-edit? (html:a :href (url "p=~a&c=e" title) "[編集]") "") (if show-all? (html:a :href (url "c=a") "[一覧]") "")) (html:hr) content))))) ;; CGI processing --------------------------------- (define (error-page e) (list (cgi-header) (html-doctype) (html:html (html:head (html:title "Wiliki: Error")) (html:body (html:h1 "Error") (html:p (html-escape-string (slot-ref e 'message)))) )) ) (define (cmd-view pagename) (cond ((dbm-get *db* pagename #f) => (lambda (page) (page->html pagename (format-content page)))) ((equal? pagename *topname*) (dbm-put! *db* *topname* "") (page->html *topname* "")) (else (error "No such page" pagename)))) (define (cmd-edit pagename) (let ((page (or (dbm-get *db* pagename #f) ""))) (page->html pagename (html:form :method "POST" :action *cgi* (html:input :type "hidden" :name "c" :value "s") (html:input :type "hidden" :name "p" :value pagename) (html:textarea :name "content" :rows 25 :cols 60 page) (html:input :type "submit" :name "submit" :value "Submit") (html:input :type "reset" :name "reset" :value "Reset") )))) (define (cmd-commit-edit pagename content) (dbm-put! *db* pagename content) (page->html pagename (format-content content))) (define (cmd-all) (page->html "Wiliki: 一覧" (html:ul (map (lambda (k) (html:li (html:a :href (url "~a" k) (html-escape-string k)))) (sort (dbm-map *db* (lambda (k v) k)) string :path path :rwmode :write))) (dynamic-wind (lambda () (set! *db* db)) (lambda () (thunk)) (lambda () (set! *db* #f) (dbm-close db))))) ;; Formatting html -------------------------------- (define (url fmt . args) (apply format #f (string-append "~a?" fmt) *cgi* (map uri-encode-string args))) (define (pick-wiki-name line) (regexp-replace-all #/\[\[(([^\]\s]|\][^\]\s])+)\]\]/ line (lambda (match) (let ((name (rxmatch-substring match 1))) (tree->string (if (dbm-exists? *db* name) (html:a :href (url "~a" name) name) `(,name ,(html:a :href (url "p=~a&c=e" name) "?"))))))) ) (define (pick-uri line) (regexp-replace-all #/http:(\/\/[^\/?#\s]*)?[^?#\s]*(\?[^#\s]*)?(#\S*)?/ line (lambda (match) (let ((url (rxmatch-substring match))) (tree->string (html:a :href url url)))))) (define (format-content content) (with-input-from-string content (lambda () (define (reset-level level) (make-list level "")) (define (loop line level) (cond ((eof-object? line) (reset-level level)) ((string-null? line) `(,@(reset-level level) "

\n

" ,@(loop (read-line) 0))) ((string-prefix? "----" line) `(,@(reset-level level) "

" ,@(loop (read-line) 0))) ((string-prefix? " " line) `(,@(reset-level level) "

" ,@(pre line)))
              ((rxmatch #/^(--?-?) / line)
               => (lambda (m)
                    (let ((line  (rxmatch-after m))
                          (nlevel (- (rxmatch-end m 1) (rxmatch-start m 1))))
                      `(,@(cond ((< level nlevel)
                                 (make-list (- nlevel level) "
    "))
                                ((> level nlevel)
                                 (make-list (- level nlevel) "
"))
                                (else '()))
                        "
  • "
                        ,(safe-line line)
                        ,@(loop (read-line) nlevel)))))
              (else
               (cons (safe-line line) (loop (read-line) level)))))
      (define (safe-line line)
        (pick-wiki-name (pick-uri (html-escape-string line))))
      (define (pre line)
        (cond ((eof-object? line) '("
    • ")) ((string-prefix? " " line) `(,(safe-line line) "\n" ,@(pre (read-line)))) (else (cons "\n" (loop line 0))))) (cons "

    " (loop (read-line) 0))))) (define (page->html title content . args) (let ((show-edit? (get-keyword :show-edit? args #t)) (show-all? (get-keyword :show-all? args #t))) `(,(html-doctype) ,(html:html (html:head (html:title title)) (html:body (html:h1 title) (html:div :align "right" (if (string=? title *topname*) "" (html:a :href *cgi* "[トップ]")) (if show-edit? (html:a :href (url "p=~a&c=e" title) "[編集]") "") (if show-all? (html:a :href (url "c=a") "[一覧]") "")) (html:hr) content))))) ;; CGI processing --------------------------------- (define (error-page e) (list (cgi-header) (html-doctype) (html:html (html:head (html:title "Wiliki: Error")) (html:body (html:h1 "Error") (html:p (html-escape-string (slot-ref e 'message)))) )) ) (define (cmd-view pagename) (cond ((dbm-get *db* pagename #f) => (lambda (page) (page->html pagename (format-content page)))) ((equal? pagename *topname*) (dbm-put! *db* *topname* "") (page->html *topname* "")) (else (error "No such page" pagename)))) (define (cmd-edit pagename) (let ((page (or (dbm-get *db* pagename #f) ""))) (page->html pagename (html:form :method "POST" :action *cgi* (html:input :type "hidden" :name "c" :value "s") (html:input :type "hidden" :name "p" :value pagename) (html:textarea :name "content" :rows 25 :cols 60 page) (html:input :type "submit" :name "submit" :value "Submit") (html:input :type "reset" :name "reset" :value "Reset") )))) (define (cmd-commit-edit pagename content) (dbm-put! *db* pagename content) (page->html pagename (format-content content))) (define (cmd-all) (page->html "Wiliki: 一覧" (html:ul (map (lambda (k) (html:li (html:a :href (url "~a" k) (html-escape-string k)))) (sort (dbm-map *db* (lambda (k v) k)) string :path path :rwmode :write))) (dynamic-wind (lambda () (set! *db* db)) (lambda () (thunk)) (lambda () (set! *db* #f) (dbm-close db))))) ;; Formatting html -------------------------------- (define (url fmt . args) (apply format #f (string-append "~a?" fmt) *cgi* (map uri-encode-string args))) (define (format-line line) (define (wiki-name line) (regexp-replace-all #/\[\[(([^\]\s]|\][^\]\s])+)\]\]/ line (lambda (match) (let ((name (rxmatch-substring match 1))) (tree->string (if (dbm-exists? *db* name) (html:a :href (url "~a" name) name) `(,name ,(html:a :href (url "p=~a&c=e" name) "?")))))))) (define (uri line) (regexp-replace-all #/http:(\/\/[^\/?#\s]*)?[^?#\s]*(\?[^#\s]*)?(#\S*)?/ line (lambda (match) (let ((url (rxmatch-substring match))) (tree->string (html:a :href url url)))))) (define (bold line) (regexp-replace-all #/'''([^']*)'''/ line (lambda (match) (format #f "~a" (rxmatch-substring match 1))))) (define (italic line) (regexp-replace-all #/''([^']*)''/ line (lambda (match) (format #f "~a" (rxmatch-substring match 1))))) (list (uri (italic (bold (wiki-name (html-escape-string line))))) "\n")) (define (format-content content) (with-input-from-string content (lambda () (define (loop line nestings) (cond ((eof-object? line) nestings) ((string-null? line) `(,@nestings "

    \n

    " ,@(loop (read-line) '()))) ((string-prefix? "----" line) `(,@nestings "

    " ,@(loop (read-line) '()))) ((and (string-prefix? " " line) (null? nestings)) `(,@nestings "

    " ,@(pre line)))
              ((string-prefix? "* " line)
               `(,@nestings
                 ,(html:h2 (format-line (string-drop line 2)))
                 ,@(loop (read-line) '())))
              ((string-prefix? "** " line)
               `(,@nestings
                 ,(html:h3 (format-line (string-drop line 3)))
                 ,@(loop (read-line) '())))
              ((rxmatch #/^(--?-?) / line)
               => (lambda (m)
                    (list-item m (- (rxmatch-end m 1) (rxmatch-start m 1))
                               nestings "
      " "
    ")))
              ((rxmatch #/^([123])\. / line)
               => (lambda (m)
                    (list-item m (string->number (rxmatch-substring m 1))
                               nestings "
      " "
    ")))
              ((rxmatch #/^:([^:]+):/ line)
               => (lambda (m)
                    `(,@(if (equal? nestings '(""))
                            '()
                            `(,@nestings "
    "))
                      "
    " ,(format-line (rxmatch-substring m 1))
                      "
    " ,(format-line (rxmatch-after m))
                      ,@(loop (read-line) '("
    ")))))
              (else
               (cons (format-line line) (loop (read-line) nestings)))))

      (define (pre line)
        (cond ((eof-object? line) '("
    ")) ((string-prefix? " " line) `(,@(format-line line) ,@(pre (read-line)))) (else (cons "\n" (loop line '()))))) (define (list-item match level nestings opentag closetag) (let ((line (rxmatch-after match)) (cur (length nestings))) (receive (opener closer) (cond ((< cur level) (values (make-list (- level cur) opentag) (append (make-list (- level cur) closetag) nestings))) ((> cur level) (split-at nestings (- cur level))) (else (values '() nestings))) `(,@opener "
  • " ,(format-line line) ,@(loop (read-line) closer))))) (cons "

    " (loop (read-line) '()))))) (define (page->html title content . args) (let ((show-edit? (get-keyword :show-edit? args #t)) (show-all? (get-keyword :show-all? args #t))) `(,(html-doctype) ,(html:html (html:head (html:title title)) (html:body (html:h1 title) (html:div :align "right" (if (string=? title *topname*) "" (html:a :href *cgi* "[トップ]")) (if show-edit? (html:a :href (url "p=~a&c=e" title) "[編集]") "") (if show-all? (html:a :href (url "c=a") "[一覧]") "")) (html:hr) content))))) ;; CGI processing --------------------------------- (define (error-page e) (list (cgi-header) (html-doctype) (html:html (html:head (html:title "Wiliki: Error")) (html:body (html:h1 "Error") (html:p (html-escape-string (slot-ref e 'message)))) )) ) (define (cmd-view pagename) (cond ((dbm-get *db* pagename #f) => (lambda (page) (page->html pagename (format-content page)))) ((equal? pagename *topname*) (dbm-put! *db* *topname* "") (page->html *topname* "")) (else (error "No such page" pagename)))) (define (cmd-edit pagename) (let ((page (or (dbm-get *db* pagename #f) ""))) (page->html pagename (html:form :method "POST" :action *cgi* (html:input :type "hidden" :name "c" :value "s") (html:input :type "hidden" :name "p" :value pagename) (html:textarea :name "content" :rows 25 :cols 60 page) (html:input :type "submit" :name "submit" :value "Submit") (html:input :type "reset" :name "reset" :value "Reset") )))) (define (cmd-commit-edit pagename content) (dbm-put! *db* pagename content) (page->html pagename (format-content content))) (define (cmd-all) (page->html "Wiliki: 一覧" (html:ul (map (lambda (k) (html:li (html:a :href (url "~a" k) (html-escape-string k)))) (sort (dbm-map *db* (lambda (k v) k)) string'. ;; ;; :db-path - A path to the dbm database. If it's relative, it's ;; relative to the directory the CGI script exists. ;; I recommend to put the database outside the directory ;; tree accessible via http. ;; The database is automatically created when accessed ;; first time; make sure the data directory is writable ;; by the CGI script only for the first time. ;; ;; :top-page - The name of the top page. If the named page doesn't ;; exist, it is created for the first time it accessed. ;; ;; :title - The name of your WiLiKi site. A string given here ;; is used in some places, like in the title of the ;; "Search results" or "Recent changes" pages. ;; ;; :description - A short description of this Wiki site. This is ;; used in RDF site summary. ;; ;; :editable? - If #f, editing is prohibited. ;; ;; :language - default language, either 'jp or 'en ;; ;; :style-sheet - If a path to the css is given, it is used as a ;; style sheet. #f to use the default style. ;; ;; :charsets - specify assoc list of character encodings to be ;; used to generate webpage. ;; ;; :image-urls - specify which URL is allowed as an in-line image. ;; ;; :db-type - A class that implements database functions; ;; Default is . I think and should ;; work, although they might have a problem in locking ;; the database. You can also define your database class ;; and implement wdb* methods (see wiliki.scm). ;; Don't add this argument if you're not sure about these stuff. ;; ;; :debug-level - if more than 0, wiliki shows diagnostic messages when ;; it encounters an error during processing (including macro ;; expansion error). Useful while debugging, but should be ;; turned off for the sites open to public. (define (main args) (wiliki-main (make :db-path "/home/shiro/data/wikidata.dbm" :top-page "WiLiKi" :title "MyWiliki" :description "Shiro's Wiliki Site" :style-sheet "wiliki.css" :language 'jp :charsets '((jp . euc-jp) (en . euc-jp)) :image-urls '((#/^http:\/\/sourceforge.net\/sflogo/ allow)) :debug-level 0 ))) ;; Local variables: ;; mode: scheme ;; end: WiLiKi-0.6.2/src/wiliki.css0000644000076400007640000000523411042022430014472 0ustar shiroshiro/* sample style sheet for wiliki */ body { font-family: verdana, arial, helvetica, sans-serif; color: black; background-color: #eeeedd; margin-left: 2em; margin-right: 2em; } h1, h2, h3, h4, h5, h6 { text-align: left; color: #006655; background: transparent; } h1 { font-size: 190% } h2 { font-size: 160% } h3 { font-size: 130% } h4 { font-size: 110% } h5 { font-size: 100% } h6 { font-size: 100%; font-style: italic } pre { margin-left: 2em; margin-right: 2em; font-family: monospace; background-color: #ddeeee; border: solid thin #aacccc; } pre.macroerror { background-color: #ee5555; } blockquote { border-left: solid thick #ddbbaa; } blockquote > blockquote { border-left: solid thick #bb9988; } blockquote > blockquote > blockquote { border-left: solid thick #997766; } dt { font-weight: bold } td.inbody { background: #dddddd } /* used in formatted body */ td.preview { background: #eeddaa } /* used in preview page */ input.navi-button { margin: 0pt; padding: 0pt; background-color: #dddddd; border: solid 1pt #777777; } input.search-box { margin: 0pt; padding: 0pt; border: solid 1pt #777777; } input.navi-button:hover { background: #ffffee; } span.breadcrumb-links { color: #444444; font-size: 90%; } span.wiliki-alert { background-color: #ff8080; } /* used to warn internal error */ /* * Comment */ div.comment { font-size: 90%; padding: 0pt 3em 2em 3em; margin: 0pt; } div.comment .comment-input { margin-left: 20pt; } div.comment .comment-area { width: 60ex; height: 10ex; } div.comment > p.comment-caption { border-left: solid 4px #006655; border-bottom: solid 1px #006655; padding: 0px 3px; margin: 8px 0px; } div.comment > div.comment-past > h2 { font-size: 100%; font-weight: normal; padding: 0pt; margin: 0pt; } div.comment > div.comment-past h2 { font-size: 100%; font-weight: normal; padding: 0pt; margin: 0pt; } div.comment > div.comment-past h3 { font-size: 100%; font-weight: normal; padding: 0pt; margin: 0pt; } div.comment > div.comment-past h4 { font-size: 100%; font-weight: normal; padding: 0pt; margin: 0pt; } div.comment > div.comment-past h5 { font-size: 100%; font-weight: normal; padding: 0pt; margin: 0pt; } div.comment > div.comment-past h6 { font-size: 100%; font-weight: normal; padding: 0pt; margin: 0pt; } div.comment > div.comment-past > blockquote { border: none; padding: 0pt 20pt; margin: 0pt 0pt 5pt 0pt; } div.comment > div.comment-past > blockquote * { padding: 0pt; margin-top: 0pt; margin-bottom: 0pt; } /* * Tag */ span.tag-anchor { background-color: #ffdddd; font-size: 90%; font-style: italic; } WiLiKi-0.6.2/src/wiliki.scm0000644000076400007640000004343711375751105014514 0ustar shiroshiro;;; ;;; WiLiKi - Wiki in Scheme ;;; ;;; Copyright (c) 2000-2009 Shiro Kawai ;;; ;;; 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-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))) (let1 toppage (make :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 :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"))))) ;; ;; All pages, recent changes, RSS ;; (define-wiliki-action a :read (_) (html-page (make :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 :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 (_ (type :default #f)) (rss-page :item-description (cond [(member type '("html" "html-partial" "raw" "raw-partial" "none")) (string->symbol type)] [else #f]))) ;; ;; Search ;; (define-wiliki-action s :read (_ (key :convert cv-in)) (html-page (make :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 ;; We redirect GET request to the edit action to the normal view, ;; since it is bothering that search engines pick the link to the edit ;; page. (We allow GET with t parameter, since edit history page ;; contains such links.) ;; The 'n' action is only used from the link of creating a new page. ;; It returns the normal view if the named page already exists. (define-wiliki-action e :read (pagename (t :convert x->integer :default #f)) (if (or t (and-let* ([m (cgi-get-metavariable "REQUEST_METHOD")]) (string-ci=? m "POST"))) (cmd-edit pagename t) (wiliki:redirect-page pagename))) (define-wiliki-action n :read (pagename) (if (wiliki:db-exists? pagename) (wiliki:redirect-page pagename) (cmd-edit pagename #f))) (define-wiliki-action c :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-commit-edit cmd-preview) pagename content mtime logmsg donttouch #f)) ;; ;; 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-specific formatting routines ;; ;; Creates a link to switch language (define (wiliki:language-link page) (and-let* ((target (or (ref page 'command) (ref page 'key)))) (receive (language label) (case (wiliki:lang) [(jp) (values 'en "->English")] [else (values 'jp "->Japanese")]) `(a (@ (href ,(string-append (cgi-name-of (wiliki)) "?" target (lang-spec language '&)))) "[" ,label "]")))) ;; Navigation buttons (define (wiliki:make-navi-button params content) `(form (@ (method POST) (action ,(cgi-name-of (wiliki))) (style "margin:0pt; padding:0pt")) ,@(map (match-lambda [(n v) `(input (@ (type hidden) (name ,n) (value ,v)))]) params) (input (@ (type submit) (class "navi-button") (value ,content))))) (define (wiliki:top-link page) (and (not (equal? (ref page 'title) (top-page-of (wiliki)))) (wiliki:make-navi-button '() ($$ "Top")))) (define (wiliki:edit-link page) (and (eq? (ref (wiliki) 'editable?) #t) (wiliki:persistent-page? page) (wiliki:make-navi-button `((p ,(ref page 'key)) (c e)) ($$ "Edit")))) (define (wiliki:history-link page) (and (ref (wiliki) 'log-file) (wiliki:persistent-page? page) (wiliki:make-navi-button `((p ,(ref page 'key)) (c h)) ($$ "History")))) (define (wiliki:all-link page) (and (not (equal? (ref page 'command) "c=a")) (wiliki:make-navi-button '((c a)) ($$ "All")))) (define (wiliki:recent-link page) (and (not (equal? (ref page 'command) "c=r")) (wiliki:make-navi-button '((c r)) ($$ "Recent Changes")))) (define (wiliki:search-box) `((form (@ (method POST) (action ,(cgi-name-of (wiliki))) (style "margin:0pt; padding:0pt")) (input (@ (type hidden) (name c) (value s))) (input (@ (type text) (name key) (size 15) (class "search-box"))) (input (@ (type submit) (name search) (value ,($$ "Search")) (class "navi-button"))) ))) (define (wiliki:breadcrumb-links page delim) (define (make-link-comp rcomps acc) (if (null? acc) (list (car rcomps)) (cons (wiliki:wikiname-anchor (string-join (reverse rcomps) delim) (car rcomps)) acc))) (let1 combs (string-split (ref page 'title) delim) (if (pair? (cdr combs)) `((span (@ (class "breadcrumb-links")) ,@(intersperse delim (pair-fold make-link-comp '() (reverse combs))))) '()))) (define (wiliki:menu-links page) (define (td x) (list 'td x)) `((table (@ (border 0) (cellpadding 0)) (tr ,@(cond-list ((wiliki:top-link page) => td) ((wiliki:edit-link page) => td) ((wiliki:history-link page) => td) ((wiliki:all-link page) => td) ((wiliki:recent-link page) => td)) (td ,@(wiliki:search-box)))))) (define (wiliki:page-title page) `((h1 ,(if (wiliki:persistent-page? page) `(a (@ (href ,(url "c=s&key=[[~a]]" (ref page 'key)))) ,(ref page 'title)) (ref page 'title))))) (define (wiliki:default-page-header page opts) `(,@(wiliki:page-title page) (div (@ (align "right")) ,@(wiliki:breadcrumb-links page ":")) (div (@ (align "right")) ,@(wiliki:menu-links page)) (hr))) (define (wiliki:default-page-footer page opts) (if (ref page 'mtime) `((hr) (div (@ (align right)) ,($$ "Last modified : ") ,(wiliki:format-time (ref page 'mtime)))) '())) (define (wiliki:default-head-elements page opts) (let1 w (wiliki) `((title ,(wiliki:format-head-title (the-formatter) page)) ,@(cond-list [w `(base (@ (href ,(wiliki:url :full))))] [w `(link (@ (rel "alternate") (type "application/rss+xml") (title "RSS") (href ,(wiliki:url :full "c=rss"))))] [(and w (ref w'style-sheet)) => @(lambda (ss) (map (lambda (s) `(link (@ (rel "stylesheet") (href ,s) (type "text/css")))) (if (list? ss) ss (list ss))))]) ))) (define (default-format-time time) (if time (if (zero? time) ($$ "Epoch") (sys-strftime "%Y/%m/%d %T %Z" (sys-localtime time))) "-")) (define (default-format-wikiname name) (define (inter-wikiname-prefix head) (and-let* ([page (wiliki:db-get "InterWikiName")] [rx (string->regexp #`"^:,(regexp-quote head):\\s*")]) (call-with-input-string (ref page 'content) (lambda (p) (let loop ((line (read-line p))) (cond [(eof-object? line) #f] [(rx line) => (lambda (m) (let1 prefix (m 'after) (if (string-null? prefix) (let1 prefix (read-line p) (if (or (eof-object? prefix) (string-null? prefix)) #f (string-trim-both prefix))) (string-trim-both prefix))))] [else (loop (read-line p))])))))) (define (reader-macro-wikiname? name) (cond [(string-prefix? "$$" name) (handle-reader-macro name)] [(or (string-prefix? "$" name) (#/^\s/ name) (#/\s$/ name)) ;;invalid wiki name (list "[[" name "]]")] [else #f])) (define (inter-wikiname? name) (receive (head after) (string-scan name ":" 'both) (or (and head (and-let* ([inter-prefix (inter-wikiname-prefix head)]) (values inter-prefix after))) (values #f name)))) (or (reader-macro-wikiname? name) (receive (inter-prefix real-name) (inter-wikiname? name) (cond [inter-prefix (let1 scheme (if (#/^(https?|ftp|mailto):/ inter-prefix) "" "http://") `((a (@ (href ,(format "~a~a~a" scheme inter-prefix (uri-encode-string (cv-out real-name))))) ,name)))] ;; NB: the order of checks here is debatable. Should a virtual ;; page shadow an existing page, or an existing page shadow a ;; virtual one? Note also the order of this check must match ;; the order in cmd-view. [(or (wiliki:db-exists? real-name) (virtual-page? real-name)) (list (wiliki:wikiname-anchor real-name))] [else `(,real-name (a (@ (href ,(url "p=~a&c=n" (cv-out real-name)))) "?"))])) ) ) ;; Ideally, default-format-wikiname &c should be defined as a method ;; specialized for . However we need to keep the ;; old protocol for the backward compatibility; existing wiliki app ;; may customize the formatter by setting slots. Newly written scripts ;; should customize by subclassing , *not* by setting ;; slots. (define-class () (;; for backward compatibility. (bracket :init-value default-format-wikiname) (time :init-value default-format-time) (header :init-value wiliki:default-page-header) (footer :init-value wiliki:default-page-footer) (head-elements :init-value wiliki:default-head-elements))) (wiliki:formatter (make )) ;override the default ;; Character conv --------------------------------- (define cv-in wiliki:cv-in) (define cv-out wiliki:cv-out) (define output-charset wiliki:output-charset) ;; CGI processing --------------------------------- (define html-page wiliki:std-page) ; for backward compatibility (provide "wiliki") WiLiKi-0.6.2/src/Makefile.in0000644000076400007640000000303711501265723014552 0ustar shiroshiro# # $Id: Makefile.in,v 1.27 2007-07-14 05:33:20 shirok Exp $ # # General info SHELL = @SHELL@ prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ datarootdir = @datarootdir@ datadir = @datadir@ VPATH = $(srcdir) # These may be overridden by make invocators DESTDIR = GOSH = "@GOSH@" GAUCHE_CONFIG = "@GAUCHE_CONFIG@" GAUCHE_PACKAGE = "@GAUCHE_PACKAGE@" GAUCHE_CESCONV = "@GAUCHE_CESCONV@" INSTALL = "@GAUCHE_INSTALL@" SCMFILES = wiliki.scm \ wiliki/auth.scm \ wiliki/core.scm \ wiliki/db.scm \ wiliki/edit.scm \ wiliki/format.scm \ wiliki/history.scm \ wiliki/log.scm \ wiliki/macro.scm \ wiliki/util.scm \ wiliki/rss.scm \ wiliki/rssmix.scm \ wiliki/page.scm \ wiliki/parse.scm \ wiliki/pasttime.scm \ wiliki/scr-macros.scm \ wiliki/version.scm TARGET = $(SCMFILES) GENERATED = wiliki/version.scm HEADER_INSTALL_DIR = "$(DESTDIR)@GAUCHE_PKGINCDIR@" SCM_INSTALL_DIR = "$(DESTDIR)@GAUCHE_PKGLIBDIR@" ARCH_INSTALL_DIR = "$(DESTDIR)@GAUCHE_PKGARCHDIR@" all : wiliki/version.scm wiliki/version.scm : ../VERSION $(GOSH) ./gen-version ../VERSION > wiliki/version.scm install : $(INSTALL) -m 444 -T $(SCM_INSTALL_DIR) $(TARGET) uninstall : $(INSTALL) -U $(SCM_INSTALL_DIR) $(TARGET) clean : rm -f core *~ wiliki/*~ wiliki/*.orig $(GENERATED) distclean : clean rm -f Makefile maintainer-clean : rm -f Makefile check : test : WiLiKi-0.6.2/src/gen-version0000644000076400007640000000036210741672223014664 0ustar shiroshiro;;-*-Scheme-*- (define (main args) (let* ((vfile (cadr args)) (verstr (call-with-input-file vfile read-line))) (write '(select-module wiliki)) (newline) (write `(define (wiliki:version) ,verstr)) (newline)) 0) WiLiKi-0.6.2/src/wiliki2.cgi0000755000076400007640000000523410741672223014551 0ustar shiroshiro#!/usr/bin/gosh ;; wiliki2 - sample of customizing page format (use util.list) (use wiliki) (use wiliki.format) (use wiliki.db) (define-class () ()) (define-method wiliki:format-page-header ((fmt ) page . opts) (define (td x) (list 'td x)) `((div (@ (style "font-size:80%") (align "right")) (table (tr (td ,@(wiliki:breadcrumb-links page ":")) ,@(cond-list ((wiliki:top-link page) => td) ((wiliki:edit-link page) => td) ((wiliki:history-link page) => td) ((wiliki:all-link page) => td) ((wiliki:recent-link page) => td))))))) (define-method wiliki:format-page-footer ((fmt ) page . opts) `((hr) (div (@ (class "footer") (style "text-align:right")) "Last modified : " ,(wiliki:format-time (ref page 'mtime)) (br) (a (@ (href "http://www.shiro.dreamhost.com/scheme/wiliki/wiliki.cgi")) "WiLiKi " ,(wiliki:version)) " running on " (a (@ (href "http://www.shiro.dreamhost.com/scheme/gauche/")) "Gauche ",(gauche-version))))) (define-method wiliki:format-page-content ((fmt ) page . opts) `((table (@ (border 0) (cellspacing 8) (width "100%") (class "content-table")) (tr (td (@ (class "menu-strip") (valign "top") (style "font-size:80%;width:10em")) (div (@ (class "menu-title")) ,@(wiliki:format-wikiname "Topics")) ,@(wiliki:get-formatted-page-content "Topics") (div (@ (class "menu-title")) "Search") (div (@ (style "margin-top:2pt;margin-bottom:2pt")) ,@(wiliki:search-box)) (div (@ (class "menu-title")) "Recent Changes") (ul (@ (class "menu-list")) ,@(map (lambda (p) `(li ,@(wiliki:format-wikiname (car p)))) (wiliki:recent-changes-alist :length 20))) (a (@ (href ,(wiliki:self-url "c=r"))) "More ...")) (td (@ (valign "top")) ,@(wiliki:page-title page) ,@(wiliki:format-content page)))))) (wiliki:formatter (make )) (define (main args) (wiliki-main (make :db-path "/home/shiro/data/wikidata.dbm" :top-page "WiLiKi" :title "MyWiliki2" :description "Shiro's Wiliki Site Sample 2" :style-sheet "wiliki2.css" :language 'jp :charsets '((jp . euc-jp) (en . euc-jp)) :image-urls '((#/^http:\/\/sourceforge.net\/sflogo/ allow)) :log-file "wikidata.log" :debug-level 0 ))) ;; Local variables: ;; mode: scheme ;; end: WiLiKi-0.6.2/src/wiliki2.css0000644000076400007640000000332610741672223014574 0ustar shiroshiro/* sample style sheet for wiliki */ body { font-family: verdana, arial, helvetica, sans-serif; color: black; background-color: #ffffee; } :link { text-decoration: none; color: #00bb00; } :visited { text-decoration: none; color: #557722; } h1 { text-align: right; font-size: 190%; color: #444400; margin-top: 20pt; margin-bottom: 20pt; border-bottom: solid thick #888844; } h2 { text-align: left; font-size: 150%; color: #448800; margin-top: 30pt; border-bottom: solid thin #448800; } h3, h4, h5, h6 { text-align: left; color: #448800; background: transparent; } h3 { font-size: 130% } h4 { font-size: 110% } h5 { font-size: 100% } h6 { font-size: 100%; font-style: italic } pre { margin-left: 2em; margin-right: 2em; font-family: monospace; background-color: #eeffee; border: solid thin #9999aa; } pre.macroerror { background-color: #ee5555; } blockquote { border: solid thick #aabbdd; } dt { font-weight: bold } table.content-table { table-layout : fixed } td.inbody { background-color: #eeeeee } /* used in formatted body */ td.preview { background-color: #eeeedd } /* used in preview page */ div.footer { color: #bbbbbb } td.menu-strip ul { margin: 0pt; padding-left: 5pt; } div.menu-title { text-align : center; font-weight: bold; background: #aaddbb; } input.navi-button { margin: 0pt; padding: 0pt; background-color: #dddddd; border: solid thin #777777; } input.search-box { margin: 0pt; padding: 0pt; border: solid 1pt #777777; } input.navi-button:hover { background: #ffffee; } span.breadcrumb-links { color: #444444; font-size: 90%; } span.wiliki-alert { background-color: #ff8080; } /* used to warn internal error */ WiLiKi-0.6.2/src/wiliki/0000755000076400007640000000000011501274407013771 5ustar shiroshiroWiLiKi-0.6.2/src/wiliki/edit.scm0000644000076400007640000003137411417462243015435 0ustar shiroshiro;;; ;;; wiliki/edit - handles edit, preview, and conflict page ;;; ;;; Copyright (c) 2000-2009 Shiro Kawai ;;; ;;; 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: edit.scm,v 1.22 2007-11-05 22:26:40 shirok Exp $ ;;; (define-module wiliki.edit (use gauche.parameter) (use srfi-13) (use text.gettext) (use text.diff) (use www.cgi) (use wiliki.core) (use wiliki.log) (use wiliki.page) (use wiliki.macro) (export cmd-edit cmd-preview cmd-commit-edit)) (select-module wiliki.edit) (define $$ gettext) (define (edit-form preview pagename content mtime logmsg donttouch) (define (buttons) (if preview `((input (@ (type submit) (name preview) (value ,($$ "Preview again")))) (input (@ (type submit) (name commit) (value ,($$ "Commit"))))) `((input (@ (type submit) (name preview) (value ,($$ "Preview")))) (input (@ (type submit) (name commit) (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'")))) `((form (@ (method POST) (action ,(wiliki:url))) (input (@ (type hidden) (name c) (value c))) (input (@ (type hidden) (name p) (value ,pagename))) (input (@ (type hidden) (name l) (value ,(wiliki:lang)))) (input (@ (type hidden) (name mtime) (value ,mtime))) ,@(buttons) ,@(donttouch-checkbox) (br) ,@(if preview (list preview '(hr)) '()) (textarea (@ (name content) (class content) (rows ,(ref (wiliki)'textarea-rows)) (cols ,(ref (wiliki)'textarea-cols))) ,content) (br) (p ,($$ "ChangeLog (brief summary of your edit for later reference):")) (textarea (@ (name logmsg) (class logmsg) (rows 2) (cols ,(ref (wiliki)'textarea-cols))) ,logmsg) (br) ,@(buttons) (br) (stree ,($$ "

    Text Formatting Rules

    No HTML.

    A line begins with \";;\" doesn't appear in the output (comment).

    A line begins with \"~\" is treated as if it is continued from the previous line, except comments. (line continuation).

    Empty line to separating paragraphs (<p>)

    \"- \", \"-- \" and \"--- \" ... at the beginning of a line for an item of unordered list (<ul>). Put a space after dash(es).

    \"# \", \"## \", \"### \" ... at the beginning of a line for an item of ordered list (<ol>). Put a space after #'s.

    A line with only \"----\" is <hr>.

    \":item:description\" 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.

    [[Name]] 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.)

    A URL-like string beginning with \"http:\" becomes a link. \"[URL name]\" becomes a name that linked to URL.

    Surround words by two single quotes (''foo'') to emphasize.

    Surround words by three single quotes ('''foo''') to emphasize more.

    \"*\", \"**\" and \"***\"' ... at the beginning of a line is a header. Put a space after the asterisk(s).

    Whitespace(s) at the beginning of line for preformatted text.

    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.

    A line begins with \"||\" and also ends with \"||\" becomes a row of a table. Consecutive rows forms a table. Inside a row, \"||\" delimits columns.

    \"~%\" is replaced for \"<br>\".

    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.

    ")) ))) (define (cmd-edit pagename time) (define (get-old-content page) (and-let* ((time) (lines (wiliki-log-recover-content pagename (wiliki:log-file-path (wiliki)) (ref page 'content) time))) (string-join lines "\n"))) (unless (eq? (ref (wiliki)'editable?) #t) (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))) ) (wiliki:std-page (make :title pagename :content (edit-form #f pagename content (ref page 'mtime) "" #f))))) (define (cmd-preview pagename content mtime logmsg donttouch restricted) (let ((page (wiliki:db-get pagename #t))) (wiliki:std-page (make :title (format #f ($$ "Preview of ~a") pagename) :content (edit-form (preview-box (wiliki:format-content content)) pagename content mtime logmsg donttouch))))) ;; DONTTOUCH - If #t, don't update RecentChanges. ;; LIMITED - #t indicates this edit is generated procedurally, like comment ;; feature. It is allowed if EDITABLE? == limited. (define (cmd-commit-edit pagename content mtime logmsg donttouch limited) (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) (wiliki:redirect-page (ref (wiliki)'top-page))) (define (update-page content) (when (page-changed? content (ref p 'content)) (let1 new-content (parameterize ([wiliki:page-stack (list p)]) (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))) (wiliki:redirect-page pagename)) ;; 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 (wiliki: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)) (conflict-page p (conflict->diff merged) content logmsg donttouch))))) (if (equal? (ref p 'content) content) (wiliki:redirect-page pagename) ;; no need to update (let1 diff '() (diff-report (ref p 'content) content :writer (lambda (line type) (push! diff (if type (cons type line) line)))) (conflict-page p (reverse! diff) content logmsg donttouch))))) (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))) ;; Ad-hoc filter for mechanical spams. (define (suspicious?) (or ;; 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. (and (string? content) (#/ (lambda (reason) (wiliki:log-event "rejecting spam on ~s (~a): content=~s logmsg=~s" pagename reason content logmsg) (wiliki:redirect-page (ref (wiliki)'top-page)))] [(or (not (ref p 'mtime)) (eqv? (ref p 'mtime) mtime)) (if (and (not (equal? pagename (ref (wiliki)'top-page))) (string-every #[\s] content)) (erase-page) (update-page content))] [else (handle-conflict)]) )) (define (conflict-page page diff content logmsg donttouch) (wiliki:std-page (make :title (string-append (ref (wiliki)'title)": "($$ "Update Conflict")) :content `((stree ,($$ "

    It seems that somebody has updated this page while you're editing. The difference is snown below. Please revise your edit and commit again.

    ")) (hr) (ul (li ,(wiliki:format-diff-line `(+ . ,($$ "lines you added (or somebody else deleted)")))) (li ,(wiliki:format-diff-line `(- . ,($$ "lines somebody else added (or you deleted)"))))) ,(wiliki:format-diff-pre diff) (a (@ (name "edit")) (hr)) ,($$ "

    The following shows what you are about to submit. Please re-edit the content and submit again.

    ") ,@(edit-form #f (ref page 'key) content (ref page 'mtime) logmsg donttouch) )))) (define (preview-box content) `(table (@ (style "table-layout:fixed") (width "100%") (cellpadding 5)) (tr (td (@ (class "preview")) ,@content)))) ;; NB: we assume write-log is always called during the main database ;; is locked, so we don't do any locking here. (define (write-log wiliki pagename old new timestamp logmsg) (and-let* ((logfile (wiliki:log-file-path wiliki))) (let1 content (wiliki-log-create pagename new old :timestamp timestamp :remote-addr (or (cgi-get-metavariable "REMOTE_ADDR") "") :remote-user (or (cgi-get-metavariable "REMOTE_USER") "") :message (or logmsg "")) (call-with-output-file logfile (lambda (p) (display content p) (flush p)) :if-exists :append)) )) (provide "wiliki/edit") WiLiKi-0.6.2/src/wiliki/parse.scm0000644000076400007640000004334511477050176015627 0ustar shiroshiro;;; ;;; wiliki/parse.scm - wiliki markup -> SXML converter ;;; ;;; Copyright (c) 2003-2009 Shiro Kawai ;;; ;;; 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: parse.scm,v 1.7 2007-12-22 00:05:06 shirok Exp $ (define-module wiliki.parse (use srfi-1) (use srfi-13) (use text.tree) (use util.match) (export wiliki-parse wiliki-parse-string wiliki-remove-markup)) (select-module wiliki.parse) ;; This module provides basic procedues to parse Wiki markup text ;; to SXML. Nothing else is done; the parser doesn't know what ;; WikiName is, or how to interpret macros. They are simply inserted ;; as 'wiki-name' and 'wiki-macro' SXML node into the output. ;; The higher-level layer is responsible to interpret these node ;; as it desires. ;; ;; This module is the 'bottom' of wiliki functionality---it doesn't ;; depend on any other wiliki modules, and can be used individually. ;;========================================================== ;; Entries ;; ;; wiliki-parse :: Port -> [SXML] (define (wiliki-parse port) (with-port-locking port (cut fmt-lines (make-line-scanner port)))) ;; wiliki-parse-string :: String -> [SXML] (define (wiliki-parse-string string) (call-with-input-string string wiliki-parse)) ;; An utility to remove wiki markup stuff and returns a plain text Stree. ;; newlines are also removed. (define (wiliki-remove-markup text) (reverse! ((rec (tree-fold tree seed) (match tree ["\n" seed] ;; skip newline [(? string?) (cons tree seed)] [('@ . _) seed] ;; skip attr node [('@@ . _) seed] ;; skip aux node [('wiki-name name) (cons name seed)] [('wiki-macro . _) seed] [(name . nodes) (fold tree-fold seed nodes)] [else seed])) `(x ,@(wiliki-parse-string text)) '()))) ;;---------------------------------------------------------- ;; Parser body ;; ;; Find wiki name in the line. ;; Correctly deal with nested "[[" and "]]"'s. (define (fmt-line ctx line seed) ;; parse to next "[[" or "]]" (define (token s) (cond ((#/\[\[|\]\]/ s) => (lambda (m) (values (m 'before) (m) (m 'after)))) (else (values s #f #f)))) ;; return and (define (find-closer s level in) (receive (pre tok post) (token s) (cond ((not tok) (values #f (tree->string (cons "[[" (reverse (cons pre in)))))) ((string=? tok "[[") (find-closer post (+ level 1) (list* "[[" pre in))) ((= level 0) (values (tree->string (reverse (cons pre in))) post)) (else (find-closer post (- level 1) (list* "]]" pre in)))))) ;; deal with other inline items between wikinames ;; NB: the precedence is embedded to the order of calling regexp-fold. (define (mailto line seed) (regexp-fold #/\[(mailto:[-\w]+(?:\.[-\w]+)*@[-\w]+(?:\.[-\w]+)+)\s+(.*)\]/ cons (lambda (match seed) (cons `(a (@ (href ,(match 1))) ,(match 2)) seed)) seed line)) (define (uri line seed) (regexp-fold #/(\[)?(http|https|ftp):(\/\/[^\/?#\s]*)?([^?#\s]*(\?[^#\s]*)?(#\S*)?)(\s([^\]]+)\])?/ mailto (lambda (match seed) ;; NB: If a server name is not given, we omit the protocol scheme in ;; href attribute, so that the same page would work on both ;; http and https access. (Patch from YAEGASHI Takeshi). (let ((scheme (match 2)) (server (match 3)) (path (match 4)) (openp (match 1)) (name (match 8))) (let1 url (if server #`",|scheme|:,|server|,|path|" path) (if (and openp name) (cons `(a (@ (href ,url)) ,name) seed) (list* (if openp "[" "") `(a (@ (href ,url)) ,scheme ":" ,(or server "") ,path) seed))))) seed line)) (define (bracket line seed) (if (string-null? line) seed (receive (pre post) (string-scan line "[[" 'both) (if pre (receive (wikiname rest) (find-closer post 0 '()) (if wikiname (bracket rest (cons `(wiki-name ,wikiname) (uri pre seed))) (uri rest (uri pre seed)))) (uri line seed))))) (define (nl line seed) (regexp-fold #/~%/ bracket (lambda (match seed) (cons '(br) seed)) seed line)) ;; NB: we remove empty bold and italic, for backward compatibility (define (italic line seed) (regexp-fold #/''([^'].*?)?''/ nl (lambda (match seed) (if (or (not (match 1)) (string-null? (match 1))) seed (cons `(em ,@(reverse! (nl (match 1) '()))) seed))) seed line)) (define (bold line seed) (regexp-fold #/'''([^'].*?)?'''/ italic (lambda (match seed) (if (or (not (match 1)) (string-null? (match 1))) seed (cons `(strong ,@(reverse! (nl (match 1) '()))) seed))) seed line)) (define (code line seed) (regexp-fold #/"""([^\"].*?)?"""/ bold (lambda (match seed) (if (or (not (match 1)) (string-null? (match 1))) seed (cons `(code ,@(reverse! (nl (match 1) '()))) seed))) seed line)) (define (smacro line seed) (if (string-null? line) seed (receive (pre post) (string-scan line "##(" 'both) (if pre (receive (expr rest) (read-macro-expr post) ;; NB: we should handle distinction of inline and block elements ;; here. It requires some trick, so for now I leave it. (if expr (smacro rest (cons `(wiki-macro ,@expr) (bold pre seed))) (smacro post (bold (string-append pre "##(") seed)))) (code line seed))))) ;; Main body (cons "\n" (smacro line seed))) ;; Read lines from generator and format them. This is the main ;; parser/transformer of WiLiKi format. (define (fmt-lines generator) (define (h-level m) (- (rxmatch-end m 1) (rxmatch-start m 1))) (define (l-level ctx) (count (cut memq <> '(ul ol)) ctx)) (define (lex line ctx) (cond ((eof-object? line) '(eof)) ((string-null? line) '(null)) ((string=? "----" line) '(hr)) ((string=? "{{{" line) '(open-verb)) ((string=? "<<<" line) '(open-quote)) ((and (string=? ">>>" line) (memq 'blockquote ctx)) '(close-quote)) ((string-prefix? " " line) `(pre . ,line)) ((rxmatch #/^(\*{1,}) / line) => (cut cons 'heading <>)) ((rxmatch #/^(--*) / line) => (cut cons 'ul <>)) ((rxmatch #/^(##*) / line) => (cut cons 'ol <>)) ((rxmatch #/^:(.*):([^:]*)$/ line) => (cut cons 'dl <>)) ((rxmatch #/^\|\|(.*)\|\|$/ line) => (cut cons 'table <>)) (else `(p . ,line)))) (define token-buffer #f) (define (next-token ctx) (or token-buffer (lex (generator) ctx))) (define (pushback-token tok) (set! token-buffer tok)) (define (token-type tok) (car tok)) (define (token-value tok) (cdr tok)) (define (>> cont ctx seed) (lambda (tok ctx r) (cont tok ctx (cons r seed)))) ;; Block-level loop (define (block tok ctx seed) (let loop ((tok tok) (seed seed) (p '())) (if (eq? (token-type tok) 'p) (loop (next-token ctx) seed (fmt-line ctx (token-value tok) p)) (let1 seed (if (null? p) seed (cons `(p ,@(reverse! p)) seed)) (case (token-type tok) ((eof) (reverse! seed)) ((null) (block (next-token ctx) ctx seed)) ((hr) (block (next-token ctx) ctx (cons '(hr) seed))) ((open-verb) (verb ctx (>> block ctx seed))) ((open-quote) (blockquote ctx (>> block ctx seed))) ((close-quote) (reverse! seed)) ((pre) (pre tok ctx (>> block ctx seed))) ((heading) (heading (token-value tok) ctx (>> block ctx seed))) ((ul ol) (list-item tok ctx (>> block ctx seed))) ((dl) (def-item tok ctx (>> block ctx seed))) ((table) (table tok ctx (>> block ctx seed))) (else (error "internal error: unknown token type?"))))))) ;; Verbatim (define (verb ctx cont) (let loop ((line (generator)) (r '())) (if (or (eof-object? line) (equal? "}}}" line)) (cont (next-token ctx) ctx `(pre ,@(reverse! r))) (loop (generator) (list* "\n" (tree->string (expand-tab line)) r))))) ;; Preformatted (define (pre tok ctx cont) (let loop ((tok tok) (r '())) (if (eq? (token-type tok) 'pre) (loop (next-token ctx) (fmt-line ctx (tree->string (expand-tab (token-value tok))) r)) (cont tok ctx `(pre ,@(reverse! r)))))) ;; Heading (define (heading m ctx cont) (let* ((h-lev (min (h-level m) 5)) (elm (ref '(_ h2 h3 h4 h5 h6) h-lev)) (hstr (m 'after)) (new-ctx (acons elm hstr ctx))) (cont (next-token new-ctx) new-ctx `(,elm (@@ (hkey ,hstr)) ; keep this for header-id calculation ,@(reverse! (fmt-line ctx hstr '())))))) ;; Table (define (table tok ctx cont) (let loop ((tok tok) (r '())) (if (eq? (token-type tok) 'table) (loop (next-token ctx) (cons (table-row ctx (token-value tok)) r)) (cont tok ctx `(table (@ (class "inbody") (border 1) (cellspacing 0)) ,@(reverse! r)))))) (define (table-row ctx m) `(tr (@ (class "inbody")) ,@(map (lambda (seq) `(td (@ (class "inbody")) ,@(reverse! (fmt-line ctx seq '())))) (string-split (m 1) "||")))) ;; Blockquote (define (blockquote ctx cont) (let* ((new-ctx (list 'blockquote)) (r `(blockquote ,@(block (next-token new-ctx) new-ctx '())))) (cont (next-token ctx) ctx r))) ;; UL and OL (define (list-item tok ctx cont) (let* ((ltype (token-type tok)) (newctx (cons ltype ctx)) (bottom (l-level newctx))) (define (wrap tok items ctx) (if (not (memq (token-type tok) '(ul ol))) (values tok `((,(car ctx) ,@(reverse! items)))) (let ((new-level (h-level (token-value tok))) (cur-level (l-level ctx))) (cond ((< new-level bottom) (values tok `((,(car ctx) ,@(reverse! items))))) ((and (eq? (token-type tok) (car ctx)) (= new-level cur-level)) (fold-content tok ctx items)) ((> new-level cur-level) (receive (nextok r) (wrap tok '() (cons (token-type tok) ctx)) (wrap nextok (cond ((null? items) r) ((eq? (caar items) 'li) `((,(caar items) ,@(append (cdar items) r)) ,@(cdr items))) (else (append r items))) ctx))) (else (values tok (if (null? items) '() `((,(car ctx) ,@(reverse! items))))))) ))) (define (fold-content tok ctx items) (let loop ((tok (next-token ctx)) (ctx ctx) (r (fmt-line ctx ((token-value tok) 'after) '()))) (case (token-type tok) ((eof null hr heading ul ol close-quote) (wrap tok (cons `(li ,@(reverse! r)) items) ctx)) ((open-quote) (blockquote ctx (>> loop ctx r))) ((open-verb) (verb ctx (>> loop ctx r))) ((table) (table tok ctx (>> loop ctx r))) ((dl) (def-item tok ctx (>> loop ctx r))) (else (loop (next-token ctx) ctx (fmt-line ctx (token-value tok) r)))))) ;; body of list-item (receive (tok elts) (wrap tok '() newctx) (cont tok ctx (car elts))))) ;; DL (define (def-item tok ctx cont) (receive (nextok r) (def-item-rec tok ctx '()) (cont nextok ctx `(dl ,@(reverse! r))))) (define (def-item-rec tok ctx seed) (let ((dt (reverse! (fmt-line ctx ((token-value tok) 1) '()))) (dd (fmt-line ctx ((token-value tok) 2) '()))) (let loop ((tok (next-token ctx)) (p dd) (r '())) (define (fold-p) (if (null? p) r (cons `(p ,@(reverse! p)) r))) (define (finish) `((dd ,@(reverse! (fold-p))) (dt ,@dt) ,@seed)) (case (token-type tok) ((eof null hr heading) (values tok (finish))) ((dl) (def-item-rec tok ctx (finish))) ((p) (loop (next-token ctx) (fmt-line ctx (token-value tok) p) r)) ((pre) (pre tok ctx (lambda (tok ctx elt) (loop tok '() (cons elt (fold-p)))))) ((open-quote) (blockquote ctx (lambda (tok ctx elt) (loop tok '() (cons elt (fold-p)))))) ((open-verb) (verb ctx (lambda (tok ctx elt) (loop tok '() (cons elt (fold-p)))))) ((table) (table tok ctx (lambda (tok ctx elt) (loop tok '() (cons elt (fold-p)))))) ((ul ol) (if (> (h-level (token-value tok)) (l-level ctx)) (list-item tok ctx (lambda (tok ctx elt) (loop tok '() (cons elt (fold-p))))) (values tok (finish)))) (else (loop (next-token ctx) '() (fmt-line ctx (token-value tok) (fold-p)))) )))) ;; Main body (block (next-token '()) '() '()) ) ;;---------------------------------------------------------- ;; Utilities ;; (define (regexp-fold rx proc-nomatch proc-match seed line) (let loop ((line line) (seed seed)) (cond ((string-null? line) seed) ((rx line) => (lambda (m) (let ((pre (m 'before)) (post (m 'after))) (if (string-null? pre) (loop post (proc-match m seed)) (loop post (proc-match m (proc-nomatch pre seed))))))) (else (proc-nomatch line seed))) )) ;; Expands tabs in a line. (define expand-tab (let ((pads #(" " " " " " " " " " " " " " " "))) (lambda (line) (let loop ((line line) (r '()) (column 0)) (receive (before after) (string-scan line #\tab 'both) (if before (let* ((newcol (+ (string-length before) column)) (fill-to (inexact->exact (* (ceiling (/ newcol 8)) 8)))) (loop after (list* (vector-ref pads (- fill-to newcol)) before r) fill-to)) (reverse (cons line r)))))) )) ;; After "##(" is read, retrieve one expr from string. ;; Returns [Sexp, Str] (define (read-macro-expr str) (with-error-handler (lambda (e) (values #f #f)) (lambda () (let* ((s (open-input-string str)) (x (read-list #\) s))) (values x (get-remaining-input-string s)))))) (define (make-line-scanner port) (define buf #f) ;; buffer for a lookahead line (define verbatim #f) ;; flag ;; Get a physical line (define (getline) (if buf (begin0 buf (set! buf #f)) (read-line port))) (define (ungetline line) (set! buf line)) ;; Lexer body (lambda () (let rec ((line (getline)) (r '())) (cond ((eof-object? line) (if (null? r) line (string-concatenate-reverse r))) (verbatim (when (string=? "}}}" line) (set! verbatim #f)) line) ((string-prefix? ";;" line) (rec (getline) r)) ((string=? "{{{" line) (if (null? r) (begin (set! verbatim #t) line) (begin (ungetline line) (string-concatenate-reverse r)))) ((string-prefix? "~" line) (rec (getline) (cons (string-drop line 1) r))) (else (if (null? r) (rec (getline) (cons line r)) (begin (ungetline line) (string-concatenate-reverse r)))) ))) ) (provide "wiliki/parse") WiLiKi-0.6.2/src/wiliki/scr-macros.scm0000644000076400007640000001575610757143206016570 0ustar shiroshiro;; ;; Macros used in SchemeCrossReference site ;; included for the reference ;; $Id: scr-macros.scm,v 1.4 2006-04-05 12:38:20 shirok Exp $ (select-module wiliki.macro) (use srfi-1) (use srfi-13) (use util.list) ;;--------------------------------------------------------------- ;; SRFI-related macros (define-reader-macro (srfis . numbers) `((p "Implementing " ,@(wiliki:format-wikiname "SRFI") "s: " ,@(append-map (lambda (num) (cons " " (wiliki:format-wikiname #`"SRFI-,num"))) numbers)))) (define (pick-srfis-macro page-record) (cond ((#/\[\[$$srfis ([\s\d]+)\]\]/ page-record) => (lambda (m) (map x->integer (string-tokenize (m 1))))) (else #f))) (define-reader-macro (srfi-implementors-map) (let1 tab (make-hash-table 'eqv?) (wiliki:db-for-each (lambda (pagename record) (cond ((pick-srfis-macro record) => (cut map (cut hash-table-push! tab <> pagename) <>))))) (list `(table (@ (style "border-width: 0")) ,@(map (lambda (srfi-num&title) (let* ((num (car srfi-num&title)) (title (cdr srfi-num&title)) (popularity (length (hash-table-get tab num '()))) (bgcolor (case popularity ((0) "#ffffff") ((1) "#fff8f8") ((2) "#fff0f0") ((3 4) "#ffe0e0") ((5 6) "#ffcccc") ((7 8) "#ffaaaa") (else "#ff8888")))) `(tr (td (@ (style ,#`"background-color: ,bgcolor")) ,@(wiliki:format-wikiname #`"SRFI-,num") ": ") (td (@ (style ,#`"background-color: ,bgcolor")) ,title) (td (@ (style ,#`"background-color: ,bgcolor ; font-size: 60%")) ,(format "[~a implementation~a]" popularity (if (= popularity 1) "" "s")))))) *final-srfis*))))) (define-reader-macro (srfi-implementors . maybe-num) (let* ((num (x->integer (get-optional maybe-num (or (and-let* ((t (ref (wiliki-current-page) 'title)) (m (#/SRFI-(\d+)/ t))) (m 1)) "-1")))) (impls (sort (wiliki:db-fold (lambda (pagename record seed) (cond ((pick-srfis-macro record) => (lambda (srfis) (if (memv num srfis) (cons pagename seed) seed))) (else seed))) '())))) `((p "SRFI-" ,(x->string num) " is implemented in " ,@(if (null? impls) '("(none)") (append-map (lambda (impl) (cons " " (wiliki:format-wikiname impl))) impls)))))) ;;; The SRFI table below can be obtained by the following code snippet. #| (use rfc.http) (define (get-srfi-info kind) (receive (s h c) (http-get "srfi.schemers.org" #`"/,|kind|-srfis.html") (unless (string=? s "200") (errorf "couldn't retrieve ~a srfi data (~a)" kind s)) (with-input-from-string c (lambda () (reverse (port-fold (lambda (line seed) (cond ((#/SRFI (\d+)<\/A>: (.*)/ line) => (lambda (m) (acons (x->integer (m 1)) (regexp-replace-all #/<\/?\w+>/ (m 2) "") seed))) (else seed))) '() read-line)))))) |# (define *final-srfis* '((0 . "Feature-based conditional expansion construct") (1 . "List Library") (2 . "AND-LET*: an AND with local bindings, a guarded LET* special form") (4 . "Homogeneous numeric vector datatypes") (5 . "A compatible let form with signatures and rest arguments") (6 . "Basic String Ports") (7 . "Feature-based program configuration language") (8 . "receive: Binding to multiple values") (9 . "Defining Record Types") (10 . "Sharp-Comma External Form") (11 . "Syntax for receiving multiple values") (13 . "String Library") (14 . "Character-Set Library") (16 . "Syntax for procedures of variable arity") (17 . "Generalized set!") (18 . "Multithreading support") (19 . "Time Data Types and Procedures") (21 . "Real-time multithreading support") (22 . "Running Scheme Scripts on Unix") (23 . "Error reporting mechanism") (25 . "Multi-dimensional Array Primitives ") (26 . "Notation for Specializing Parameters without Currying") (27 . "Sources of Random Bits") (28 . "Basic Format Strings") (29 . "Localization") (30 . "Nested Multi-line Comments") (31 . "A special form for recursive evaluation") (34 . "Exception Handling for Programs") (35 . "Conditions") (36 . "I/O Conditions") (37 . "args-fold: a program argument processor") (38 . "External Representation for Data With Shared Structure") (39 . "Parameter objects") (40 . "A Library of Streams (deprecated)") (41 . "Streams") (42 . "Eager Comprehensions") (43 . "Vector Library") (44 . "Collections") (45 . "Primitives for expressing iterative lazy algorithms") (46 . "Basic Syntax-rules Extensions") (47 . "Array") (48 . "Intermediate Format Strings") (49 . "Indentation-sensitive syntax") (51 . "Handling rest list") (54 . " Formatting") (55 . "require-extension") (57 . "Records") (58 . "Array Notation") (59 . "Vicinity") (60 . "Integers as Bits") (61 . "A more general cond clause") (62 . "S-expression comments") (63 . "Homogeneous and Heterogeneous Arrays") (64 . "A Scheme API for test suites") (66 . "Octet Vectors") (67 . "Compare Procedures") (69 . "Basic hash tables") (70 . "Numbers") (71 . "LET-syntax for multiple values") (72 . "Simple hygienic macros") (74 . "Octet-Addressed Binary Blocks") (78 . "Lightweight testing") (86 . "MU and NU simulating VALUES & CALL-WITH-VALUES, and their related LET-syntax") (87 . "=> in case clauses") (88 . "Keyword Objects") (89 . "Optional and named parameters") (90 . "Extensible hash table constructor") (94 . "Type-Restricted Numerical Functions") (95 . "Sorting and Merging"))) ;;--------------------------------------------------------------- ;; Category macros (define-reader-macro (category . xs) `((div (@ (class category-display)) ,(format "Categor~a:" (match xs [(_) "ys"][_ "ies"])) ,@(intersperse "," (map (lambda (x) ;; we'll add link later. `(a ,x)) xs))))) WiLiKi-0.6.2/src/wiliki/macro.scm0000644000076400007640000004660611446527512015620 0ustar shiroshiro;;; ;;; wiliki/macro.scm - built-in macro definitions ;;; ;;; Copyright (c) 2000-2009 Shiro Kawai ;;; ;;; 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: macro.scm,v 1.50 2007-11-05 22:26:40 shirok Exp $ (define-module wiliki.macro (use srfi-1) (use srfi-13) (use srfi-19) (use gauche.sequence) (use gauche.parameter) (use text.html-lite) (use text.tree) (use text.gettext) (use util.list) (use util.match) (use text.csv) (use wiliki.format) (use wiliki.page) (use wiliki.core) ) (select-module wiliki.macro) ;; Delay loading some modules (autoload srfi-27 random-integer random-source-randomize! default-random-source) (autoload wiliki.pasttime how-long-since) (autoload wiliki.edit cmd-edit cmd-preview cmd-commit-edit) ;;=============================================================== ;; Writer macro definitions ;; ;;--------------------------------------------------------------- ;; $date ;; (define-writer-macro (date) (list (wiliki:format-time (sys-time)))) ;;--------------------------------------------------------------- ;; $srfi ;; ;; (this is a kind of sample) (define-writer-macro (srfi n) (format "[http://srfi.schemers.org/srfi-~a/srfi-~a.html srfi-~a]" n n n)) ;;=============================================================== ;; Reader macro definitions ;; ;;--------------------------------------------------------------- ;; $$index and $$cindex ;; (define-reader-macro (index prefix) `((ul ,@(map (lambda (key) `(li ,(wiliki:wikiname-anchor (car key)))) (wiliki:db-search (lambda (k v) (string-prefix? prefix k)) (lambda (a b) (string wiliki:format-content) (else (list #`"[[$$include ,page]]")))) ;;--------------------------------------------------------------- ;; $$img ;; (define-reader-macro (img url . maybe-alt) (define (alt) (if (null? maybe-alt) "[image]" (string-join maybe-alt " "))) (define (badimg) `((a (@ (href ,url)) ,(alt)))) (let loop ((urls (ref (wiliki)'image-urls))) (if (pair? urls) (receive (pred action) (if (pair? (car urls)) (values (caar urls) (cadar urls)) (values (car urls) 'allow)) (if (pred url) (if (eq? action 'allow) `((img (@ (src ,url) (alt ,(alt))))) (badimg)) (loop (cdr urls)))) (badimg)))) ;;--------------------------------------------------------------- ;; $$tag ;; (define-reader-macro (tag . tagnames) `((span (@ (class tag-anchor)) ,(format "Tag~a: " (match tagnames [(_) ""] [else "s"])) ,@(intersperse ", " (map (lambda (tagname) `(a (@ (href ,(wiliki:url "p=Tag:~a" tagname))) ,tagname)) tagnames))) )) ;; We cache tag search results for 1 hour, to reduce the load in case ;; the virtual page is hit by crawlers. (define-virtual-page (#/^Tag:(.*)/ (pagename tagname)) (define (get-pages) (or (and-let* ([cache (wiliki:db-raw-get (%tag-cache-name tagname) #f)] [now (sys-time)]) (match (read-from-string cache) [(timestamp . pages) (and (integer? timestamp) (> (+ timestamp 3600) now) pages)] [else #f])) (%tag-update-cache tagname))) `((h2 ,(format (gettext "Page(s) with tag ~s") tagname)) (ul ,@(map (lambda (key&attr) `(li ,@(wiliki:format-wikiname (car key&attr)) "(" ,(how-long-since (get-keyword :mtime (cdr key&attr))) " ago)")) (get-pages))) (form (@ (method POST) (action ,(wiliki:url))) ,(gettext "The list is cached and updated occasionally.") (input (@ (type hidden) (name p) (value ,pagename))) (input (@ (type hidden) (name c) (value tag-rescan))) (input (@ (type submit) (name submit) (value ,(gettext "Update cache now"))))) )) (define-wiliki-action tag-rescan :write (pagename) (rxmatch-case pagename [#/^Tag:(.*)/ (_ tagname) (%tag-update-cache tagname)] [else #f]) (wiliki:redirect-page pagename)) (define (%tag-cache-name tagname) #`" %Tag:,tagname") (define (%tag-update-cache tagname) (define (find-tag line) (rxmatch-case line [#/\[\[$$tag\s+(.*?)\]\]/ (_ args) (member tagname (or (wiliki:parse-macro-args args) '()))] [else #f])) (let* ((w (wiliki)) (pages (wiliki:db-search (lambda (key content) (and (not (string-prefix? " " key)) (wiliki:db-record-content-find w content find-tag)))))) (wiliki:with-db (cut wiliki:db-raw-put! (%tag-cache-name tagname) (write-to-string (cons (sys-time) pages))) :rwmode :write) pages)) ;;--------------------------------------------------------------- ;; $$toc ;; (define-reader-macro (toc . maybe-page) (let* ((name (get-optional maybe-page #f)) (page (if name (wiliki:db-get name #f) (wiliki-current-page)))) (if (not page) (if (pair? maybe-page) (list #`"[[$$toc ,(car maybe-page)]]") (list "[[$$toc]]")) (let1 pagename (and page (ref page 'key)) ;; MAKE-UL takes one heading entry (level . text) and tries to fit ;; it in a tree. If the entry is the same level, we accumulate ;; the heading entries to ITEMS. If the entry is deeper than the ;; current, we recurse into the deeper level but uses CPS to continue ;; the current level after the lower levels are collected. ;; NB: hs is a _reverse_ ordered list of all headings (level . text). ;; Since it's reversed, we can scan forward to find the heading ;; nesting. (define (make-ul hs cur items cont) (cond ((null? hs) (cont '() `(ul ,@items))) ((= (caar hs) cur) ;; same level (make-ul (cdr hs) cur (cons (make-anchor (nestings hs)) items) cont)) ((> (caar hs) cur) ;; deeper level (make-ul hs (+ cur 1) '() (lambda (hs ul) (make-ul hs cur (cons ul items) cont)))) (else ;; we finished the current level and under. pass ;; the result to the continuation proc. (cont hs `(ul ,@items))))) (define (nestings hs) (reverse! (cdr (fold (lambda (elt seed) (let ((level (car elt)) (cur-level (car seed))) (if (< level cur-level) (list* level (cdr elt) (cdr seed)) seed))) '(6) hs)))) (define (make-anchor headings) (let ((id (wiliki:calculate-heading-id headings))) `(li (a (@ (href ,#`",(wiliki:url \"~a\" pagename)#,id")) ,@(wiliki:format-line-plainly (car headings)))))) (let1 headings (wiliki:page-lines-fold page (lambda (l r) (cond ((#/^(\*{1,}) / l) => (lambda (m) (acons (string-length (m 1)) (m 'after) r))) (else r))) '() :follow-includes? #t :skip-verbatim? #t) (make-ul headings 1 '() (lambda (_ ul) (list ul)))) )))) ;;--------------------------------------------------------------- ;; $$breadcrumb-links ;; (define-reader-macro (breadcrumb-links . opts) (let-optionals* opts ((name #f) (delim ":")) (let1 page (if name (wiliki:db-get name #f) (wiliki-current-page)) (if (not page) (if name (list #`"[[$$breadcrumb-links ,(car opts)]]") (list "[[$$breadcrumb-links]]")) (wiliki:breadcrumb-links page delim))))) ;;--------------------------------------------------------------- ;; $$testerr ;; (define-reader-macro (testerr . x) (error (x->string x))) ;;--------------------------------------------------------------- ;; $$comment ;; ;; Comment macro. This is an example of combining reader macro ;; and custom command. ;; ;; We store each individual comment to a separate page, so that ;; the incomplete markup won't mess up the rest of the page. ;; The comment pages are named as "|comment:::", where ;; identifies the comment chunk; the default of is the ;; name of the page the comment macro is attached. To put more than ;; one comment form on a page, unique id must be provided by the ;; macro argument. ;; ;; We also take some caution to the dumb automated spammers. ;; First, we place multiple textareas in the form, all but one ;; of which is hidden by CSS. If anything is written in the hidden ;; textarea we just discard the post. This might not be friendly ;; to non-CSS-aware browsers, though; if it becomes a problem, we might ;; consider putting a message. We also include a timestamp in the ;; form and check if its value is in reasonable range. These can be ;; easily beaten by determined spammers, but I bet almost all of them ;; won't bother to do that much. ;; ;; The optional arguments can be provided in key:value form, like this: ;; [[$$comment id:foo order:new->old textarea:bottom]] ;; The accepted keys: ;; id: Specifies the alternate id to group the comment. The default ;; is the key value of the page where the macro is put. ;; order: Specifies the sort order of existing comments. Either ;; old->new (chronologically) or new->old (reverse chronologically). ;; textarea: The position of the textarea to post the new comments. ;; Either "top", "bottom", or "none" (do not allow adding comments). (define-reader-macro (comment . opts) (let-macro-keywords* opts ((id (and-let* ([p (wiliki-current-page)]) (ref p'key))) (order "old->new") (textarea "bottom")) ;; argument check (unless (member order '("old->new" "new->old")) (error "$$comment: Invalid 'order' argument (must be either old->new or new->old):" order)) (unless (member textarea '("bottom" "top" "none")) (error "$$comment: Invalid 'textarea' argument (must be either one of bottom, top or none):" textarea)) (cond [(not id) '()] [(wiliki:current-page-being-included?) ;; If the page that contains $$comment macro is included in ;; another page, we only show the summary. (comment-summary id)] [else (comment-input-and-display id order textarea)]))) (define (comment-input-and-display id order textarea) (random-source-randomize! default-random-source) (let* ((rkey (+ (random-integer #x10000000) 1)) ; never be 0 (answer (modulo (ash rkey -11) 3)) (prefix (comment-prefix id)) (sorter (if (equal? order "old->new") string?)) ;; NB: sort procedure assumes we have up to 1000 comments. (comment-pages (wiliki:db-search (lambda (k v) (string-prefix? prefix k)) (lambda (a b) (sorter (car a) (car b))))) (timestamp (sys-time)) ) (define (past-comments) (parameterize ((wiliki:reader-macros '())) (append-map (lambda (p) (wiliki:get-formatted-page-content (car p))) comment-pages))) (define (st x) (if (= x answer) '(class "comment-area") '(style "display: none"))) (define (show-textarea) (if (memq (ref (wiliki)'editable?) '(limited #t)) `((p (@(class "comment-caption")) ,(gettext "Post a comment")) (form (@ (action "") (method "POST")) (input (@ (type hidden) (name "c") (value "post-comment"))) (input (@ (type hidden) (name "p") (value ,(ref (wiliki-current-page)'key)))) (input (@ (type hidden) (name "cid") (value ,id))) (input (@ (type hidden) (name "rkey") (value ,rkey))) (input (@ (type hidden) (name "t") (value ,timestamp))) (table (@ (class "comment-input")) (tr (td ,(gettext"Name: ") (input (@ (type text) (name "n"))))) (tr (td (textarea (@ ,(st 0) (name "c0"))) (textarea (@ ,(st 1) (name "c1"))) (textarea (@ ,(st 2) (name "c2"))))) (tr (td (input (@ (type submit) (name "submit") (value ,(gettext"Submit Comment")))))) ))) '())) (define (show-past-comments) (if (null? comment-pages) '() `((p (@(class"comment-caption")),(gettext "Past comment(s)")) (div (@(class"comment-past")) ,@(past-comments))))) `((div (@ (class "comment")) (a (@(name ,prefix))) ,@(if (equal? textarea "top") (show-textarea) '()) ,@(show-past-comments) ,@(if (equal? textarea "bottom") (show-textarea) '()))) )) (define (comment-summary id) (let* ((prefix (comment-prefix id)) (num-comments (length (wiliki:db-search (lambda (k v) (string-prefix? prefix k))))) ) `((div (@ (class "comment")) (p (@ (class "comment-summary")) (a (@ (href ,(wiliki:url "~a#~a" (ref (wiliki-current-page)'key) prefix))) ,(format "Comment~a (~a)" (if (= num-comments 1) "" "s") num-comments))))) )) (define (comment-prefix id) #`"|comments:,|id|::") (define-wiliki-action post-comment :write (pagename (cid :convert wiliki:cv-in) (rkey :convert x->integer) (t :convert x->integer) ; timestamp (n :convert wiliki:cv-in :default "") ; name (c0 :convert wiliki:cv-in :default "") (c1 :convert wiliki:cv-in :default "") (c2 :convert wiliki:cv-in :default "")) ;; Pick the valid textarea contents. If there's any text in the ;; dummy textarea, we assume it is from automated spammer. (define (get-legal-post-content) (and-let* (( (> rkey 0) ) (answer (modulo (ash rkey -11) 3))) (fold (lambda (content n r) (cond ((= n answer) content) ((equal? content "") r) (else #f))) #f (list c0 c1 c2) (iota 3)))) ;; See cmd-commit-edit in edit.scm; probably we should consolidate ;; those heuristic spam filtering into one module. (define (filter-suspicious content) (cond [(or (not (string? content)) (#/ (string-size content) 250) (let1 p (/. (string-size (regexp-replace-all* content #/http:\/\/[:\w\/%&?=.,+#-]+/ "" #/[\t-@\[-^`\{-\x7f]/ "")) (string-size content)) (and (< p 0.24) p))) => (lambda (p) (wiliki:log-event "too much urls in comment (ratio=~a)" p) #f)] ;; See if there are too many URLs (we should allow many URLs in ;; the main content, but for the comment, we may say it's too ;; suspicious.) [(let1 c (length (string-split content #/http:\/\/[:\w\/%&?=.,+#-]+/)) (and (> c 12) c)) => (lambda (c) (format "too many urls in comment (~a)" (- c 1)) #f)] [else content])) ;; Find maximum comment count (define (max-comment-count) (let1 rx (string->regexp #`"^,(regexp-quote (comment-prefix cid))(\\d+)$") (wiliki:db-fold (lambda (k v maxval) (cond [(rx k) => (lambda (m) (max maxval (x->integer (m 1))))] [else maxval])) -1))) (define (do-post) (and-let* ([ (> (string-length n) 0) ] [now (sys-time)] [ (< (- now 7200) t now) ] [content (filter-suspicious (get-legal-post-content))] [ (> (string-length content) 0) ] [cnt (+ (max-comment-count) 1)] [comment-page (format "~a~3'0d" (comment-prefix cid) cnt)]) ;; ignore the result of cmd-commit-edit. we'll redirect to the ;; main page anyway. (cmd-commit-edit comment-page (string-append "* "n" (" (sys-strftime "%Y/%m/%d %T" (sys-localtime now)) "):\n<<<\n"content"\n>>>\n") t "" #t #t) ;; cmd-commit-edit may reject creating comment page if it thinks ;; the content is spam. See if comment page is actually created. (when (wiliki:db-exists? comment-page) (wiliki:db-touch! pagename)))) (do-post) (wiliki:redirect-page pagename)) ;;=============================================================== ;; Virtual page definitions ;; (define-virtual-page (#/^RecentChanges$/ (_)) `((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-virtual-page (#/^\|comments:(.*)(?!::\d+$)/ (_ p)) `((p "See " ,@(wiliki:format-wikiname p)))) (provide "wiliki/macro") WiLiKi-0.6.2/src/wiliki/pasttime.scm0000644000076400007640000000474711157576011016342 0ustar shiroshiro;;; ;;; wiliki/pasttime - how long has it been passed since ...? ;;; ;;; Copyright (c) 2000-2009 Shiro Kawai ;;; ;;; 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: pasttime.scm,v 1.3 2003-08-30 12:28:00 shirok Exp $ ;;; (define-module wiliki.pasttime (export how-long-since)) (select-module wiliki.pasttime) ;; Multilingualizaton of this module is tricky, as the rules of ;; forming plurals are different from language to language. ;; See GNU's gettext document for the problem. ;; For now, I only support English. (define-constant secs-in-a-year 31557600) (define-constant secs-in-a-month 2629800) (define-constant secs-in-a-day 86400) (define-constant secs-in-an-hour 3600) (define-constant secs-in-a-minute 60) (define (how-long-since time . opts) (define (pl num unit) (format "~a ~a~a" num unit (if (= num 1) "" "s"))) (let-optionals* opts ((now (sys-time))) (let ((diff (- now time))) (cond ((>= diff secs-in-a-year) (pl (quotient diff secs-in-a-year) "year")) ((>= diff secs-in-a-month) (pl (quotient diff secs-in-a-month) "month")) ((>= diff secs-in-a-day) (pl (quotient diff secs-in-a-day) "day")) ((>= diff secs-in-an-hour) (pl (quotient diff secs-in-an-hour) "hour")) ((>= diff secs-in-a-minute) (pl (quotient diff secs-in-a-minute) "minute")) (else (pl diff "second"))) ))) (provide "wiliki/pasttime") WiLiKi-0.6.2/src/wiliki/page.scm0000644000076400007640000001102411317641621015410 0ustar shiroshiro;;; ;;; wiliki/page.scm - wiliki page structure ;;; ;;; Copyright (c) 2003-2009 Shiro Kawai ;;; ;;; 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: page.scm,v 1.5 2007-10-11 21:52:26 shirok Exp $ (define-module wiliki.page (use srfi-1) (use gauche.parameter) (use util.match) (export wiliki:current-page wiliki:page-circular? wiliki:current-page-being-included? wiliki:current-root-page wiliki:page-stack ;; for backward compatibility wiliki-page-stack wiliki-current-page wiliki-page-circular? ) ) (select-module wiliki.page) ;;================================================================== ;; Class ;; Represents a page. ;; ;; persistent page: a page that is (or will be) stored in DB. ;; - has 'key' value. ;; - if mtime is #f, it is a freshly created page before saved. ;; transient page: other pages created procedurally just for display. ;; - 'key' slot has #f. (define-class () (;; title - Page title. For persistent pages, this is set to ;; the same value as the database key. (title :init-value #f :init-keyword :title) ;; key - Database key. For transient pages, this is #f. (key :init-value #f :init-keyword :key) ;; command - A URL parameters to reproduce this page. Only meaningful ;; for transient pages. (command :init-value #f :init-keyword :command) ;; extra-head-elements - List of SXML to be inserted in the head element ;; of output html. ;; Useful to add meta info in the auto-generated pages. (extra-head-elements :init-value '() :init-keyword :extra-head-elements) ;; content - Either a wiliki-marked-up string or SXML. ;; wiliki:format-content may replace a marked-up string for SXML. (content :init-value "" :init-keyword :content) ;; creation and modification times, and users (users not used now). (ctime :init-value (sys-time) :init-keyword :ctime) (cuser :init-value #f :init-keyword :cuser) (mtime :init-value #f :init-keyword :mtime) (muser :init-value #f :init-keyword :muser) )) ;;================================================================== ;; Page rendering tracking ;; (define wiliki:page-stack (make-parameter '())) ;; Returns the currently being rendered. Note that it is ;; only effective during wiliki:format-content. (define (wiliki:current-page) (let1 hist (wiliki:page-stack) (if (null? hist) #f (car hist)))) ;; Returns true if rendering PAGE would cause an infinite loop. (define (wiliki:page-circular? page) (member page (wiliki:page-stack) (lambda (p1 p2) (and p1 p2 (ref p1 'key) (ref p2 'key) (string=? (ref p1 'key) (ref p2 'key)))))) ;; Returns if the current page is rendered because it is included ;; by some other page. (define (wiliki:current-page-being-included?) (let1 hist (wiliki:page-stack) (and (pair? hist) (pair? (cdr hist))))) ;; Returns the current 'root' page, i.e. the outermost page being ;; rendered. If no $$include is happening, the current page is the ;; current root page. (define (wiliki:current-root-page) (let1 hist (wiliki:page-stack) (if (null? hist) #f (car (last-pair hist))))) ;; ;; For backward compatibility ;; (define wiliki-page-stack wiliki:page-stack) (define wiliki-current-page wiliki:current-page) (define wiliki-page-circular? wiliki:page-circular?) (provide "wiliki/page") WiLiKi-0.6.2/src/wiliki/auth.scm0000644000076400007640000001256711365112705015451 0ustar shiroshiro;;; ;;; wiliki.auth ;;; ;;; Copyright (c) 2010 Shiro Kawai ;;; ;;; 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: core.scm,v 1.10 2007-12-21 12:00:36 shirok Exp $ ;;; ;; ;; Simple authentication for WiLiKi. ;; ;; Login is handled by a separate cgi script (customary named 'login'), ;; which sets up a session token in the cookie. ;; ;; Session token is saved under a file /tmp/wiliki-*. ;; ;; Wiliki script can check the validity of the token via auth-check-session. (define-module wiliki.auth (use gauche.parameter) (use crypt.bcrypt) (use file.util) (use util.match) (use srfi-13) (export auth-db-path auth-valid-password? auth-change-password auth-new-user auth-new-session auth-get-session auth-delete-session auth-clean-sessions)) (select-module wiliki.auth) (define-condition-type #f) ;;; ;;; Password management ;;; (define-constant +min-password-length+ 8) (define-constant +max-password-length+ 40) (define auth-db-path (make-parameter #f)) (define (%check-db-path) (unless (auth-db-path) (error "password file pathname isn't set"))) (define (read-passwd-file) (%check-db-path) (or (file->sexp-list (auth-db-path) :if-does-not-exist #f) '())) (define (write-passwd-file db) (%check-db-path) (receive (port path) (sys-mkstemp (auth-db-path)) (guard ([e (else (sys-unlink path) (raise e))]) (dolist [entry db] (write entry port) (newline port)) (close-output-port port) (sys-rename path (auth-db-path))))) (define (auth-valid-password? user pass) (%check-db-path) (and-let* ([p (assoc user (read-passwd-file))]) (equal? (cadr p) (bcrypt-hashpw pass (cadr p))))) (define (%user-pass-check user pass) (unless (string? user) (error "username must be a string, but got" user)) (unless (string? pass) (error "password must be a string")) (unless (<= +min-password-length+ (string-length pass) +max-password-length+) (errorf "password must have at least ~a characters, \ and can have at most ~a characters." +min-password-length+ +max-password-length+)) (unless (string-every (cut char-set-contains? #[[:graph:]] <>) pass) (error "password can only contain ascii graphical characters [!-~]"))) ;; todo: lock (define (auth-new-user user pass) (%check-db-path) (%user-pass-check user pass) (let1 db (read-passwd-file) (when (assoc user db) (errorf "user ~a already exists" user)) (write-passwd-file `((,user ,(bcrypt-hashpw pass)) ,@db)))) ;; todo: lock (define (auth-change-password user pass) (%check-db-path) (%user-pass-check user pass) (let1 db (read-passwd-file) (cond [(assoc user db) => (lambda (p) (set! (cadr p) (bcrypt-hashpw pass)) (write-passwd-file db))] [else (errorf "user ~a does not exist" user)]))) ;;; ;;; Session management ;;; (define (auth-new-session value) (receive (port path) (sys-mkstemp (build-path (temporary-directory) "wiliki-")) (guard [e (else (close-output-port port) (sys-unlink path) (raise e))] (let* ([key (string-take-right path 6)] [hv (bcrypt-hashpw key)]) (write `(,hv ,value) port) (close-output-port port) (string-append key hv))))) (define (auth-get-session key) (when (< (string-length key) (+ 6 7)) (error "invalid session key")) (let* ([suffix (string-take key 6)] [hv (string-drop key 6)] [path (build-path (temporary-directory) #`"wiliki-,suffix")]) (call-with-input-file path (lambda (p) (or (and p (match (read p) [((? (cut string=? hv <>)) value) (touch-file path) value] [_ #f])) (error "invalid or expired session"))) :if-does-not-exist #f))) (define (auth-delete-session key) (and (>= (string-length key) 6) (sys-unlink (build-path (temporary-directory) #`"wiliki-,(string-take key 6)")))) (define (auth-clean-sessions age) (let1 limit (- (sys-time) age) (dolist [f (glob (build-path (temporary-directory) "wiliki-??????"))] (when (< (file-mtime f) limit) (sys-unlink f))))) WiLiKi-0.6.2/src/wiliki/history.scm0000644000076400007640000002332111157576011016202 0ustar shiroshiro;;; ;;; wiliki/history - handles history and diff page ;;; ;;; Copyright (c) 2000-2009 Shiro Kawai ;;; ;;; 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: history.scm,v 1.22 2007-11-05 22:26:40 shirok Exp $ ;;; (select-module wiliki) (use util.lcs) (define-constant HISTORY_SIZE 25) ;; # of histories per page ;; "Edit History" page. --------------------------------------- (define (cmd-history pagename start-count) (define (row-bg cnt) (if (even? cnt) "background-color:#ffffff" "background-color:#f0f0f8")) (define (td cnt a . c) `(td (@ (class "history_td") (style ,#`",(row-bg cnt); color:#000000") ,@a) ,@c)) (define (tdr cnt a . c) `(td (@ (class "history_td") (style ,#`",(row-bg cnt); color:#000000; text-align:right") ,@a) ,@c)) (define (th a . c) `(th (@ (class "history_th") (style "background-color:#ccccff; color:#000000") ,@a) ,@c)) (define (diff-to-prev entry prev-timestamp) `(a (@ (href ,(url "p=~a&c=hd&t=~a&t1=~a" (cv-out pagename) prev-timestamp (ref entry 'timestamp)))) "previous")) (define (diff-to-current entry) `(a (@ (href ,(url "p=~a&c=hd&t=~a" (cv-out pagename) (ref entry 'timestamp)))) "current")) (define (history-table-row first entry prev-timestamp cnt) `((tr ,(td cnt '((rowspan 2)) (wiliki:format-time (ref entry 'timestamp))) ,(td cnt '() (format "+~a -~a line(s)" (length (ref entry 'added-lines)) (length (ref entry 'deleted-lines)))) ,(apply tdr cnt '() "[" `(a (@ (href ,(url "p=~a&c=hv&t=~a" (cv-out pagename) (ref entry 'timestamp)))) "View") `(span ,@(cond-list [(eq? (ref (wiliki)'editable?) #t) `(span "|" (a (@ (href ,(url "p=~a&c=e&t=~a" (cv-out pagename) (ref entry 'timestamp)))) "Edit"))])) " this version] " (if (and (zero? start-count) (eq? first entry)) `("[Diff to ",(diff-to-prev entry prev-timestamp)"]") `("[Diff to ",(diff-to-current entry) "|",(diff-to-prev entry prev-timestamp)"]")))) (tr ,(td cnt '((colspan 2)) (let1 l (ref entry 'log-message) (cond ((or (not l) (equal? l "")) "*** no log message ***") ((> (string-length l) 80) (string-take l 80)) (else l)))) ))) (define (history-table entries end?) `(table (@ (width "90%")) (tr ,(th '((rowspan 2)) "Timestamp") ,(th '() "Changes") ,(th '() "Operations")) (tr ,(th '((colspan 2)) "Log")) ,@(if (not (null? entries)) (append-map (cut history-table-row (car entries) <> <> <>) (take* entries HISTORY_SIZE) (fold-right (lambda (e r) (cons (ref e 'timestamp) r)) '(0) (drop* entries 1)) (iota (length entries))) '()) (tr ,(tdr HISTORY_SIZE '((colspan 4)) "[" (if end? `(a (@ (href ,(url "p=~a&c=hd&t=0" (cv-out pagename)))) "Diff from epoch") `(a (@ (href ,(url "p=~a&c=h&s=~a" (cv-out pagename) (+ start-count HISTORY_SIZE)))) "Older histories...")) "]")))) (html-page (make :title ($$ "Edit History") :extra-head-elements '((meta (@ (name "robots") (content "noindex,nofollow")))) :content (or (and-let* ((logfile (wiliki:log-file-path (wiliki))) (logs (wiliki-log-pick-from-file pagename logfile)) (picked (take* (if (= start-count 0) logs (drop* logs start-count)) (+ HISTORY_SIZE 1))) ( (not (null? picked)) ) ) `((h2 (stree ,(format ($$ "Edit history of ~a") (wiliki:wikiname-anchor-string pagename)))) ,(history-table (map wiliki-log-parse-entry picked) (< (length picked) (+ HISTORY_SIZE 1))))) (no-history-info pagename))) )) ;; "Edit History:Diff" page. ----------------------------------- (define (cmd-diff pagename old-time new-time) (define (explanation) `(ul (li ,(wiliki:format-diff-line `(+ . ,($$ "added lines")))) (li ,(wiliki:format-diff-line `(- . ,($$ "deleted lines")))))) (define (diff-to-current entries current) (let* ((diffpage (wiliki-log-diff* entries current))) `((h2 (stree ,(format ($$ "Changes of ~a since ~a") (wiliki:wikiname-anchor-string pagename) (wiliki:format-time old-time)))) ,(explanation) ,(return-to-edit-history pagename) ,(wiliki:format-diff-pre diffpage)))) (define (diff2 entries current) (let* ((oldpage (wiliki-log-revert* entries current)) (newpage (wiliki-log-revert* (take-while (lambda (e) (< new-time (ref e 'timestamp))) entries) current)) (rdiff (lcs-fold (cut acons '- <> <>) (cut acons '+ <> <>) cons '() oldpage newpage))) `((h2 (stree ,(format ($$ "Changes of ~a between ~a and ~a") (wiliki:wikiname-anchor-string pagename) (wiliki:format-time old-time) (wiliki:format-time new-time)))) ,(explanation) ,(return-to-edit-history pagename) ,(wiliki:format-diff-pre (reverse! rdiff))))) (html-page (make :title ($$ "Edit History:Diff") :extra-head-elements '((meta (@ (name "robots") (content "noindex,nofollow")))) :content (or (and-let* ((logfile (wiliki:log-file-path (wiliki))) (page (wiliki:db-get pagename)) (picked (wiliki-log-pick-from-file pagename logfile))) (let ((entries (wiliki-log-entries-after picked old-time))) (if (>= old-time new-time) (diff-to-current entries (ref page 'content)) (diff2 entries (ref page 'content))))) (no-history-info pagename))) )) ;; "Edit History:View" page. ----------------------------------- (define (cmd-viewold pagename old-time) (html-page (make :title ($$ "Edit History:View") :extra-head-elements '((meta (@ (name "robots") (content "noindex,nofollow")))) :content (or (and-let* ((logfile (wiliki:log-file-path (wiliki))) (page (wiliki:db-get pagename)) (reverted (wiliki-log-recover-content pagename logfile (ref page 'content) old-time))) `((h2 (stree ,(format ($$ "Content of ~a at ~a") (wiliki:wikiname-anchor-string pagename) (wiliki:format-time old-time)))) (p (@ (style "text-align:right")) (a (@ (href ,(url "~a&c=hd&t=~a" (cv-out pagename) old-time))) ,($$ "View diff from current version"))) ,@(cond-list [(eq? (ref (wiliki)'editable?) #t) `(p (@ (style "text-align:right")) (a (@ (href ,(url "~a&c=e&t=~a" (cv-out pagename) old-time))) ,($$ "Edit this version")))]) ,(return-to-edit-history pagename) ,(wiliki:format-diff-pre reverted))) (no-history-info pagename))) )) (define (no-history-info pagename) `((p (stree ,(format ($$ "No edit history available for page ~a") (wiliki:wikiname-anchor-string pagename)))))) (define (return-to-edit-history pagename) `(p (@ (style "text-align:right")) (a (@ (href ,(url "~a&c=h" (cv-out pagename)))) ,($$ "Return to the edit history")))) (provide "wiliki/history") WiLiKi-0.6.2/src/wiliki/rss.scm0000644000076400007640000001466411323257325015321 0ustar shiroshiro;;; ;;; wiliki/rss - an ad-hoc RSS generation routine for WiLiKi ;;; ;;; Copyright (c) 2000-2009 Shiro Kawai ;;; ;;; 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: rss.scm,v 1.9 2007-05-02 13:02:44 shirok Exp $ ;;; ;; In future, this might be rewritten to use proper XML framework. ;; for now, I use an ad-hoc approach. (define-module wiliki.rss (use gauche.parameter) (use gauche.experimental.app) (use wiliki.core) (use file.util) (use util.list) (use util.match) (use text.html-lite) (use text.tree) (export rss-page rss-item-count rss-item-description rss-partial-content-lines rss-source rss-url-format)) (select-module wiliki.rss) ;; Parameters ;; # of items included in the RSS (define rss-item-count (make-parameter 15)) ;; What to include in the 'rdf:description' of each item. ;; none - omit rdf:description ;; raw - raw wiki-marked up text. ;; html - html rendered text. (heavy) (define rss-item-description (make-parameter 'none)) ;; # of maximum lines in the original wiki format to be included ;; in the partial content (raw-partial, html-partial). (define rss-partial-content-lines (make-parameter 20)) ;; A procedure that takes maximum # of entries, and returns a list ;; of entries to be included in the RSS. The returned list should be ;; in the following form: ;; : ( ...) ;; : ( . ) | (( . ) . <timestamp>) (define rss-source (make-parameter (cut wiliki:recent-changes-alist :length <>))) ;; Whether the url in RSS should be in the format of url?key or url/key (define rss-url-format (make-parameter 'query)) ;; Main entry (define (rss-page :key (count (rss-item-count)) (item-description #f)) (rss-format ((rss-source) count) (case (or item-description (rss-item-description)) [(raw) (cut raw-content <> #f)] [(raw-partial) (cut raw-content <> #t)] [(html) (cut html-content <> #f)] [(html-partial) (cut html-content <> #t)] [else (lambda (e) "")]))) (define (rss-format entries item-description-proc) (let* ((self (wiliki)) (full-url (wiliki:url :full))) `("Content-type: text/xml\n\n" "<?xml version=\"1.0\" encoding=\"" ,(wiliki:output-charset) "\" ?>\n" "<rdf:RDF xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\" xmlns=\"http://purl.org/rss/1.0/\" xmlns:dc=\"http://purl.org/dc/elements/1.1/\" xmlns:content=\"http://purl.org/rss/1.0/modules/content/\" >\n" ,(rdf-channel (wiliki:url :full) (rdf-title (ref (wiliki)'title)) (rdf-link full-url) (rdf-description (ref (wiliki)'description)) (rdf-items-seq (map (lambda (e) (rdf-li (entry->url e))) entries))) ,(map (lambda (e) (let1 url (entry->url e) (rdf-item url (rdf-title (entry->title e)) (rdf-link url) (item-description-proc (entry->key e)) (dc-date (entry->timestamp e))))) entries) "</rdf:RDF>\n"))) (define (raw-content entry partial?) (or (and-let* ([page (wiliki:db-get entry)]) (rdf-description (trim-content (ref page 'content) partial?))) "")) (define (html-content entry partial?) (or (and-let* ([page (wiliki:db-get entry)]) ($ rdf-content $ tree->string $ map wiliki:sxml->stree $ wiliki:format-content (trim-content (ref page'content) partial?))) "")) (define (trim-content raw-text partial?) (if partial? (string-join (take* (string-split raw-text "\n") (rss-partial-content-lines)) "\n") raw-text)) (define (entry->url entry) (case (rss-url-format) [(query) (wiliki:url :full "~a" (entry->key entry))] [(path) (build-path (wiliki:url :full) (entry->key entry))] [else (wiliki:url :full "config-error:invalid-rss-url-format")])) (define (entry->title entry) (match entry [((key . title) . _) title] [(key . _) key])) (define (entry->key entry) (match entry [((key . title) . _) key] [(key . _) key])) (define (entry->timestamp entry) (cdr entry)) ;; RDF rendering utilities. ;; NB: these should be implemented within xml framework (define (rdf-channel about . content) `("<channel rdf:about=\"" ,(html-escape-string about) "\">" ,@content "\n</channel>\n")) (define (rdf-li resource) `("<rdf:li rdf:resource=\"" ,(html-escape-string resource) "\" />\n")) (define (rdf-simple tag . content) `("<" ,tag ">" ,@content "</" ,tag ">\n")) (define (rdf-item about . content) `("<item rdf:about=\"" ,(html-escape-string about) "\">" ,@content "</item>\n")) (define (rdf-items-seq . items) `("<items><rdf:Seq>" ,@items "</rdf:Seq></items>\n")) (define (rdf-simple-1 tag content) `("<" ,tag ">" ,(html-escape-string content) "</" ,tag ">\n")) (define (rdf-title title) (rdf-simple-1 "title" title)) (define (rdf-link link) (rdf-simple-1 "link" link)) (define (rdf-description desc) (rdf-simple-1 "description" desc)) (define (rdf-content content) `("<content:encoded><![CDATA[" ,(regexp-replace-all #/\]\]>/ content "&93;]>") "]]></content:encoded>")) (define (dc-date secs) (rdf-simple-1 "dc:date" (sys-strftime "%Y-%m-%dT%H:%M:%S+00:00" (sys-gmtime secs)))) (provide "wiliki/rss") ����������������������������������������������������������������������������WiLiKi-0.6.2/src/wiliki/log.scm���������������������������������������������������������������������0000644�0000764�0000764�00000045256�11157576011�015275� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; ;;; wiliki/log.scm - logging & history management ;;; ;;; Copyright (c) 2003-2009 Shiro Kawai <shiro@acm.org> ;;; ;;; 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: log.scm,v 1.12 2007-07-14 05:33:20 shirok Exp $ (define-module wiliki.log (use srfi-1) (use srfi-11) (use srfi-13) (use util.lcs) (use util.queue) (use util.list) (use text.diff) (export <wiliki-log-entry> 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 ) ) (select-module wiliki.log) ;; When wiliki's 'logfile' slot contains a file name, wiliki writes out ;; a commit log to it when any changes are done. ;; Each entry of commit log is like follows: ;; ;; C "PageName" 1061764351 "127.0.0.1" ;; L deleted redundant lines, ;; L and added more descriptions ;; A10-15,17,19-21 ;; D10 aaaaaaa ;; D11 bbbbbbb ;; D17 ccccccc ;; . ;; ;; The line begins with #\C records the pagename, time, and ;; IP address of the committer. ;; The lines begin with #\L records the log message, if any. ;; The line begins with #\A records the line numbers ;; that are added by this commit. The line numbers are of the ;; edited version, and counts from 1. ;; The lines begin with #\D are deleted lines by this commit. ;; The line numbers are of the version before editing, and counts from 1. ;; The commit record ends with ".". C, L, A and D lines appear ;; in this order. L, A and D lines may be omitted if there's no ;; relevant information. There won't be multiple A lines. ;; ;; I don't use S-expr here. Since the log file is a plain text, ;; there may be a chance that it is corrupted. It'd be difficult ;; to recover information from a chopped S-expr. ;; A convenience structure (define-class <wiliki-log-entry> () ((pagename :init-value #f) (timestamp :init-value 0) (remote-addr :init-value #f) (remote-user :init-value #f) (log-message :init-value "") (added-lines :init-value '()) ;; list of added line numbers (deleted-lines :init-value '()) ;; alist of deleted lines )) ;; Create a log entry and returns the string. ---------------------- ;; This function doesn't use <wiliki-log-entry> structure. (define (wiliki-log-create pagename new old . args) (let-keywords* args ((timestamp (sys-time)) (message "") (remote-addr "") (remote-user "") (info "")) (with-output-to-string (cut with-port-locking (current-output-port) (lambda () (format #t "C ~s ~s ~s ~s~%" pagename timestamp remote-addr remote-user) (for-each (cut print "L " <>) (call-with-input-string message port->string-list)) (emit-edit-list new old) (print ".")))) )) ;; Emit an edit list (define (emit-edit-list new old) (define new-cnt 1) (define old-cnt 1) (define add-lines '()) (define del-lines '()) (define (register line type) (case type ((-) (push! add-lines new-cnt) (inc! new-cnt)) ((+) (push! del-lines (cons old-cnt line)) (inc! old-cnt)) (else (inc! new-cnt) (inc! old-cnt)))) (diff-report new old :writer register) (unless (null? add-lines) (print "A" (string-join (map (lambda (elt) (if (number? elt) (x->string elt) #`",(car elt)-,(cadr elt)")) (compact-ordinal-list (reverse! add-lines))) ","))) (unless (null? del-lines) (for-each (lambda (elt) (print "D" (car elt) " " (cdr elt))) (reverse! del-lines))) ) ;; Picks entries of the specified pagename --------------- ;; Returns a list of entries, where each entry is just ;; a list of lines. The entries are in reverse chronological order. (define (wiliki-log-pick pagename iport) (define pick-prefix (format "C ~s" pagename)) (define entries '()) (with-port-locking iport (lambda () (port-fold (lambda (line acc) (cond ((string=? "." line) (when acc (push! entries (reverse! (cons "." acc)))) #f) ((string-prefix? "C " line) (when acc (push! entries (reverse! acc))) (if (string-prefix? pick-prefix line) (list line) #f)) (acc (cons line acc)) (else #f))) #f (cut read-line iport)))) entries) (define (wiliki-log-pick-from-file pagename filename) (call-with-input-file filename (lambda (p) (and p (wiliki-log-pick pagename p))) :if-does-not-exist #f)) ;; Parses picked entry and returns <wiliki-log-entry> structure --- (define (wiliki-log-parse-entry entry-lines) (define entry (make <wiliki-log-entry>)) (define l-lines '()) (define d-lines '()) (dolist (line entry-lines) (cond ((string-prefix? "C " line) (let1 l (read-from-string #`"(,line)") (set! (ref entry 'pagename) (ref l 1)) (set! (ref entry 'timestamp) (ref l 2)) (set! (ref entry 'remote-addr) (ref l 3)) (set! (ref entry 'remote-user) (ref l 4)))) ((string-prefix? "L " line) (push! l-lines (string-drop line 2))) ((string-prefix? "A" line) (set! (ref entry 'added-lines) (uncompact-ordinal-list (map (lambda (elt) (rxmatch-case elt (#/(\d+)-(\d+)/ (#f s e) (map x->integer `(,s ,e))) (else (x->integer elt)))) (string-split (string-drop line 1) #\,))))) ((#/^D(\d+) / line) => (lambda (m) (push! d-lines (cons (x->integer (m 1)) (m 'after))))) )) (set! (ref entry 'log-message) (string-join (reverse! l-lines) "\n")) (set! (ref entry 'deleted-lines) (reverse! d-lines)) entry) ;; returns list of entries after the specified date, from picked entries (define (wiliki-log-entries-after picked time) (let loop ((picked picked) (r '())) (if (null? picked) (reverse! r) (let1 e (wiliki-log-parse-entry (car picked)) (if (<= (ref e 'timestamp) time) (reverse! r) (loop (cdr picked) (cons e r))))))) ;; From log entry and the current page, creates diff or recovers ;; original content. ;; common routine (define (fold-diff entry source a-proc d-proc c-proc finish) (let loop ((new-count 1) (old-count 1) (current-lines source) (added-lines (ref entry 'added-lines)) (deleted-lines (ref entry 'deleted-lines)) (r '())) (cond ((null? current-lines) (finish (map cdr deleted-lines) r)) ((and (pair? added-lines) (= new-count (car added-lines))) (loop (+ new-count 1) old-count (cdr current-lines) (cdr added-lines) deleted-lines (a-proc (car current-lines) r))) ((and (pair? deleted-lines) (= old-count (caar deleted-lines))) (loop new-count (+ old-count 1) current-lines added-lines (cdr deleted-lines) (d-proc (cdar deleted-lines) r))) (else (loop (+ new-count 1) (+ old-count 1) (cdr current-lines) added-lines deleted-lines (c-proc (car current-lines) r)))))) ;; Returns a list of edit-list like lines. Common lines are just a string, ;; Added line is (+ . line), and deleted line is (- . line). (define (wiliki-log-diff entry newpage) (fold-diff entry (string->lines newpage) (cut acons '+ <> <>) ;a-proc (cut acons '- <> <>) ;d-proc cons ;c-proc (lambda (deleted-lines r) (append! (reverse! r) (map (cut cons '- <>) deleted-lines))))) ;; Get diff of more than one entries back (define (wiliki-log-diff* entries newpage) (cond ((null? entries) (string->lines newpage)) ((null? (cdr entries)) (wiliki-log-diff (car entries) newpage)) (else (let* ((new (string->lines newpage)) (old (wiliki-log-revert* entries new))) (reverse! (lcs-fold (cut acons '+ <> <>) (cut acons '- <> <>) cons '() new old)))))) ;; Returns a previous version of the page (in the form of a list of lines) (define (wiliki-log-revert entry newpage) (fold-diff entry (string->lines newpage) (lambda (line r) r) ;a-proc cons ;d-proc cons ;c-proc (lambda (deleted-lines r) (append! (reverse! r) deleted-lines)))) ;; Apply all entries (define (wiliki-log-revert* entries newpage) (let loop ((entries entries) (page newpage)) (if (null? entries) (string->lines page) ;; ensure returning a list of lines (loop (cdr entries) (wiliki-log-revert (car entries) page))))) ;; Convenience function. Returns the content of the page (in list of lines) ;; at the specified time, or #f if the log of the specified time isn't ;; available. (define (wiliki-log-recover-content pagename logfile current-content time) (and-let* ((logfile) (picked (wiliki-log-pick-from-file pagename logfile)) (entries (wiliki-log-entries-after picked time))) (wiliki-log-revert* entries current-content))) ;; Merge branches ---------------------------------------- ;; Arguments: ;; c-page : the common ancestor of two branches ;; a-page, b-page : the branches ;; These can be either a string, or list of lines. ;; ;; Return values: ;; If successfully merged, a merged page (list of lines) and #t. ;; If conflict occurs, a partially merged page (list of lines, with ;; a conflicting lines indicated by (a line ...) and/or (b line ...)), ;; and #f. ;; ;; Strategy: ;; Basically, we try to apply two edit list _in_parallel_ to the ;; common ancestor. For each step, we examine both heads of ;; the edit lists. If only one of them is applicable, we just apply it. ;; If both of them are applicable, we got a conflict, unless two edits ;; are identical. (Theoretically there may be cases that we can even ;; merge two hunks, but I expect it's rare, so let's leave it to the ;; user). (define (wiliki-log-merge c-page a-page b-page) (let* ((a-lines (string->lines a-page)) (b-lines (string->lines b-page)) (c-lines (string->lines c-page)) (a-edits (edit-list c-lines a-lines)) (b-edits (edit-list c-lines b-lines)) (count 0) (r (make-queue)) (success? #t) ) (define (accum! . fragments) (for-each (lambda (fragment) (unless (null? fragment) (apply enqueue! r fragment))) fragments)) ;; hunk accessors for convenience (define (.from hunk) (ref hunk 0)) (define (.size hunk) (ref hunk 1)) (define (.to hunk) (+ (ref hunk 0) (ref hunk 1))) (define (.added hunk) (ref hunk 2)) ;; main loop (define (dispatch a-edits b-edits lines) (if (null? a-edits) (if (null? b-edits) (finish '() lines) (finish b-edits lines)) (if (null? b-edits) (finish a-edits lines) (merge a-edits b-edits lines)))) (define (finish edits lines) (if (null? edits) (begin (unless (null? lines) (accum! lines)) (values (dequeue-all! r) success?)) (apply-hunk (car edits) lines (cut finish (cdr edits) <>)))) (define (apply-hunk hunk lines cont) (receive (pre post) (split-at lines (- (.from hunk) count)) (accum! pre (.added hunk)) (inc! count (+ (length pre) (.size hunk))) (cont (drop post (.size hunk))))) (define (merge a-edits b-edits lines) (let* ((a-from (.from (car a-edits))) (a-to (.to (car a-edits))) (b-from (.from (car b-edits))) (b-to (.to (car b-edits)))) (cond ((and (<= a-to b-from) (< a-from b-from)) (apply-hunk (car a-edits) lines (cut dispatch (cdr a-edits) b-edits <>))) ((and (<= b-to a-from) (< b-from a-from)) (apply-hunk (car b-edits) lines (cut dispatch a-edits (cdr b-edits) <>))) ((equal? (car a-edits) (car b-edits)) ;; when both have exactly the same edit, we can safely apply ;; one of it. (apply-hunk (car a-edits) lines (cut dispatch (cdr a-edits) (cdr b-edits) <>))) (else ;; We got conflict. (set! success? #f) (conflict (min a-from b-from) (max a-to b-to) a-edits b-edits lines) )))) (define (conflict from to a-edits b-edits lines) ;; It is possible that the conflicting range touches the next ;; hunk of either a-edits or b-edits. In such cases, we extend ;; the conflicting range to include the touching hunk. (let loop ((to to) (ah (list (car a-edits))) (at (cdr a-edits)) (bh (list (car b-edits))) (bt (cdr b-edits))) (cond ((and (pair? at) (pair? bt) (equal? (car at) (car bt))) ;; a rare case, where the conflict range is immeidately ;; followed by both hunks which are exactly the same. (resolve from to (reverse! ah) at (reverse! bh) bt lines)) ((and (pair? at) (>= to (.from (car at)))) (loop (max to (.to (car at))) (cons (car at) ah) (cdr at) bh bt)) ((and (pair? bt) (>= to (.from (car bt)))) (loop (max to (.to (car bt))) ah at (cons (car bt) bh) (cdr bt))) (else (resolve from to (reverse! ah) at (reverse! bh) bt lines))))) (define (resolve from to a-hunks a-tail b-hunks b-tail lines) ;; From and to indicates conflicting range. We emit ;; the content of ranges in a-page and b-page in parallel (receive (pre post) (split-at lines (- from count)) (inc! count (- from count)) (accum! pre) (receive (mid post) (split-at post (- to from)) (let ((a-only (extract a-hunks mid)) (b-only (extract b-hunks mid))) (inc! count (- to from)) (accum! (cond-list ((pair? a-only) (cons 'a a-only)) ((pair? b-only) (cons 'b b-only)))) (dispatch a-tail b-tail post))))) (define (extract hunks lines) (let loop ((hunks hunks) (lines lines) (count count) (r '())) (if (null? hunks) (apply append! (reverse! (cons lines r))) (let* ((h (car hunks)) (lt (drop lines (- (.to h) count)))) (loop (cdr hunks) lt (.to h) (list* (.added h) (take lines (- (.from h) count)) r)))))) ;; Main body (dispatch a-edits b-edits c-lines) )) ;; Calculates a specialized edit list suitable for merging. ;; (#(<from> <len> (<add-lines> ...)) ;; ...) ;; Each hunk means <len> lines from <from>-th line in the original sequence ;; should be substituted by (<add-lines> ...). <from> counts from zero. ;; Trivial examples: ;; #(4 2 ()) : delete 4th and 5th line of the original ;; #(5 0 ("a")) : insert line "a" _before_ 5th line of the original (define (edit-list orig new) (define cnt 0) (define r '()) (let1 last (lcs-fold (lambda (line record) ;; deleted lines (begin0 (if record (begin (inc! (ref record 1)) record) (vector cnt 1 '())) (inc! cnt))) (lambda (line record) ;; added lines (if record (begin (push! (ref record 2) line) record) (vector cnt 0 (list line)))) (lambda (line record) ;; common lines (if record (push! r record)) (inc! cnt) #f) #f orig new string=?) (let1 r (reverse! (if last (cons last r) r)) (for-each (lambda (record) (update! (ref record 2) reverse!)) r) r))) ;; Utility functions ----------------------------------- ;; (1 2 3 5 8 11 12 13) => ((1 3) 5 8 (11 13)) (define (compact-ordinal-list lis) (define (flush prev start acc) (cond ((not start) acc) ((= prev start) (cons start acc)) (else (cons (list start prev) acc)))) (define (rec lis prev start acc) (cond ((null? lis) (flush prev start acc)) ((not prev) (rec (cdr lis) (car lis) (car lis) acc)) ((= prev (- (car lis) 1)) (rec (cdr lis) (car lis) start acc)) (else (rec (cdr lis) (car lis) (car lis) (flush prev start acc))))) (reverse! (rec lis #f #f '()))) (define (uncompact-ordinal-list lis) (append-map! (lambda (elt) (if (number? elt) (list elt) (iota (- 1 (apply - elt)) (car elt)))) lis)) (define (string->lines string-or-list) (if (string? string-or-list) (call-with-input-string string-or-list port->string-list) string-or-list)) (provide "wiliki/log") ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/src/wiliki/db.scm����������������������������������������������������������������������0000644�0000764�0000764�00000004525�11157576011�015073� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; ;;; wiliki/db.scm - database access layer (COMPATIBILITY MODULE) ;;; ;;; Copyright (c) 2003-2009 Shiro Kawai <shiro@acm.org> ;;; ;;; 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: db.scm,v 1.16 2007-12-21 11:56:43 shirok Exp $ ;; NB: The wiliki.db feature is merged into wiliki.core. ;; This module is only kept for the compatibility. (define-module wiliki.db (use wiliki.core) (export wiliki-db-exists? wiliki-db-record->page wiliki-db-get wiliki-db-put! wiliki-db-delete! wiliki-db-touch! wiliki-db-recent-changes wiliki-db-map wiliki-db-fold wiliki-db-for-each wiliki-db-search wiliki-db-search-content)) (select-module wiliki.db) (define (wiliki-db-record->page key record) (wiliki:db-record->page (wiliki) key record)) (define wiliki-db-exists? wiliki:db-exists?) (define wiliki-db-get wiliki:db-get) (define wiliki-db-put! wiliki:db-put!) (define wiliki-db-touch! wiliki:db-touch!) (define wiliki-db-delete! wiliki:db-delete!) (define wiliki-db-recent-changes wiliki:db-recent-changes) (define wiliki-db-fold wiliki:db-fold) (define wiliki-db-map wiliki:db-map) (define wiliki-db-for-each wiliki:db-for-each) (define wiliki-db-search wiliki:db-search) (define wiliki-db-search-content wiliki:db-search-content) (provide "wiliki/db") ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/src/wiliki/core.scm��������������������������������������������������������������������0000644�0000764�0000764�00000075436�11326730326�015446� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; ;;; wiliki.core ;;; ;;; Copyright (c) 2000-2009 Shiro Kawai <shiro@acm.org> ;;; ;;; 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: core.scm,v 1.10 2007-12-21 12:00:36 shirok Exp $ ;;; ;; ;; Provides core functionality for WiLiKi web application; ;; will be referred by internal submodules, such as wiliki.macro. ;; (define-module wiliki.core (use srfi-1) (use srfi-13) (use gauche.parameter) (use gauche.charconv) (use gauche.logger) (use file.util) (use rfc.uri) (use www.cgi) (use wiliki.page) (use util.list) (use util.match) (use text.tree) (use text.html-lite) (use text.csv) (use text.gettext) (use dbm) (extend wiliki.format) ;; temporary (export <wiliki> wiliki-main wiliki wiliki:lang wiliki:output-charset wiliki:cv-in wiliki:cv-out wiliki:wikiname-anchor wiliki:wikiname-anchor-string wiliki:page-lines-fold wiliki:recent-changes-alist wiliki:get-formatted-page-content wiliki:url wiliki:redirect-page wiliki:log-file-path wiliki:std-page wiliki:action-ref define-wiliki-action wiliki:run-action wiliki:reader-macros wiliki:writer-macros wiliki:virtual-pages define-reader-macro define-writer-macro define-virtual-page handle-reader-macro handle-writer-macro expand-writer-macros handle-virtual-page virtual-page? let-macro-keywords* wiliki:parse-macro-args wiliki:with-db wiliki:page-class wiliki:db-record->page wiliki:page->db-record wiliki:db-record-content-find wiliki:db-raw-get wiliki:db-raw-put! wiliki:db-exists? wiliki:db-get wiliki:db-put! wiliki:db-touch! wiliki:db-delete! wiliki:db-recent-changes wiliki:db-fold wiliki:db-map wiliki:db-for-each wiliki:db-search wiliki:db-search-content wiliki:log-event wiliki:spam-blacklist wiliki:spam-blacklist-append! wiliki:contains-spam? )) (select-module wiliki.core) (autoload dbm.gdbm <gdbm>) ;;=================================================================== ;; Class <wiliki> ;; A main data structure that holds run-time information. ;; Available as the value of the parameter wiliki in ;; almost all locations. (define wiliki (make-parameter #f)) ;current instance (define wiliki:lang (make-parameter #f)) ;current language (define wiliki:event-log-drain (make-parameter #f)) ;event log drain (define-class <wiliki> () (;; Customization parameters ----------------------- ;; path to the database file (db-path :accessor db-path-of :init-keyword :db-path :init-value "wikidata.dbm") ;; database class (db-type :accessor db-type-of :init-keyword :db-type :initform <gdbm>) ;; wiliki title (title :accessor title-of :init-keyword :title :init-value "WiLiKi") ;; top page (top-page :accessor top-page-of :init-keyword :top-page :init-value "TopPage") ;; default language (language :accessor language-of :init-keyword :language :init-value 'jp) ;; charset map ((<lang> . <encoding>) ...) (charsets :accessor charsets-of :init-keyword :charsets :init-value '()) ;; editable? ;; can be #f, #t or 'limited. (editable? :accessor editable? :init-keyword :editable? :init-value #t) ;; style-sheet path (style-sheet :accessor style-sheet-of :init-keyword :style-sheet :init-value #f) ;; allowed image path patterns (image-urls :accessor image-urls-of :init-keyword :image-urls :init-value ()) ;; description (description :accessor description-of :init-keyword :description :init-value "WiLiKi, a Wiki engine written in Scheme") ;; information for server (protocol :accessor protocol-of :init-keyword :protocol :initform (if (cgi-get-metavariable "HTTPS") "https" "http")) (server-name :accessor server-name-of :init-keyword :server-name :init-form (or (cgi-get-metavariable "SERVER_NAME") "localhost")) (server-port :accessor server-port-of :init-keyword :server-port :init-form (or (x->integer (cgi-get-metavariable "SERVER_PORT")) 80)) (script-name :accessor script-name-of :init-keyword :script-name :init-form (or (cgi-get-metavariable "SCRIPT_NAME") "/wiliki.cgi")) ;; debug level (debug-level :accessor debug-level :init-keyword :debug-level :init-value 0) ;; log file path. if specified, logging & history feature becomes ;; available. If the name given doesn't hvae directory component, ;; it is regarded in the same directory as db-path. (log-file :accessor log-file :init-keyword :log-file :init-value #f) ;; extra event log for diagnosis. (event-log-file :init-keyword :event-log-file :init-value #f) ;; additional paths to search localized messages by gettext. ;; (e.g. /usr/local/share/locale) (gettext-paths :accessor gettext-paths :init-keyword :gettext-paths :init-value '()) ;; OBSOLETED: customize edit text area size ;; Use stylesheet to customize them! (textarea-rows :accessor textarea-rows-of :init-keyword :textarea-rows :init-value 40) (textarea-cols :accessor textarea-cols-of :init-keyword :textarea-cols :init-value 80) )) ;;;================================================================== ;;; CGI processing entry ;;; ;; Main entry of processing (define-method wiliki-main ((self <wiliki>)) (set! (port-buffering (current-error-port)) :line) (parameterize ([wiliki self] [wiliki:event-log-drain (and (ref self'event-log-file) (make <log-drain> :path (wiliki:event-log-file-path self) :prefix event-log-prefix))]) (cgi-main (lambda (param) (let ((pagename (get-page-name self param)) (command (cgi-get-parameter "c" param)) (language (cgi-get-parameter "l" param :convert string->symbol))) (parameterize ((wiliki:lang (or language (ref self'language)))) (cgi-output-character-encoding (wiliki:output-charset)) (setup-textdomain self language) (cond ;; command may #t if we're looking at the page named "c". ((wiliki:action-ref (if (string? command) (string->symbol command) 'v)) => (cut <> pagename param)) (else (error "Unknown command" command)) )))) :merge-cookies #t :on-error error-page))) ;; aux routines for wiliki-main ;; Setting up the textdomain. ;; 1. If language is explicitly set (by 'l' parameter) we use it. ;; 2. Otherwise, we look at HTTP_ACCEPT_LANGUAGE. If it is set, ;; we just take the first one. ;; 3. Otherwise, we take the language slot of <wiliki>. ;; NB: HTTP_ACCEPT_LANGUAGE sends language-range (language-tag), ;; which has rather complicated syntax & semantics. We just cheat ;; by taking primary tag and first sub tag (if any), and assumes ;; they are language and country code. (define (setup-textdomain wiliki param-lang) (let1 lang (cond (param-lang (if (eq? param-lang 'jp) 'ja param-lang)) ; kluge for compatibility ((cgi-get-metavariable "HTTP_ACCEPT_LANGUAGE") => (lambda (v) (rxmatch-case v [#/^\s*([a-zA-Z]+)(?:-([a-zA-Z]+))?/ (_ pri sec) (if sec #`",|pri|_,|sec|" pri)] [else #f]))) (else (ref wiliki 'language))) (textdomain "WiLiKi" (x->string lang) (ref wiliki 'gettext-paths)))) ;; Retrieve requested page name. ;; The pagename can be specified in one of the following ways: ;; ;; * Using request path ;; http://foo.net/wiliki.cgi/PageName ;; * Using cgi 'p' parameter ;; http://foo.net/wiliki.cgi?l=jp&p=PageName ;; * Using cgi parameter - in this case, PageName must be the ;; first parameter before any other CGI parameters. ;; http://foo.net/wiliki.cgi?PageName ;; ;; The url is tested in the order above. So the following URL points ;; the page "Foo". ;; http://foo.net/wiliki.cgi/Foo?Bar&p=Baz ;; ;; If no page is given, the top page of WiLiKi is used. ;; If the url main component ends with '/', it is regareded as a ;; top page, e.g. the following points to the toppage. ;; http://foo.net/wiliki.cgi/?Bar&p=Baz (define (get-page-name wiki param) ;; Extract the extra components of PATH_INFO (define (get-path-info) (and-let* ((path (cgi-get-metavariable "PATH_INFO")) ((string-prefix? "/" path)) (conv (wiliki:cv-in (uri-decode-string (string-drop path 1))))) conv)) (let1 pg (cond ((get-path-info)) ((cgi-get-parameter "p" param :default #f :convert wiliki:cv-in)) ((and (pair? param) (pair? (car param)) (eq? (cadar param) #t)) (wiliki:cv-in (caar param))) (else "")) (if (equal? pg "") (top-page-of wiki) pg)) ) (define (error-page e) (wiliki:log-event "error: ~a" (ref e'message)) (wiliki:with-db (lambda () (wiliki:std-page (make <wiliki-page> :title #`",(title-of (wiliki)) : Error" :content `((p ,(ref e 'message)) ,@(if (positive? (debug-level (wiliki))) `((pre ,(call-with-output-string (cut with-error-to-port <> (cut report-error e))))) '()))) )) :rwmode :read)) ;; Set up event log prefix (define (event-log-prefix drain) (let1 t (sys-localtime (sys-time)) (format "~a ~2d ~2,'0d:~2,'0d:~2,'0d [~a]:" (sys-strftime "%b" t) (ref t'mday) (ref t'hour) (ref t'min) (ref t'sec) (sys-getenv "REMOTE_ADDR")))) ;;;================================================================== ;;; Action framework ;;; (define wiliki:actions (make-parameter '())) ;action list (internal) ;; Symbol -> (Pagename, Params -> HtmlPage) (define (wiliki:action-ref cmd) (assq-ref (wiliki:actions) cmd)) ;; Symbol, (Pagename, Params -> HtmlPage) -> () (define (wiliki-action-add! cmd action) (wiliki:actions (acons cmd action (wiliki:actions)))) ;; Add new action. Action can be invoked by 'c' CGI paramter. (define-syntax define-wiliki-action (syntax-rules () [(_ name rwmode (pagename (arg . opts) ...) . body) (wiliki-action-add! 'name (lambda (pagename params) (let1 action (lambda (arg ...) . body) (wiliki:with-db (lambda () (let1 args-alist (list (cons 'arg (cgi-get-parameter (x->string 'arg) params . opts)) ...) (wiliki:run-action (wiliki) 'name action pagename params args-alist))) :rwmode rwmode))))] )) (define-method wiliki:run-action ((wiliki <wiliki>) name action pagename params args-alist) (apply action (map cdr args-alist))) ;;;================================================================== ;;; Character set conversions ;;; ;; input conversion - get data from outside world (define (wiliki:cv-in str) (if (string? str) (ces-convert str "*JP") "")) ;; output conversion - put data to outside world, according to charsets spec (define (wiliki:cv-out str) (if (string? str) (ces-convert str (symbol->string (gauche-character-encoding)) (wiliki:output-charset)) "")) (define (wiliki:output-charset) (or (and-let* (((wiliki)) (p (assoc (wiliki:lang) (charsets-of (wiliki)))) ((symbol? (cdr p)))) (cdr p)) "utf-8")) ;; this is a fallback. ;;;================================================================== ;;; Gadgets ;;; ;; A list of urls or regexps that should be rejected at commit time. (define wiliki:spam-blacklist (make-parameter '())) (define (wiliki:spam-blacklist-append! lis) (wiliki:spam-blacklist (append (wiliki:spam-blacklist) lis))) (define (wiliki:contains-spam? content) (any (lambda (x) (cond [(regexp? x) (rxmatch x content)] [(string? x) (string-contains content x)] [else #f])) (wiliki:spam-blacklist))) ;; Returns SXML anchor node and string for given wikiname. (define (wiliki:wikiname-anchor wikiname . maybe-anchor-string) `(a (@ (href ,(wiliki:url "~a" (wiliki:cv-out wikiname)))) ,(get-optional maybe-anchor-string wikiname))) (define (wiliki:wikiname-anchor-string wikiname . maybe-anchor-string) (tree->string (wiliki:sxml->stree (apply wiliki:wikiname-anchor wikiname maybe-anchor-string)))) ;; Calls proc over each line of page. (define (wiliki:page-lines-fold page proc seed . keys) (let-keywords* keys ((follow-includes? #f) (skip-verbatim? #f)) (define (content-fold line seed) (cond ((eof-object? line) seed) ((string=? line "{{{") (verb-fold line seed)) ((and follow-includes? (#/^\[\[$$include\s*(\S*)\]\]/ line)) => (lambda (m) (handle-include (m 1) (m 'after) (if (string-null? (m 'before)) seed (content-fold (m 'before) seed))))) (else (content-fold (read-line) (proc line seed))))) (define (handle-include pagename after seed) (content-fold (if (string-null? after) (read-line) after) (handle-page (wiliki:db-get pagename #f) seed))) (define (handle-page page seed) (if (or (not (is-a? page <wiliki-page>)) (not (string? (ref page 'content)))) seed (with-input-from-string (ref page 'content) (cut with-port-locking (current-input-port) (cut content-fold (read-line) seed))))) (define (verb-fold line seed) (cond ((eof-object? line) seed) ((string=? line "}}}") (content-fold (read-line) (if skip-verbatim? seed (proc line seed)))) (else (verb-fold (read-line) (if skip-verbatim? seed (proc line seed)))))) (handle-page page seed))) ;; Returns recent changes (define (wiliki:recent-changes-alist . keys) (cond [(get-keyword :length keys #f) => (cut take* (wiliki:db-recent-changes) <>)] [else (wiliki:db-recent-changes)])) ;; Returns [SXML] (define (wiliki:get-formatted-page-content pagename) (wiliki:format-content (wiliki:db-get pagename #t))) ;; Redirect to the given wiliki page (define (wiliki:redirect-page key) (cgi-header :location (wiliki:url :full "~a" key) :status "302 Moved")) ;; Returns absolute pathname of the log file, or #f (define (wiliki:log-file-path wiliki) (wiliki-prepend-path wiliki (ref wiliki'log-file))) (define (wiliki:event-log-file-path wiliki) (wiliki-prepend-path wiliki (ref wiliki'event-log-file))) (define (wiliki-prepend-path wiliki filename) (and (string? filename) (if (or (string-prefix? "./" filename) (string-prefix? "../" filename) (string-prefix? "/" filename)) filename (build-path (sys-dirname (ref wiliki'db-path)) filename)))) ;; Standard page (define (wiliki:std-page page . args) (list (cgi-header :content-type #`"text/html; charset=,(wiliki:output-charset)" :content-style-type "text/css") (html-doctype :type :transitional) (wiliki:sxml->stree (apply wiliki:format-page page args)))) ;; Returns URL of the wiliki, with given parameters. ;; (wiliki:url) => the relative URL of wiliki cgi ;; (wiliki:url string) => adds query string STRING. STRING is not ;; url escaped. ;; (wiliki:url fmtstr arg ...) => using format to format the query ;; string, then adds it to the url. ARGs are first converted to ;; string by x->string, then url-encoded. ;; (wiliki:url :full), (wiliki:url :full string), ;; (wiliki:url :full fmtstr arg ...) => like above, but returns ;; absolute url. (define (wiliki:url . args) (define (rel-base w) (sys-basename (ref w'script-name))) (define (abs-base w) (format "~a://~a~a~a" (ref w'protocol) (ref w'server-name) (if (or (and (= (ref w'server-port) 80) (string=? (ref w'protocol) "http")) (and (= (ref w'server-port) 443) (string=? (ref w'protocol) "https"))) "" #`":,(ref w'server-port)") (ref w'script-name))) (define (lang-spec language prefix) (if (equal? language (ref (wiliki)'language)) "" #`",|prefix|l=,|language|")) (define (url-format full? fmt args) (let* ((w (wiliki)) (fstr (if fmt #`"?,|fmt|,(lang-spec (wiliki:lang) '&)" (lang-spec (wiliki:lang) '?)))) (string-append (if full? (abs-base w) (rel-base w)) (if (null? args) fstr (apply format fstr (map (compose uri-encode-string x->string) args)))))) (match args [() (rel-base (wiliki))] [((? string? s)) (url-format #f s '())] [((? string? s) args ...) (url-format #f s args)] [(:full) (abs-base (wiliki))] [(:full (? string? s)) (url-format #t s '())] [(:full (? string? s) args ...) (url-format #t s args)] [else (error "invalid call to wiliki:url:" `(wiliki:url ,@args))])) ;;=================================================================== ;; Macro mechanism ;; ;; Macro alist (define wiliki:reader-macros (make-parameter '())) (define wiliki:writer-macros (make-parameter '())) (define wiliki:virtual-pages (make-parameter '())) ;; 'Macro' is a procedure that takes arguments, and should return [SXML]. ;; For backward compatibility, it is allowed to return Stree as well. (define (wrap-macro-output output) (if (and (proper-list? output) (every (lambda (node) (or (string? node) (and (pair? node) (symbol? (car node))))) output)) output ;; it's likely an SXML list `((stree ,@output)))) ;;otherwise, wrap it by stree node ;;---------------------------------------------- ;; API called from the main WiLiKi system ;; (define (handle-reader-macro name) (or (and-let* ((args (wiliki:parse-macro-args name))) (handle-expansion name (lambda () (assoc (car args) (wiliki:reader-macros))) (lambda (p) (apply (cdr p) (cdr args))))) (unrecognized-macro name))) (define (handle-writer-macro name) (or (and-let* ((args (wiliki:parse-macro-args name))) (handle-expansion name (lambda () (assoc (car args) (wiliki:writer-macros))) (lambda (p) (apply (cdr p) (cdr args))))) (unrecognized-macro name))) (define (handle-virtual-page name) (make <wiliki-page> :title name :content (handle-expansion name (lambda () (get-virtual-page name)) (lambda (p) ((cdr p) name))))) (define (handle-expansion name finder applier) (guard (e (else (if (positive? (ref (wiliki) 'debug-level)) `((pre (@ (class "macroerror")) ,#`"Macro error in [[,|name|]]:\n" ,(call-with-output-string (cut with-error-to-port <> (cut report-error e))))) (unrecognized-macro name)))) (wrap-macro-output (cond ((finder) => applier) (else (unrecognized-macro name)))))) (define (expand-writer-macros content) (define (normal line) (cond ((eof-object? line)) ((string=? line "{{{") (print line) (verbatim (read-line))) (else (display (regexp-replace-all #/\[\[($\w+(?:\s+[^\]]*)?)\]\]/ line (lambda (m) (tree->string (handle-writer-macro (m 1)))))) (newline) (normal (read-line))))) (define (verbatim line) (cond ((eof-object? line) (print "}}}")) ;; close verbatim block ((string=? line "}}}") (print line) (normal (read-line))) (else (print line) (verbatim (read-line))))) (with-string-io content (lambda () (with-port-locking (current-input-port) (lambda () (normal (read-line))))))) ;;---------------------------------------------- ;; Utility to define macros ;; (define (unrecognized-macro name) (list #`"[[,name]]")) (define-syntax define-reader-macro (syntax-rules () ((_ (name . args) . body) (wiliki:reader-macros (cons (let ((sname (string-append "$$" (symbol->string 'name)))) (cons sname (lambda p (if (arity-matches? p 'args) (apply (lambda args . body) p) (unrecognized-macro sname))))) (wiliki:reader-macros)))) )) (define-syntax define-writer-macro (syntax-rules () ((_ (name . args) . body) (wiliki:writer-macros (let ((sname (string-append "$" (symbol->string 'name)))) (acons sname (lambda p (if (arity-matches? p 'args) (apply (lambda args . body) p) (unrecognized-macro sname))) (wiliki:writer-macros))))) )) (define-syntax define-virtual-page (syntax-rules () ((_ (expr (var ...)) . body) (wiliki:virtual-pages (acons expr (lambda p (rxmatch-if (rxmatch expr (car p)) (var ...) (apply (lambda args . body) p) (unrecognized-macro (regexp->string expr)))) (wiliki:virtual-pages)))) )) (define (get-virtual-page name) (find (lambda (e) (rxmatch (car e) name)) (wiliki:virtual-pages))) (define (virtual-page? name) (not (not (get-virtual-page name)))) (define (arity-matches? list formals) (cond ((null? list) (or (null? formals) (not (pair? formals)))) ((null? formals) #f) ((pair? formals) (arity-matches? (cdr list) (cdr formals))) (else #t))) (define wiliki:parse-macro-args (let1 parser (make-csv-reader #\space) (lambda (name) (guard (e (else #f)) (call-with-input-string name parser))))) (define-macro (let-macro-keywords* args binds . body) (define (get-macro-arg-with-key key default args) (cond [(find (cut string-prefix? key <>) args) => (cut string-drop <> (string-length key))] [else default])) `(let* ,(map (match-lambda [(var default) `(,var (,get-macro-arg-with-key ,#`",|var|=" ,default ,args))]) binds) ,@body)) ;;=================================================================== ;; Database layer ;; ;; some constants (define-constant *retry-limit* 15) (define-constant *recent-changes* " %recent-changes") ;; private parameter (define the-db (make-parameter #f)) ;; private procedures (define (db-try-open dbpath dbtype rwmode) ;; Try to open the database. We retry up to *retry-limit* times. (define (try retry mode) (guard (e [(>= retry *retry-limit*) (raise e)] [else (sys-nanosleep #e15e8) (try (+ retry 1) mode)]) (dbm-open dbtype :path dbpath :rw-mode mode))) ;; If db file does not exist, we open it with :write mode, ;; regardless of rwmode arg, so that the empty DB is created. ;; Note that race condition will not happen here. If there's no ;; DB and two process simultaneously came to this code, only ;; one can grab the write access of DB, and another will ;; be kept waiting until the initial content is committed. (try 0 (if (dbm-db-exists? dbtype dbpath) rwmode :write)) ) (define (check-db) (or (the-db) (error "WiLiKi: database is not open"))) (define (read-recent-changes db) (read-from-string (dbm-get db *recent-changes* "()"))) (define (write-recent-changes db r) (dbm-put! db *recent-changes* (write-to-string (take* r 50)))) ;;; ;;; External API ;;; ;; Call thunk with opening the db specified by path. If the db is already ;; open, we just call thunk, EXCEPT that the opened db is in read-only mode ;; and we're requested to reopen it in write mode. (define (wiliki:with-db thunk . opts) (let-keywords* opts ((rwmode :read)) (let ((path (ref (wiliki)'db-path)) (type (ref (wiliki)'db-type))) (cond [(the-db) => (lambda (db) (when (and (eq? rwmode :write) (eq? (ref db'rw-mode) :read)) ;; we should reopen the db (dbm-close db) (the-db (db-try-open path type rwmode))) (thunk))] [else (parameterize ((the-db (db-try-open path type rwmode))) (dynamic-wind (lambda () #f) thunk (lambda () (unless (dbm-closed? (the-db)) (dbm-close (the-db))))))])))) ;; Returns the class to represent the page (define-method wiliki:page-class ((self <wiliki>)) <wiliki-page>) ;;; All other wiliki:db APIs implicitly uses the-db. ;; 'Record' is a serialized page data. By default, it is a string ;; with concatenation of kv-list of metadata plus raw content. ;; To change record representation, the following three methods ;; needs to be overridden. (define-method wiliki:db-record->page ((self <wiliki>) key record) (call-with-input-string record (lambda (p) (let* ((params (read p)) (content (port->string p))) (apply make (wiliki:page-class self) :title key :key key :content content params))))) ;; internal; to save overhead of making <wiliki-page> (define-method wiliki:db-record-content-find ((self <wiliki>) record pred) (call-with-input-string record (lambda (p) (read p) ; skip metadata (let loop ((line (read-line p)) (out-verb? #t)) (cond [(eof-object? line) #f] [(and out-verb? (string-prefix? ";;" line)) (loop (read-line p) #t)] [(pred line) #t] [else (loop (read-line p) (cond [(and (not out-verb?) (string=? "{{{" line)) #f] [(string=? "}}}" line) #t] [else out-verb?]))]))))) (define-method wiliki:page->db-record ((self <wiliki>) (page <wiliki-page>)) (with-output-to-string (lambda () (write (list :ctime (ref page 'ctime) :cuser (ref page 'cuser) :mtime (ref page 'mtime) :muser (ref page 'muser))) (display (ref page 'content))))) ;; Raw acessors (define (wiliki:db-raw-get key . maybe-default) (apply dbm-get (check-db) key maybe-default)) (define (wiliki:db-raw-put! key val) (dbm-put! (check-db) key val)) (define (wiliki:db-exists? key) (dbm-exists? (check-db) key)) (define (wiliki:db-get key . opts) (let-optionals* opts ((create? #f)) (let1 db (check-db) (cond [(dbm-get db key #f) => (cut wiliki:db-record->page (wiliki) key <>)] [create? (make (wiliki:page-class (wiliki)) :title key :key key)] [else #f])))) (define-method wiliki:db-put! (key (page <wiliki-page>) . opts) (let-keywords* opts ((donttouch #f)) (let ((db (check-db)) (s (wiliki:page->db-record (wiliki) page))) (dbm-put! db key s) (unless donttouch (let1 r (alist-delete key (read-recent-changes db)) (write-recent-changes db (acons key (ref page 'mtime) r)))) ))) (define (wiliki:db-touch! key) (and-let* ([db (check-db)] [page (wiliki:db-get key)] [r (alist-delete key (read-recent-changes db))]) (write-recent-changes db (acons key (sys-time) r)))) (define (wiliki:db-delete! key) (let* ((db (check-db)) (r (alist-delete key (read-recent-changes db)))) (dbm-delete! db key) (write-recent-changes db r))) (define (wiliki:db-recent-changes) (read-recent-changes (check-db))) (define (wiliki:db-fold proc seed) (dbm-fold (check-db) (lambda (k v seed) (if (string-prefix? " " k) seed (proc k v seed))) seed)) (define (wiliki:db-map proc) (wiliki:db-fold (lambda (k v seed) (cons (proc k v) seed)) '())) (define (wiliki:db-for-each proc) (wiliki:db-fold (lambda (k v seed) (proc k v) #f) #f)) (define (wiliki:db-search pred . maybe-sorter) (sort (dbm-fold (check-db) (lambda (k v r) (if (pred k v) (acons k (read-from-string v) r) r)) '()) (get-optional maybe-sorter (lambda (a b) (> (get-keyword :mtime (cdr a) 0) (get-keyword :mtime (cdr b) 0)))))) (define (wiliki:db-search-content key . maybe-sorter) (let1 w (wiliki) (apply wiliki:db-search (lambda (k v) (and (not (string-prefix? " " k)) (wiliki:db-record-content-find w v (cut string-contains-ci <> key)))) maybe-sorter))) ;;;================================================================== ;;; Event log ;;; (define (wiliki:log-event fmt . args) (when (wiliki:event-log-drain) (apply log-format (wiliki:event-log-drain) fmt args))) (provide "wiliki/core") ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/src/wiliki/format.scm������������������������������������������������������������������0000644�0000764�0000764�00000031734�11320205614�015766� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; ;;; wiliki/format.scm - format wiki pages (backward compatibility module) ;;; ;;; Copyright (c) 2003-2009 Shiro Kawai <shiro@acm.org> ;;; ;;; 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: format.scm,v 1.46 2007-12-22 00:05:06 shirok Exp $ (define-module wiliki.format (use srfi-1) (use srfi-2) (use srfi-11) (use srfi-13) (use text.html-lite) (use text.tree) (use text.tr) (use rfc.uri) (use util.list) (use util.queue) (use util.match) (use gauche.parameter) (use gauche.charconv) (use gauche.sequence) (use wiliki.parse) (use wiliki.page) (use sxml.tools) (export <wiliki-formatter-base> wiliki:persistent-page? wiliki:transient-page? wiliki:format-wikiname wiliki:format-macro wiliki:format-time wiliki:format-content wiliki:formatter wiliki:format-page-header wiliki:format-page-content wiliki:format-page-footer wiliki:format-page-body wiliki:format-head-elements wiliki:format-head-title wiliki:format-page wiliki:format-line-plainly wiliki:calculate-heading-id wiliki:sxml->stree wiliki:format-diff-pre wiliki:format-diff-line ) ) (select-module wiliki.format) ;; This module provides a base class <wiliki-formatter-base> as an anchor ;; point of customizing various formatting functions. ;; ;; The base class and methods only implements minimum functionalities, that ;; do not depend on persistent database. Subclass this class and specialize ;; method if you're writing a formatter for non-web targets (e.g. formatting ;; for a plain text). ;; ;; The <wiliki-formatter> class in wiliki.scm provides a full feature of ;; to generate HTML page. If you're customizing webpage formatting, use ;; that class as a starting point. (define-class <wiliki-formatter-base> () (;; The following slots are only for compatibility to the code ;; written with WiLiKi-0.5_pre2. ;; They won't be supported officially in future versions; use ;; subclassing & methods instead. (bracket :init-keyword :bracket :init-value (lambda (name) (list #`"[[,|name|]]"))) (macro :init-keyword :macro :init-value (lambda (expr context) `("##" ,(write-to-string expr)))) (time :init-keyword :time :init-value (lambda (time) (x->string time))) (body :init-keyword :body :init-value (lambda (page opts) (fmt-body page opts))) (header :init-keyword :header :init-value (lambda (page opts) '())) (footer :init-keyword :footer :init-value (lambda (page opts) '())) (content :init-keyword :content :init-value (lambda (page opts) (wiliki:format-content page))) (head-elements :init-keyword :head-elements :init-value (lambda (page opts) '())) )) ;; Global context and the default formatter (define the-formatter (make-parameter (make <wiliki-formatter-base>))) ;; similar to sxml:sxml->xml, but deals with stree node, which ;; embeds a string tree. (define (wiliki:sxml->stree sxml) (define (sxml-node type body) (define (attr lis r) (cond ((null? lis) (reverse! r)) ((not (= (length+ (car lis)) 2)) (error "bad attribute in node: " (cons type body))) (else (attr (cdr lis) (cons `(" " ,(html-escape-string (x->string (caar lis))) "=\"" ,(html-escape-string (x->string (cadar lis))) "\"") r))))) (define (rest type lis) (if (and (null? lis) (memq type '(br area link img param hr input col base meta))) '(" />") (list* ">" (reverse! (fold node '() lis)) "</" type "\n>"))) (if (and (pair? body) (pair? (car body)) (eq? (caar body) '@)) (list* "<" type (attr (cdar body) '()) (rest type (cdr body))) (list* "<" type (rest type body))) ) (define (node n r) (cond ((string? n) (cons (html-escape-string n) r)) ((and (pair? n) (symbol? (car n))) (if (eq? (car n) 'stree) (cons (cdr n) r) (cons (sxml-node (car n) (cdr n)) r))) (else ;; badly formed node. we show it for debugging ease. (cons (list "<span class=\"wiliki-alert\">" (html-escape-string (format "~,,,,50:s" n)) "</span\n>") r)))) (node sxml '())) ;;================================================= ;; Formatting: Wiki -> SXML ;; ;; Utility to generate a (mostly) unique id for the headings. ;; Passes a list of heading string stack. (define (wiliki:calculate-heading-id headings) (string-append "H-" (number->string (hash headings) 36))) ;; Backward compatibility (define wiliki:format-line-plainly wiliki-remove-markup) ;; Page ====================================================== (define (wiliki:format-content page) (define (do-fmt content) (expand-page (wiliki-parse-string content))) (cond ((string? page) (do-fmt page)) ((is-a? page <wiliki-page>) (if (wiliki-page-circular? page) ;; loop in $$include chain detected `(p ">>>$$include loop detected<<<") (parameterize ((wiliki-page-stack (cons page (wiliki-page-stack)))) (if (string? (ref page 'content)) (let1 sxml (do-fmt (ref page 'content)) (set! (ref page'content) sxml) sxml) (ref page 'content))))) (else page))) ;; [SXML] -> [SXML], expanding wiki-name and wiki-macro nodes. ;; (define (expand-page sxmls) (let rec ((sxmls sxmls) (hctx '())) ;;headings context (match sxmls (() '()) ((('wiki-name name) . rest) (append (wiliki:format-wikiname (the-formatter) name) (rec rest hctx))) ((('wiki-macro . expr) . rest) (append (wiliki:format-macro (the-formatter) expr 'inline) (rec rest hctx))) (((and ((or 'h2 'h3 'h4 'h5 'h6) . _) sxml) . rest) ;; extract heading hierarchy to calculate heading id (let* ((hn (sxml:name sxml)) (hkey (assq 'hkey (sxml:aux-list-u sxml))) (hctx2 (extend-headings-context hctx hn hkey))) (cons `(,hn ,@(if hkey `((@ (id ,(heading-id hctx2)))) '()) ,@(rec (sxml:content sxml) hctx)) (rec rest hctx2)))) (((and (name . _) sxml) . rest);; generic node (cons `(,name ,@(cond ((sxml:attr-list-node sxml) => list) (else '())) ,@(rec (sxml:content sxml) hctx)) (rec rest hctx))) ((other . rest) (cons other (rec rest hctx)))))) (define (hn->level hn) (find-index (cut eq? hn <>) '(h2 h3 h4 h5 h6))) (define (extend-headings-context hctx hn hkey) (if (not hkey) hctx (let* ((level (hn->level hn)) (up (drop-while (lambda (x) (>= (hn->level (car x)) level)) hctx))) (acons hn (cadr hkey) up)))) (define (heading-id hctx) (wiliki:calculate-heading-id (map cdr hctx))) ;; default page body formatter (define (fmt-body page opts) `(,@(wiliki:format-page-header page opts) ,@(wiliki:format-page-content page opts) ,@(wiliki:format-page-footer page opts))) ;;; ;;; Exported functions ;;; (define wiliki:formatter the-formatter) ;; Default formatting methods. ;; Methods are supposed to return SXML nodeset. ;; NB: It is _temporary_ that these methods calling the slot value ;; of the formatter, just to keep the backward compatibility to 0.5_pre2. ;; Do not count on this implementation. The next release will remove ;; all the closure slots of <wiliki-formatter-base> and the default behavior ;; will directly be embedded in these methods. (define-method wiliki:format-wikiname ((fmt <wiliki-formatter-base>) name) ((ref fmt 'bracket) name)) (define-method wiliki:format-wikiname ((name <string>)) (wiliki:format-wikiname (the-formatter) name)) (define-method wiliki:format-macro ((fmt <wiliki-formatter-base>) expr context) ((ref fmt 'macro) expr context)) (define-method wiliki:format-macro (expr context) (wiliki:format-macro (the-formatter) expr context)) (define-method wiliki:format-time ((fmt <wiliki-formatter-base>) time) ((ref fmt 'time) time)) (define-method wiliki:format-time (time) (wiliki:format-time (the-formatter) time)) (define-method wiliki:format-page-content ((fmt <wiliki-formatter-base>) page ;; may be a string . options) ((ref fmt 'content) page options)) (define-method wiliki:format-page-content (page . opts) (apply wiliki:format-page-content (the-formatter) page opts)) (define-method wiliki:format-page-body ((fmt <wiliki-formatter-base>) (page <wiliki-page>) . opts) `(,@(apply wiliki:format-page-header page opts) ,@(apply wiliki:format-page-content page opts) ,@(apply wiliki:format-page-footer page opts))) (define-method wiliki:format-page-body ((page <wiliki-page>) . opts) (apply wiliki:format-page-body (the-formatter) page opts)) (define-method wiliki:format-page-header ((fmt <wiliki-formatter-base>) (page <wiliki-page>) . options) ((ref fmt 'header) page options)) (define-method wiliki:format-page-header ((page <wiliki-page>) . opts) (apply wiliki:format-page-header (the-formatter) page opts)) (define-method wiliki:format-page-footer ((fmt <wiliki-formatter-base>) (page <wiliki-page>) . options) ((ref fmt 'footer) page options)) (define-method wiliki:format-page-footer ((page <wiliki-page>) . opts) (apply wiliki:format-page-footer (the-formatter) page opts)) (define-method wiliki:format-head-elements ((fmt <wiliki-formatter-base>) (page <wiliki-page>) . options) (append ((ref fmt 'head-elements) page options) (ref page 'extra-head-elements))) (define-method wiliki:format-head-elements ((page <wiliki-page>) . opts) (apply wiliki:format-head-elements (the-formatter) page opts)) (define-method wiliki:format-head-title ((fmt <wiliki-formatter-base>) (page <wiliki-page>) . options) (ref page'title)) (define-method wiliki:format-page ((fmt <wiliki-formatter-base>) (page <wiliki-page>) . opts) `(html (head ,@(apply wiliki:format-head-elements fmt page opts)) (body ,@(apply wiliki:format-page-body fmt page opts)))) (define-method wiliki:format-page ((page <wiliki-page>) . opts) (apply wiliki:format-page (the-formatter) page opts)) (define (wiliki:persistent-page? page) (not (wiliki:transient-page? page))) (define (wiliki:transient-page? page) (not (ref page 'key))) ;; NB: these should also be a generics. (define (wiliki:format-diff-pre difflines) `(pre (@ (class "diff") (style "background-color:#ffffff; color:#000000; margin:0")) ,@(map wiliki:format-diff-line difflines))) (define (wiliki:format-diff-line line) (define (aline . c) `(span (@ (class "diff_added") (style "background-color:#ffffff; color: #4444ff")) ,@c)) (define (dline . c) `(span (@ (class "diff_deleted") (style "background-color:#ffffff; color: #ff4444")) ,@c)) (cond ((string? line) `(span " " ,line "\n")) ((eq? (car line) '+) (aline "+ " (cdr line) "\n")) ((eq? (car line) '-) (dline "- " (cdr line) "\n")) (else "???"))) (provide "wiliki/format") ������������������������������������WiLiKi-0.6.2/src/wiliki/rssmix.scm������������������������������������������������������������������0000644�0000764�0000764�00000034762�11157576011�016041� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/home/shiro/bin/gosh ;;; ;;; wiliki/rssmix - Fetch and show RSSs ;;; ;;; Copyright (c) 2003-2009 Shiro Kawai <shiro@acm.org> ;;; ;;; 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: rssmix.scm,v 1.3 2007-04-06 09:18:58 shirok Exp $ ;;; ;; *EXPERIMENTAL* (define-module wiliki.rssmix (use srfi-1) (use srfi-2) (use srfi-13) (use srfi-14) (use srfi-19) (use rfc.http) (use rfc.uri) (use text.html-lite) (use util.list) (use sxml.ssax) (use gauche.threads) (use gauche.uvector) (use gauche.regexp) (use gauche.charconv) (use dbm) (use www.cgi) (export rss-main <rssmix>) ) (select-module wiliki.rssmix) (autoload dbm.gdbm <gdbm>) (define-constant USER_AGENT "wiliki/rssmix http://www.shiro.dreamhost.com/scheme/wiliki/rssmix.cgi") (define-constant NAMESPACES '((rdf . "http://www.w3.org/1999/02/22-rdf-syntax-ns#") (rss . "http://purl.org/rss/1.0/") (dc . "http://purl.org/dc/elements/1.1/"))) (define-class <rssmix> () ((sites :init-keyword :sites :init-value '()) ;; - list of monitoring sites. Each entry should be ;; (IDENT HOME-URI RSS-URI) (num-items :init-keyword :num-items :init-value 70) ;; - # of entries to show (title :init-keyword :title :init-value "Recent Changes") (db-name :init-keyword :db-name :init-value "/home/shiro/data/rssmix.dbm") (db-type :init-keyword :db-type :init-form <gdbm>) (cache-life :init-keyword :cache-life :init-value 1800) ;; - lifetime of cache, in seconds. (fetch-timeout :init-keyword :fetch-timeout :init-value 15) ;; - timeout value to fetch RSS (max-title-width :init-keyword :max-title-width :init-value 65) ;; - entry longer than this will be truncated (max-threads :init-keyword :max-threads :init-value 4) ;; - max # of threads to be used to fetch rss. (db :init-value #f) ;; - opened dbm instance (db-lock :init-form (make-mutex)) ;; - mutex for db )) ;; temporary structure to represent site item info (define-class <rss-item> () ((site-id :init-keyword :site-id) (site-url :init-keyword :site-url) (title :init-keyword :title) (link :init-keyword :link) (date :init-keyword :date) )) (define-syntax with-rss-db (syntax-rules () ((_ self . body) (let* ((s self) (lock (ref s 'db-lock))) (dynamic-wind (lambda () (mutex-lock! lock)) (lambda () (let1 db (dbm-open (ref s 'db-type) :path (ref s 'db-name) :rwmode :write) (set! (ref s 'db) db) (with-error-handler (lambda (e) (dbm-close db) (raise e)) (lambda () (receive r (begin . body) (dbm-close db) (apply values r)))))) (lambda () (mutex-unlock! lock)))) ))) ;; an ad-hoc function to estimate width of the string (define (char-width ch) (if (< (char->integer ch) 256) 1 2)) (define (string-width str) (string-fold (lambda (ch w) (+ w (char-width ch))) 0 str)) (define (string-chop str width) (with-string-io str (lambda () (let loop ((w 0) (ch (read-char))) (unless (or (eof-object? ch) (> w width)) (write-char ch) (loop (+ w (char-width ch)) (read-char))))))) (define (rss-format-date unix-time) (sys-strftime "%Y/%m/%d %H:%M:%S %Z" (sys-localtime unix-time))) (define-method rss-page ((self <rssmix>) title body) `("Content-Style-Type: text/css\n" ,(cgi-header :content-type #`"text/html; charset=\",(gauche-character-encoding)\"") ,(html-doctype :type :transitional) ,(html:html (html:head (html:title (html-escape-string title)) (html:link :rel "stylesheet" :href "wiliki-sample.css" :type "text/css")) (html:body (html:h1 (html-escape-string title)) (html:div :align "right" "[" (html:a :href "http://www.shiro.dreamhost.com/scheme/wiliki/wiliki.cgi?WiLiKi:RSSMix" "What's This?") "]" "[" (html:a :href "?c=info" "Sources") "]") (html:hr) body)))) (define-method rss-error-page ((self <rssmix>) e) (rss-page self "Error" (html:p (html-escape-string (ref e 'message))))) (define-method rss-recent-changes ((self <rssmix>)) (rss-page self (ref self 'title) (html:table (map (lambda (item) (html:tr (html:td (rss-format-date (ref item 'date))) (html:td (let* ((id (ref item 'site-id)) (title (ref item 'title)) (titlew (string-width title)) (len (- (ref self 'max-title-width) (+ (string-width id) titlew))) ) (when (negative? len) (set! title #`",(string-chop title (+ titlew len)) ...")) (list (html:a :href (ref item 'site-url) (html-escape-string id)) ": " (html:a :href (ref item 'link) (html-escape-string title)) ) )))) (take* (collect self) (ref self 'num-items))) ))) (define-method rss-site-info ((self <rssmix>)) (let* ((sites (ref self 'sites)) (infos (with-rss-db self (map (lambda (s) (read-from-string (dbm-get (ref self 'db) (car s) "#f"))) sites))) ) (rss-page self "RSSMix: Site Info" (map (lambda (site info) `(,(html:h3 (html-escape-string (car site))) ,(html:table (html:tr (html:td "Title") (html:td (get-keyword :channel-title info "--"))) (html:tr (html:td "Top") (html:td (html:a :href (cadr site) (html-escape-string (cadr site))))) (html:tr (html:td "RSS") (html:td (html:a :href (caddr site) (html-escape-string (caddr site))))) (html:tr (html:td "Last fetched") (html:td (or (and-let* ((info) (ts (get-keyword :timestamp info #f))) (rss-format-date ts)) "--"))) (html:tr (html:td "Time spent") (html:td (or (and-let* ((info) (ts (get-keyword :elapsed info #f))) ts) "--"))) ))) sites infos) ))) (define-method rss-main ((self <rssmix>)) (cgi-main (lambda (params) (let1 command (cgi-get-parameter "c" params :default "list") (cond ((equal? command "info") (rss-site-info self)) ((equal? command "list") (rss-recent-changes self)) (else (error "Unknown command" command))))) :on-error (lambda (e) (rss-error-page self e))) 0) ;; Collect RSS info from given sites. (define (collect self) (let* ((sites (ref self 'sites)) (getters (with-rss-db self (map (lambda (site) (get-rss self (car site) (caddr site))) sites))) (timeout (add-duration (current-time) ;; NB: this requires fixed srfi-19.scm (make-time 'time-duration 0 (ref self 'fetch-timeout)))) ) (sort (append-map (lambda (site getter) (or (and-let* ((items (getter timeout))) (map (lambda (item) (make <rss-item> :site-id (car site) :site-url (cadr site) :title (car item) :link (cadr item) :date (caddr item))) items)) '())) sites getters) (lambda (a b) (> (ref a 'date) (ref b 'date)))) )) ;; Returns a procedure PROC, that takes a srfi-time and returns RSS data, ;; which is a list of (TITLE LINK UNIX-TIME). ;; The time passed to PROC specifies a limit when thread can wait to fetch ;; the RSS. If the RSS is cached and up to date, PROC promptly returns it. ;; If there is no cache or the cache is obsolete, a thread is spawned to ;; fetch RSS. If something goes wrong, PROC returns #f. ;; Cache is updated accodringly within PROC. ;; NB: this is called from primordial thread, so we don't need to lock db. (define (get-rss self id rss-url) (let* ((cached (and-let* ((body (dbm-get (ref self 'db) id #f))) (read-from-string body))) (timestamp (and cached (get-keyword :timestamp cached 0))) (rss (and cached (get-keyword :rss-cache cached #f))) (now (sys-time)) ) (if (and rss (> timestamp (- now (ref self 'cache-life)))) (lambda (timeout) rss) ;; active (let1 t (thread-start! (make-thread (make-thunk self id rss-url now) id)) (lambda (timeout) (let1 r (thread-join! t timeout 'timeout) (if (eq? r 'timeout) (begin (record-timeout self id) rss) r))))) )) ;; Record the fact that timeout occurred. Must be called from main thread. (define (record-timeout self id) (with-rss-db self (and-let* ((db (ref self 'db)) (cached (read-from-string (dbm-get db id "#f"))) (channel-title (get-keyword :channel-title cached #f)) (timestamp (get-keyword :timestamp cached #f)) (rss-cache (get-keyword :rss-cache cached #f)) (data (list :timestamp timestamp :rss-cache rss-cache :channel-title channel-title :elapsed 'timeout))) (dbm-put! db id (write-to-string data))))) ;; Creates a thunk for thread. (define (make-thunk self id uri start-time) (lambda () (with-error-handler (lambda (e) (display (ref e 'message) (current-error-port)) #f) (lambda () (let1 rss (fetch uri) (and rss (let* ((now (sys-time)) (data (list :timestamp now :rss-cache (cdr rss) :channel-title (car rss) :elapsed (- now start-time)))) (with-rss-db self (dbm-put! (ref self 'db) id (write-to-string data))) (cdr rss))) )) ))) ;; Fetch RSS from specified URI, parse it, and extract link information ;; with updated dates. Returns list of items, in ;; (TITLE URI DATETIME) ;; where DATETIME is in time-utc. ;; When error, returns #f. (define (fetch uri) (and-let* ((match (#/^http:\/\/([^\/]+)/ uri)) (server (match 1)) (path (match 'after))) (receive (status headers body) (http-get server path :user-agent USER_AGENT) (and-let* (((equal? status "200")) ((string? body)) (encoding (body-encoding body))) (extract-from-rdf (SSAX:XML->SXML (wrap-with-input-conversion (open-input-string body) encoding) NAMESPACES)))) )) ;; Figure out the encoding of the returned body. At this point, ;; the body might be an incomplete string, so we have to be careful. ;; Returns #f if body is not a valid xml doc. (define (body-encoding body) (and-let* ((body (string-complete->incomplete body)) (before (string-scan body #*"?>" 'before)) (enc (string-scan before #*"encoding=\"" 'after)) (enc2 (string-scan enc #*"\"" 'before))) enc2)) ;; Traverse RDF tree and obtain necessary info. ;; It would be better to use SXPath, but for now... (define (extract-from-rdf sxml) (define (find-node tag parent) (and (pair? parent) (find (lambda (n) (eq? (car n) tag)) (cdr parent)))) (define (filter-node tag parent) (and (pair? parent) (filter (lambda (n) (eq? (car n) tag)) (cdr parent)))) ;; NB: srfi-19's string->date fails to recognize time zone offset ;; with ':' between hours and minutes. I need to parse it manually. (define (parse-date date) (and-let* ((match (#/^(\d\d\d\d)-(\d\d)-(\d\d)(?:T(\d\d):(\d\d)(?::(\d\d))?([+-]\d\d):(\d\d))?/ date))) (receive (year month day hour minute second zh zm) (apply values (map (lambda (i) (x->integer (match i))) (iota 8 1))) (time-second (date->time-utc (make-date 0 second minute hour day month year (* (if (negative? zh) -1 1) (+ (* (abs zh) 3600) (* zm 60)))))) ))) (let* ((rdf (find-node 'rdf:RDF sxml)) (chan (find-node 'rss:channel rdf)) (chan-title (find-node 'rss:title chan)) (items (filter-node 'rss:item rdf))) (cons (and (pair? chan-title) (if (and (pair? (cadr chan-title)) (eq? (caadr chan-title) '@)) (caddr chan-title) (cadr chan-title))) (filter-map (lambda (item) (let ((title (and-let* ((n (find-node 'rss:title item))) (cadr n))) (link (and-let* ((n (find-node 'rss:link item))) (cadr n))) (date (and-let* ((n (find-node 'dc:date item))) (parse-date (cadr n))))) (and title link date (list title link date)))) items))) ) ��������������WiLiKi-0.6.2/src/wiliki/util.scm��������������������������������������������������������������������0000644�0000764�0000764�00000002555�11157576011�015464� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; ;;; wiliki.util - utility functions ;;; ;;; Copyright (c) 2004-2009 Shiro Kawai <shiro@acm.org> ;;; ;;; 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: util.scm,v 1.5 2007-07-14 05:33:20 shirok Exp $ ;;; ;; This module is only kept for backward compatibility. ;; use wiliki.core (provide "wiliki/util") ���������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/src/rssmix.cgi�������������������������������������������������������������������������0000755�0000764�0000764�00000006073�11157576066�014540� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/home/shiro/bin/gosh ;;; ;;; wiliki/rssmix - Fetch and show RSSs ;;; ;;; Copyright (c) 2003-2009 Shiro Kawai <shiro@acm.org> ;;; ;;; 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: rssmix.cgi,v 1.12 2004-05-23 22:57:52 shirok Exp $ ;;; ;; *EXPERIMENTAL* (use wiliki.rssmix) (define (main args) (rss-main (make <rssmix> :sites '(("WiLiKi" "http://www.shiro.dreamhost.com/scheme/wiliki/wiliki.cgi" "http://www.shiro.dreamhost.com/scheme/wiliki/wiliki.cgi?c=rss") ("SchemeXref" "http://www.shiro.dreamhost.com/scheme/wiliki/schemexref.cgi" "http://www.shiro.dreamhost.com/scheme/wiliki/schemexref.cgi?c=rss") ("ねるWiki" "http://www.soraneko.com/~nel/wiliki.cgi" "http://www.soraneko.com/~nel/wiliki.cgi?c=rss") ("スラド" "http://slashdot.jp/" "http://slashdot.jp/slashdot.rdf") ("On Off and Beyond" "http://blog.neoteny.com/chika/" "http://blog.neoteny.com/chika/index.rdf") ("WikiLike" "http://ishinao.net/WikiLike/" "http://ishinao.net/WikiLike/rss.php") ("@pm" "http://gnk.s15.xrea.com/" "http://gnk.s15.xrea.com/index.rdf") ("wiki on ishinao.net" "http://ishinao.net/pukiwiki/" "http://ishinao.net/pukiwiki/?cmd=rss") ("Felio's" "http://zukku.kcl.or.jp/~felio/wiliki/wiliki.cgi" "http://zukku.kcl.or.jp/~felio/wiliki/wiliki.cgi?c=rss") ("Keshi" "http://www.keshi.org/wiliki/wiliki.cgi" "http://www.keshi.org/wiliki/wiliki.cgi?c=rss") ("AnotherLife" "http://ip-solution.ngb.co.jp/cgi-bin/anotherlife.cgi" "http://ip-solution.ngb.co.jp/cgi-bin/anotherlife.cgi?c=rss") ) :title "RSSMix: Recent Entries"))) ;; Local variables: ;; mode: scheme ;; end: ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/NEWS�����������������������������������������������������������������������������������0000644�0000764�0000764�00000000126�11157564760�012423� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������http://practical-scheme.net/wiliki/wiliki.cgi?WiLiKi%3a%b9%b9%bf%b7%cd%fa%ce%f2&l=jp ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/test/����������������������������������������������������������������������������������0000755�0000764�0000764�00000000000�11501274533�012671� 5����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/test/edit.scm��������������������������������������������������������������������������0000644�0000764�0000764�00000000217�10741672221�014323� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������;; test wiliki.edit (use gauche.test) (test-start "edit") (use wiliki.edit) (test-module 'wiliki.edit) ;; more tests to come... (test-end) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/test/auth.scm��������������������������������������������������������������������������0000644�0000764�0000764�00000005436�11321030264�014335� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������(use gauche.test) (use gauche.version) (use gauche.parameter) (use srfi-13) (use file.util) (test-start "auth") (when (version<=? (gauche-version) "0.9") ; auth requires 0.9.1 and later (test-end) (exit)) (use wiliki.auth) (test-module 'wiliki.auth) (auth-db-path (sys-normalize-pathname "pw.o" :absolute #t)) (sys-unlink (auth-db-path)) (test-section "password management") (test* "new user" #t (begin (auth-new-user "shiro" "humuhumunukunkuapua`a") (file-exists? (auth-db-path)))) (test* "check pass" #t (auth-valid-password? "shiro" "humuhumunukunkuapua`a")) (test* "check pass (bad pass)" #f (auth-valid-password? "shiro" "humuhumu")) (test* "check pass (wrong user)" #f (auth-valid-password? "kuro" "humuhumunukunkuapua`a")) (test* "more user" #t (begin (auth-new-user "kuro" "opakapaka") (and (auth-valid-password? "shiro" "humuhumunukunkuapua`a") (auth-valid-password? "kuro" "opakapaka")))) (test* "new user / dupe" (test-error <auth-failure>) (auth-new-user "shiro" "mahimahi")) (test* "new user / too short password" (test-error <auth-failure>) (auth-new-user "midori" "ahi")) (test* "change pass" '(#f #t) (begin (auth-change-password "shiro" "mahimahi") (list (auth-valid-password? "shiro" "humuhumunukunkuapua`a") (auth-valid-password? "shiro" "mahimahi")))) (test* "change pass / no user" (test-error <auth-failure>) (auth-change-password "midori" "papaikualoa")) (test* "change pass / too short password" (test-error <auth-failure>) (auth-change-password "shiro" "moi")) (sys-unlink (auth-db-path)) (test-section "session management") (remove-files "_test") (parameterize ([temporary-directory "_test"]) (make-directory* (temporary-directory)) (let1 key #f (test* "new-session" #t (begin (set! key (auth-new-session "ahi poke")) (file-exists? (build-path (temporary-directory) #`"wiliki-,(string-take key 6)")))) (test* "get-session" "ahi poke" (auth-get-session key)) (test* "another session" "opah" (auth-get-session (auth-new-session "opah"))) (test* "double check" "ahi poke" (auth-get-session key)) (test* "delete-session" 1 (begin (auth-delete-session key) (length (glob (build-path (temporary-directory) "wiliki-*"))))) (test* "clean-sessions" 1 (begin (auth-clean-sessions 3600) (length (glob (build-path (temporary-directory) "wiliki-*"))))) (test* "clean-sessions" 0 (begin (auth-clean-sessions -10) (length (glob (build-path (temporary-directory) "wiliki-*"))))) )) (remove-files "_test") (test-end) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/test/rss.scm���������������������������������������������������������������������������0000644�0000764�0000764�00000000230�11116205744�014177� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������;; test wiliki.rss (use gauche.test) (use wiliki) (test-start "rss") (use wiliki.rss) (test-module 'wiliki.rss) ;; more tests to come... (test-end) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/test/log.scm���������������������������������������������������������������������������0000644�0000764�0000764�00000037014�10741672221�014164� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������;; test the logger (use gauche.test) (use srfi-1) ;;------------------------------------------------ (test-start "logger") (use wiliki.log) (test-module 'wiliki.log) (sys-unlink "logger.log") ;; Data preparation (define page1-1 "In this chapter I describe a few Gauche's design concepts that help you to understand how Gauche works. @menu @end menu ") (define page1-1-log "C \"Page1\" 1234567890 \"1.2.3.4\" \"shiro\" L Created A1-5 . ") (define page1-2 "In this chapter I describe a few Gauche's design concepts that help you to understand how Gauche works. @menu * Standard conformance:: * Multibyte Strings:: * Case-sensitivity:: * Integerated Object System:: * Module system:: * Compilation:: @end menu ") (define page1-2-log "C \"Page1\" 1234567891 \"1.2.3.4\" \"shirok\" L Added menu items A5-10 . ") (define page1-3 "In this chapter, I'll describe a few Gauche's design concepts that help you to understand how Gauche works. Each subsection contains links to the relevant pages of this reference manual. @menu * Standard conformance:: * Multibyte Strings:: * Case-sensitivity:: * Integerated Object System:: @end menu ") (define page1-3-log "C \"Page1\" 1234567892 \"1.2.3.4\" \"shiro\" L Some L fixes A1,3-4 D1 In this chapter I describe a few Gauche's design concepts D3 D9 * Module system:: D10 * Compilation:: . ") (define page2-1 "This is the fastest and finest predicate. Returns @code{#t} if @var{obj1} and @var{obj2} are allocated objects of the same types, and denote the same location. Returns @code{#t} if both objects are @code{#f}, @code{#t}, or @code{()}. You can think @var{eq?} as a pointer comparison. Note that the result is unspecified in Scheme standard when both objects are characters or numbers. ") (define page2-2 "This is the fastest and finest predicate. Returns #t if obj1 and obj2 are allocated objects of the same types, and denote the same location. Returns @code{#t} if both objects are @code{#f}, @code{#t}, or @code{()}. You can think @var{eq?} as a pointer comparison. When @var{obj1} and @var{obj2} are both exact or both inexact numbers, @var{eqv?} returns @code{#t} iff @code{(= @var{obj1} @var{obj2})} is true. Note that the result is unspecified in Scheme standard when both objects are characters or numbers. By defining the method, users can extend the behavior of @code{equal?} for user-defined classes. ") ;; Create log entries ------------------------------------------- (test-section "wiliki-log-create") (test* "page1-1" page1-1-log (wiliki-log-create "Page1" page1-1 "" :timestamp 1234567890 :message "Created" :remote-addr "1.2.3.4" :remote-user "shiro")) (test* "page1-2" page1-2-log (wiliki-log-create "Page1" page1-2 page1-1 :timestamp 1234567891 :message "Added menu items\n" :remote-addr "1.2.3.4" :remote-user "shirok")) (test* "page1-3" page1-3-log (wiliki-log-create "Page1" page1-3 page1-2 :timestamp 1234567892 :message "Some\nfixes" :remote-addr "1.2.3.4" :remote-user "shiro")) ;; Prepare log file (with-output-to-file "logger.log" (lambda () (display page1-1-log) (display (wiliki-log-create "Page2" page2-1 "" :timestamp 1234567890 :message "Another\npage.\n" :remote-addr "3.4.5.6" :remote-user "U.N.Owen")) (display page1-2-log) (display page1-3-log) (display (wiliki-log-create "Page2" page2-2 page2-1 :timestamp 1234567895 :message "Added noise\n" :remote-addr "3.4.5.6" :remote-user "U.N.Owen")))) ;; Scan log file ------------------------------------------- (test-section "wiliki-log-pick & parse") (define picked1 (map (lambda (s) (call-with-input-string s port->string-list)) (list page1-3-log page1-2-log page1-1-log))) (test* "pick page1" picked1 (call-with-input-file "logger.log" (cut wiliki-log-pick "Page1" <>))) (test* "parse" '("Page1" 1234567892 "1.2.3.4" "shiro" "Some\nfixes" (1 3 4) ((1 . "In this chapter I describe a few Gauche's design concepts") (3 . "") (9 . "* Module system:: ") (10 . "* Compilation:: "))) (let1 e (wiliki-log-parse-entry (car picked1)) (map (cut ref e <>) '(pagename timestamp remote-addr remote-user log-message added-lines deleted-lines)))) ;; Diff & revert ------------------------------------------- (test-section "wiliki-log-diff & revert") (test* "diff 1-3 vs 1-2" '((+ . "In this chapter, I'll describe a few Gauche's design concepts") (- . "In this chapter I describe a few Gauche's design concepts") "that help you to understand how Gauche works." (+ . "Each subsection contains links to the relevant pages of this reference") (+ . "manual.") (- . "") "@menu" "* Standard conformance:: " "* Multibyte Strings:: " "* Case-sensitivity:: " "* Integerated Object System:: " (- . "* Module system:: ") (- . "* Compilation:: ") "@end menu") (wiliki-log-diff (wiliki-log-parse-entry (car picked1)) page1-3)) (test* "diff 1-2 vs 1-1" '("In this chapter I describe a few Gauche's design concepts" "that help you to understand how Gauche works." "" "@menu" (+ . "* Standard conformance:: ") (+ . "* Multibyte Strings:: ") (+ . "* Case-sensitivity:: ") (+ . "* Integerated Object System:: ") (+ . "* Module system:: ") (+ . "* Compilation:: ") "@end menu") (wiliki-log-diff (wiliki-log-parse-entry (cadr picked1)) page1-2)) (test* "diff 1-1 vs none" '((+ . "In this chapter I describe a few Gauche's design concepts") (+ . "that help you to understand how Gauche works.") (+ . "") (+ . "@menu") (+ . "@end menu")) (wiliki-log-diff (wiliki-log-parse-entry (caddr picked1)) page1-1)) (test* "revert 1-3 to 1-2" page1-2 (string-join (wiliki-log-revert (wiliki-log-parse-entry (car picked1)) page1-3) "\n" 'suffix)) (test* "revert 1-3 to 1-1 (use after)" page1-1 (string-join (wiliki-log-revert* (wiliki-log-entries-after picked1 1234567890) page1-3) "\n" 'suffix)) (test* "revert 1-3 to 1-2 (use after)" page1-2 (string-join (wiliki-log-revert* (wiliki-log-entries-after picked1 1234567891) page1-3) "\n" 'suffix)) (test* "revert 1-3 to 1-3 (use after)" page1-3 (string-join (wiliki-log-revert* (wiliki-log-entries-after picked1 1234567892) page1-3) "\n" 'suffix)) (test* "revert 1-3 to 1-3 (use after)" page1-3 (string-join (wiliki-log-revert* (wiliki-log-entries-after picked1 1234567893) page1-3) "\n" 'suffix)) (test* "revert 1-3 to none" "" (string-join (wiliki-log-revert* (wiliki-log-entries-after picked1 0) page1-3) "\n" 'suffix)) (test* "revert 2-2 to 2-1" page2-1 (let1 picked (call-with-input-file "logger.log" (cut wiliki-log-pick "Page2" <>)) (string-join (wiliki-log-revert (wiliki-log-parse-entry (car picked)) page2-2) "\n" 'suffix))) ;; Merge ------------------------------------------------- (test-section "wiliki-log-merge") (define (mg a b c) (values-ref (wiliki-log-merge a b c) 0)) ;; trivial cases ;; Argh.. due to the bug in util.lcs, this edge case doesn't work (for now). '(test* "trivial merge 0" '() (mg '() '() '())) (test* "trivial merge 1" '("a") (mg '("a") '("a") '("a"))) (test* "trivial merge 2" '("a" "b") (mg '("a" "b") '("a" "b") '("a" "b"))) (test* "trivial merge 3" '("a" "b" "c") (mg '("a" "b" "c") '("a" "b" "c") '("a" "b" "c"))) ;; single edits (test* "single merge 0" '("a" "b" "c" "d") (mg '("a" "b") '("a" "b") '("a" "b" "c" "d"))) (test* "single merge 1" '("a" "b" "c" "d") (mg '("a" "b") '("a" "b" "c" "d") '("a" "b"))) (test* "single merge 2" '("a" "b" "c" "d") (mg '("a") '("a") '("a" "b" "c" "d"))) (test* "single merge 3" '("a" "b" "c" "d") (mg '("a") '("a" "b" "c" "d") '("a"))) (test* "single merge 4" '("a" "b" "c" "d") (mg '("b") '("b") '("a" "b" "c" "d"))) (test* "single merge 5" '("a" "b" "c" "d") (mg '("b") '("a" "b" "c" "d") '("b"))) (test* "single merge 6" '("a" "b" "c" "d") (mg '("d") '("d") '("a" "b" "c" "d"))) (test* "single merge 7" '("a" "b" "c" "d") (mg '("d") '("a" "b" "c" "d") '("d"))) '(test* "single merge 8" '("a" "b" "c" "d") (mg '() '() '("a" "b" "c" "d"))) '(test* "single merge 9" '("a" "b" "c" "d") (mg '() '("a" "b" "c" "d") '())) ;; delete & delete (test* "delete&delete 0" '("a" "d") (mg '("a" "b" "c" "d") '("a" "b" "d") '("a" "c" "d"))) (test* "delete&delete 1" '("a" "d") (mg '("a" "b" "c" "d") '("a" "c" "d") '("a" "b" "d"))) (test* "delete&delete 2" '("b" "c") (mg '("a" "b" "c" "d") '("a" "b" "c") '("b" "c" "d"))) (test* "delete&delete 3" '("b" "c") (mg '("a" "b" "c" "d") '("b" "c" "d") '("a" "b" "c"))) (test* "delete&delete 4" '("a" "b") (mg '("a" "b" "c" "d") '("a" "b" "d") '("a" "b" "c"))) (test* "delete&delete 5" '("a" "b") (mg '("a" "b" "c" "d") '("a" "b" "c") '("a" "b" "d"))) (test* "delete&delete 6" '("b") (mg '("a" "b" "c" "d") '("a" "b" "d") '("b" "c"))) (test* "delete&delete 7" '("b") (mg '("a" "b" "c" "d") '("b" "c" "d") '("a" "b"))) (test* "delete&delete 8" '() (mg '("a" "b" "c" "d") '("a" "b") '("c" "d"))) (test* "delete&delete 9" '() (mg '("a" "b" "c" "d") '("a" "c") '("b" "d"))) (test* "delete&delete 10" '() (mg '("a" "b" "c" "d") '("a" "d") '("b" "c"))) (test* "delete&delete 11" '("a" "b") (mg '("a" "b" "c" "d") '("a" "b") '("a" "b"))) (test* "delete&delete 12" '("b" "c") (mg '("a" "b" "c" "d") '("b" "c") '("b" "c" "d"))) (test* "delete&delete 13" '("b" "c") (mg '("a" "b" "c" "d") '("a" "b" "c") '("b" "c"))) (test* "delete&delete 14" '() (mg '("a" "b" "c" "d") '() '())) (test* "delete&delete 15" '() (mg '("a" "b" "c" "d") '() '("a" "b" "c" "d"))) (test* "delete&delete (conflict) 0" '((a "d") (b "a")) (mg '("a" "b" "c" "d") '("d") '("a"))) (test* "delete&delete (conflict) 1" '((a "b") (b "c")) (mg '("a" "b" "c" "d") '("b") '("c"))) (test* "delete&delete (conflict) 2" '("a" (a "c") (b "d")) (mg '("a" "b" "c" "d") '("a" "c") '("a" "d"))) (test* "delete&delete (conflict) 3" '((a "a") (b "c") "d") (mg '("a" "b" "c" "d") '("a" "d") '("c" "d"))) (test* "delete&delete (conflict) 4" '("a" (a "c" "e") (b "d" "f")) (mg '("a" "b" "c" "d" "e" "f") '("a" "c" "e") '("a" "d" "f"))) (test* "delete&delete (conflict) 5" '("a" (a "c" "d") (b "e" "f")) (mg '("a" "b" "c" "d" "e" "f") '("a" "c" "d") '("a" "e" "f"))) ;; This test actually shows the deficiencies of the current algorithm, ;; which is forward-only. To get more plausible result, ;; ((a "a" "b") (b "c" "d") "f"), we need to merge hunk backwards from ;; the common line "f". (test* "delete&delete (conflict) 6" '((b "c" "d") "f") (mg '("a" "b" "c" "d" "e" "f") '("a" "b" "f") '("c" "d" "f"))) ;; add & add (test* "add&add (non conflict) 0" '("a" "b" "c" "d") (mg '("b" "c") '("a" "b" "c") '("b" "c" "d"))) (test* "add&add (non conflict) 1" '("a" "b" "c" "d" "e" "f") (mg '("a" "c" "d" "f") '("a" "b" "c" "d" "f") '("a" "c" "d" "e" "f"))) (test* "add&add (non conflict) 2" '("a" "b" "c" "d" "e" "f") (mg '("c" "e") '("a" "b" "c" "e") '("c" "d" "e" "f"))) (test* "add&add (non conflict) 3" '("a" "b" "c" "d") (mg '("a" "d") '("a" "b" "c" "d") '("a" "b" "c" "d"))) (test* "add&add (non conflict) 4" '("a" "b" "c" "d") (mg '("d") '("a" "b" "c" "d") '("a" "b" "c" "d"))) (test* "add&add (non conflict) 5" '("a" "b" "c" "d") (mg '("a") '("a" "b" "c" "d") '("a" "b" "c" "d"))) (test* "add&add (non conflict) 6" '("a" "b" "c" "d") (mg '() '("a" "b" "c" "d") '("a" "b" "c" "d"))) (test* "add&add (conflict) 0" '("a" (a "b" "d") (b "c" "d") "e") (mg '("a" "e") '("a" "b" "d" "e") '("a" "c" "d" "e"))) (test* "add&add (conflict) 1" '((a "a" "b") (b "a") "c" "d" "e" "f") (mg '("c" "e") '("a" "b" "c" "e") '("a" "c" "d" "e" "f"))) (test* "add&add (conflict) 2" '("a" "b" "c" (a "d" "e") (b "d" "f")) (mg '("a" "b" "c") '("a" "b" "c" "d" "e") '("a" "b" "c" "d" "f"))) (test* "add&add (conflict) 3" '((a "a" "b") (b "b" "c")) (mg '() '("a" "b") '("b" "c"))) (test* "add&add (conflict) 4" '("a" "b" (a "c" "d") (b "e" "f")) (mg '("a" "b") '("a" "b" "c" "d") '("a" "b" "e" "f"))) (test* "add&add (conflict) 4" '((a "x" "y") (b "z" "w") "a" "b") (mg '("a" "b") '("x" "y" "a" "b") '("z" "w" "a" "b"))) ;; add & delete (test* "add&delete 0" '("z" "a" "b") (mg '("a" "b" "c" "d") '("z" "a" "b") '("a" "b" "c" "d"))) (test* "add&delete 1" '("z" "a" "b" (b "c")) (mg '("a" "b" "c" "d") '("z" "a" "b") '("a" "b" "c"))) (test* "add&delete 2" '("z" "a" "b" (a "d")) (mg '("a" "b" "c" "d") '("a" "b" "d") '("z" "a" "b"))) (test* "add&delete 3" '("z" "a" "b" (b "d" "e")) (mg '("a" "b" "c" "d") '("z" "a" "b") '("a" "b" "d" "e"))) (test* "add&delete 4" '("z" "a" "b" "d" "e") (mg '("a" "b" "c" "d") '("z" "a" "b" "d") '("a" "b" "d" "e"))) (test* "add&delete 5" '("z" "a" "b" (a "d") "e") (mg '("a" "b" "c" "d" "e") '("a" "b" "d" "e") '("z" "a" "b" "e"))) (test* "add&delete 6" '((b "A" "a") "b" "c" (a "C" "d")) (mg '("a" "b" "c" "d") '("b" "c" "C" "d") '("A" "a" "b" "c"))) (test* "add&delete 7" '("a" (a "P" "Q") (b "R" "Q") "d") (mg '("a" "b" "c" "d") '("a" "P" "Q" "d") '("a" "R" "Q" "d"))) ;; Should probably be ("a" (b "b") "S" "T" (a "d") "e" "f") (test* "add&delete 8" '("a" (a "S" "T" "d" "e" "f") (b "b" "S" "T" "e" "f")) (mg '("a" "b" "c" "d") '("a" "S" "T" "d" "e" "f") '("a" "b" "S" "T" "e" "f"))) ;; other patterns (test* "other 0" '("b" "a") (mg '("a" "b") '("b" "a") '("b" "a"))) ;; This seems interesting. It is thought that the third list is ;; created by deleting first line, and adding "a" to the last. Since ;; the second list isn't changed, the last edit takes effect. (test* "other 1" '("b" "a") (mg '("a" "b") '("a" "b") '("b" "a"))) (test* "other 2" '("c" "b" "a") (mg '("a" "b" "c") '("c" "b" "a") '("c" "b" "a"))) ;; Probably the first "c" should be factored out. (test* "other 3" '((a "c" "b") (b "c") "a" (b "b")) (mg '("a" "b" "c") '("c" "b" "a") '("c" "a" "b"))) (test* "other 4" '("d" "c" "b" "a") (mg '("a" "b" "c" "d") '("d" "c" "b" "a") '("d" "c" "b" "a"))) (test* "other 5" '("d" "b" "c" "a") (mg '("a" "b" "c" "d") '("d" "b" "c" "a") '("d" "b" "c" "a"))) (test* "other 6" '((a "d" "b" "c" "a") (b "d" "c" "b" "a")) (mg '("a" "b" "c" "d") '("d" "b" "c" "a") '("d" "c" "b" "a"))) (test-end) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/test/Makefile.in�����������������������������������������������������������������������0000644�0000764�0000764�00000000654�11501262237�014741� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������GOSH = "@GOSH@" TEST_OUT = test.log logger.log test.dbm _test TESTS = core.scm format.scm log.scm edit.scm rss.scm auth.scm test-wiliki.scm all: gosh-path gosh-path : echo $(GOSH) > gosh-path check : all @rm -rf $(TEST_OUT) @for t in $(TESTS); do \ $(GOSH) -I. -I../src $$t >> test.log; \ done clean : rm -rf core gosh-path $(TEST_OUT) *~ distclean : clean rm -f Makefile maintainer-clean : clean rm -f Makefile ������������������������������������������������������������������������������������WiLiKi-0.6.2/test/core.scm��������������������������������������������������������������������������0000644�0000764�0000764�00000000337�10741672221�014331� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������;; test wiliki.core (use gauche.test) (test-start "core") (use wiliki.core) (test-module 'wiliki.core) (test* "constructor" '<wiliki> (class-name (class-of (make <wiliki>)))) ;; more tests to come... (test-end) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/test/test-bin.scm����������������������������������������������������������������������0000644�0000764�0000764�00000006473�10741672221�015135� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������;; test wiliki tool ;; $Id: test-bin.scm,v 1.1 2004-04-03 13:42:54 shirok Exp $ (use gauche.test) (use gauche.process) (use gauche.version) (use file.util) (use sxml.ssax) (use sxml.sxpath) (when (version<=? (gauche-version) "0.7.3") ;; need some modules that aren't available until later. (add-load-path "../util")) (use sxml.xml-test) (use www.cgi-test) (sys-system "rm -rf _test") (define (command . args) `("gosh" "-I" "../src" "../bin/wiliki" ,@args)) (test-start "wiliki tool") ;; creating test data (make-directory* "_test/text") (with-output-to-file "_test/text/t0.txt" (lambda () (print "TestPage0") (print "") (print "* The test page") (print "WikiLinks") (print "- [[TestPage1]]") )) (define *t0* '(html (head (title "TestPage0")) (body (h1 "TestPage0") (h2 ?@ "The test page\n") (p "WikiLinks\n") (ul (li (a (@ (href "TestPage1")) "TestPage1")))))) (with-output-to-file "_test/text/t1.txt" (lambda () (print "Test/Page?<>") (print "zzz") )) (define *t1* '(html (head (title "Test/Page?<>")) (body (h1 "Test/Page?<>") (p "zzz\n")))) (test-section "help") (test* "wiliki" #t (let1 s (process-output->string-list (command)) (and (pair? s) (#/^Usage: wiliki <command>/ (car s)) #t))) (test* "wiliki help format" #t (let1 s (process-output->string-list (command "help" "format")) (and (pair? s) (#/^Usage: wiliki format/ (car s)) #t))) (test-section "format") (test* "wiliki format text" *t0* (let* ((r (string-join (process-output->string-list (command "format" "_test/text/t0.txt")) "\n" 'suffix)) (s (call-with-input-string r (cut ssax:xml->sxml <> '())))) (car ((sxpath '(html)) s))) test-sxml-match?) (test* "wiliki format text" *t1* (let* ((r (string-join (process-output->string-list (command "format" "_test/text/t1.txt")) "\n" 'suffix)) (s (call-with-input-string r (cut ssax:xml->sxml <> '())))) (car ((sxpath '(html)) s))) test-sxml-match?) (test* "wiliki format text to file" *t0* (let* ((p (apply run-process (command "format" "-o" "_test/t0.html" "_test/text/t0.txt"))) (r (process-wait p)) (s (call-with-input-file "_test/t0.html" (cut ssax:xml->sxml <> '())))) (car ((sxpath '(html)) s))) test-sxml-match?) (test* "wiliki format dir" `(t ,*t0* ,*t1*) (let* ((p (apply run-process (command "format" "_test/text" "_test/html"))) (r (process-wait p)) (f0 "_test/html/TestPage0.html") (f1 "_test/html/Test_2FPage_3F_3C_3E.html") (s0 (and (file-exists? f0) (call-with-input-file f0 (cut ssax:xml->sxml <> '())))) (s1 (and (file-exists? f1) (call-with-input-file f1 (cut ssax:xml->sxml <> '())))) ) `(t ,@(append ((sxpath '(html)) s0) ((sxpath '(html)) s1)))) test-sxml-match?) (test-end) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/test/format.scm������������������������������������������������������������������������0000644�0000764�0000764�00000046223�10741672221�014675� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������;; test the formatter (use gauche.test) (use text.tree) ;;------------------------------------------------ (test-start "formatter") (use wiliki.format) (test-module 'wiliki.format) ;;------------------------------------------------ (test-section "scanner") ;; test line scanner (define (scan string) (call-with-input-string string (lambda (p) (port-map identity (with-module wiliki.parse (make-line-scanner p)))))) (test* "normal" '() (scan "")) (test* "normal" '("a" "b" "c" "d") (scan "a\nb\nc\nd\n")) (test* "normal" '("" "b" "c" "d") (scan "\nb\nc\nd")) (test* "comment" '("b" "c" "d") (scan ";;a\nb\nc\nd\n")) (test* "comment" '("a" "c" "d") (scan "a\n;;b\nc\nd\n")) (test* "comment" '("a") (scan "a\n;;b\n;;c\n;;d\n")) (test* "line continuation" '("ab" "cd") (scan "a\n~b\nc\n~d\n")) (test* "line continuation" '("a" "cd") (scan "a\n~\nc\n~d\n")) (test* "line continuation" '("a" "b" "cd") (scan "~a\nb\nc\n~d\n")) (test* "line continuation+comment" '("acd") (scan "a\n;;b\n~c\n~d\n")) (test* "line continuation+comment" '("abd") (scan "a\n~b\n;;c\n~d\n")) (test* "line continuation+comment" '("ab") (scan "a\n~b\n;;c\n;;d\n")) (test* "line continuation+comment" '("bd") (scan ";;a\n~b\n;;c\n~d\n")) (test* "verbatim" '("a" "{{{" "~b" ";;c" "}}}" "d") (scan "a\n{{{\n~b\n;;c\n}}}\n~d\n")) (test* "verbatim" '("{{{" "~b" ";;c" "}}}") (scan "{{{\n~b\n;;c\n}}}\n")) (test* "verbatim" '("{{{" "}}}") (scan "{{{\n}}}\n")) (test* "verbatim" '("a}}}") (scan "a\n~}}}\n")) (test* "verbatim" '("a") (scan "a\n;;}}}\n")) (test* "verbatim" '("a" "}}}") (scan "a\n;;b\n}}}\n")) ;;------------------------------------------------ ;; Preparation of contents parsing ;; compare method ;; we assume the result is well-formed, and use ssax to parse the ;; output. (use sxml.ssax) (define-macro (tf label expected-sxml code) `(test ,label ,expected-sxml (lambda () (cadr ;; remove (*TOP* ...) (call-with-input-string (tree->string ,code) (cut ssax:xml->sxml <> '())))))) (define (page . lines) (string-join lines "\n" 'suffix)) (define-macro (tp label expected-sxml page) `(tf ,label ,expected-sxml (list "<result>" (map wiliki:sxml->stree (wiliki:format-content ,page)) "</result>"))) ;;------------------------------------------------ (test-section "inline elements") (tp "paragraph" '(result (p "hoge\n")) (page "hoge")) (tp "paragraph" '(result (p "hoge\n") (p "huge\n")) (page "hoge" "" "huge")) (tp "paragraph" '(result (p "hoge\nmoge\n") (p "huge\n")) (page "hoge" "moge" "" "huge")) (tp "paragraph" '(result (p "hoge\n") (p "huge\n")) (page "" "hoge" "" "" "" "huge" "" "")) (tp "em" '(result (p "foo" (em "bar") "baz\n")) (page "foo''bar''baz")) (tp "em" '(result (p (em "foo") "bar" (em "baz"))) (page "''foo''bar''baz''")) (tp "em" '(result (p (em "foo") (em "bar") "baz''\n")) (page "''foo''''bar''baz''")) (tp "em" '(result (p "''foo\nbar''\n")) (page "''foo" "bar''")) (tp "em(empty)" '(result (p "foo\n")) (page "''''foo")) (tp "strong" '(result (p "foo" (strong "bar") "baz\n")) (page "foo'''bar'''baz")) ;; nested em and strong isn't supported well '(tp "strong" '(result (p (em "foo" (strong "bar") "baz") "'\n")) (page "''foo'''bar'''baz'''")) (tp "strong" '(result (p "'" (strong "foo") "'\n")) (page "''''foo''''")) (tp "strong" '(result (p "'" (strong "foo") "'\n")) (page "''''foo''''")) (tp "strong(empty)" '(result (p "foo\n")) (page "''''''foo")) (tp "url" '(result (p (a (@ (href "http://foo")) "http://foo"))) (page "http://foo")) (tp "url" '(result (p (a (@ (href "http://foo?abc")) "http://foo?abc"))) (page "http://foo?abc")) (tp "url" '(result (p (a (@ (href "http://foo#abc")) "http://foo#abc"))) (page "http://foo#abc")) (tp "url" '(result (p (a (@ (href "http://foo/?bar#abc")) "http://foo/?bar#abc"))) (page "http://foo/?bar#abc")) (tp "url" '(result (p "(" (a (@ (href "http://foo/?bar")) "http://foo/?bar") " )\n")) (page "(http://foo/?bar )")) (tp "url" '(result (p "aaa " (a (@ (href "https://foo")) "https://foo"))) (page "aaa https://foo ")) (tp "url" '(result (p (a (@ (href "mailto:aa@bb.cc")) "mail here"))) (page "[mailto:aa@bb.cc mail here]")) (tp "br" '(result (p "aaa" (br) "bbb\n")) (page "aaa~%bbb")) (tp "br" '(result (p (em "aaa" (br) "bbb"))) (page "''aaa~%bbb''")) (tp "anchor" '(result (p (a (@ (href "http://foo")) "bar"))) (page "[http://foo bar]")) (tp "anchor" '(result (p (a (@ (href "http://foo?bar")) "bar"))) (page "[http://foo?bar bar]")) (tp "anchor" '(result (p (a (@ (href "http://foo#bar")) "bar"))) (page "[http://foo#bar bar]")) (tp "nested" '(result (p (strong "bb " (a (@ (href "http://foo")) "baz") "zz"))) (page "'''bb [http://foo baz]zz'''")) ;;------------------------------------------------ (test-section "metasyntax") (tp "comment" '(result (p "hoge\n")) (page ";;comment1" "hoge" ";;comment2")) (tp "line continuation" '(result (p "hogefuga\n")) (page "hoge" "~fuga")) (tp "line continuation" '(result (p "hogefuga\n")) (page "hoge" "~" "~fuga")) (tp "line continuation" '(result (p "hoge;;fuga\n")) (page "hoge" ";;" "~;;fuga")) (tp "line continuation" '(result (p (em "hogefuga"))) (page "''hoge" ";;" "~fuga''")) (tp "line continuation" '(result (p (em "hogefugamoga"))) (page "''hoge" "~fuga" ";;" "~moga''")) (tp "line continuation" '(result (p "''hogefuga\nmoga''\n")) (page "''hoge" "~fuga" ";;" "moga''")) ;;------------------------------------------------ (test-section "block elements (pre)") (tp "pre" '(result (pre " abc\n def\n efg\n")) (page " abc" " def" " efg")) (tp "pre" '(result (p "aaa\n") (pre " abc\n def\n efg\n") (p "bbb\n")) (page "aaa" " abc" " def" " efg" "bbb")) (tp "pre" '(result (pre " abc" (em "def") "ghi\n")) (page " abc''def''ghi")) (tp "pre" '(result (pre " abc\n") (p "def\n") (pre " ghi\n")) (page " abc" "def" " ghi")) (tp "pre" '(result (pre " abc\n") (p "def\n") (pre " ghi\n")) (page " abc" "def" " ghi")) (tp "pre" '(result (pre " abcdef\n jkl\n")) (page " abc" "~def" ";;ghi" " jkl")) (tp "verb" '(result (p "aaa\n") (pre ";;bbb\n ccc''ccc''ccc\n- ddd\n~eee\n") (p "bbb\n")) (page "aaa" "{{{" ";;bbb" " ccc''ccc''ccc" "- ddd" "~eee" "}}}" "bbb")) (tp "stray verb closer" '(result (p "aaa\n}}}\nbbb\n")) (page "aaa" "}}}" "bbb")) (tp "unfinished verb opener" '(result (p "aaa\n") (pre "bbb\n")) (page "aaa" "{{{" "bbb")) (tp "expanding tabs in verb" '(result (pre " 1234 bbb\n1 12345 bbb\n12 123456 bbb\n123 1234567 bbb\n1234 12345678 bbb\n")) (page "{{{" "\t1234\tbbb" "1\t12345\tbbb" "12\t123456\tbbb" "123\t1234567\tbbb" "1234\t12345678\tbbb" "}}}")) ;;------------------------------------------------ (test-section "block elements (ul&ol)") (tp "ul" '(result (p "abc\n") (ul (li "def\n") (li "ghi\n")) (p "hij\n")) (page "abc" "- def" "- ghi" "" "hij")) (tp "ul & p" '(result (p "abc\n") (ul (li "def\nghi\n")) (p "hij\n")) (page "abc" "- def" "ghi" "" "hij")) (tp "ul & p" '(result (p "abc\n") (ul (li "def\n ghi\n")) (p "hij\n")) (page "abc" "- def" " ghi" "" "hij")) (tp "ul & inline" '(result (ul (li "abc" (em "def") (strong "ghi") "jkl\n"))) (page "- abc''def''" "'''ghi'''jkl")) (tp "ul (jump down)" '(result (p "abc\n") (ul (ul (li "def\n") (li "ghi\njkl\n")))) (page "abc" "-- def" "-- ghi" "jkl")) (tp "ul (jump up)" '(result (ul (ul (ul (li "def\n"))) (li "ghi\njkl\n"))) (page "--- def" "- ghi" "jkl")) (tp "ul (complicated)" '(result (p "abc\n") (ul (li "def\n" (ul (li "ghi\njkl\n") (li "mno\npqr\n"))) (li "stu\n" (ul (li "vwx\n") (li "yz\n"))))) (page "abc" "- def" "-- ghi" "jkl" "-- mno" "pqr" "- stu" "-- vwx" "-- yz")) (tp "ul (complicated)" '(result (ul (li "abc\n" (ul (ul (ul (li "def\n"))) (li "ghi\n"))) (li "jkl\n")) (ul (li "xyz\n"))) (page "- abc" "---- def" "-- ghi" "- jkl" "" "- xyz")) (tp "ol" '(result (p "abc\n") (ol (li "def\n") (li "ghi\njkl\n"))) (page "abc" "# def" "# ghi" "jkl")) (tp "ol (jump down)" '(result (p "abc\n") (ol (ol (ol (ol (li "def\n") (li "ghi\njkl\n")))))) (page "abc" "#### def" "#### ghi" "jkl")) (tp "ol (jump up)" '(result (ol (ol (ol (ol (li "def\n")))) (li "ghi\njkl\n"))) (page "#### def" "# ghi" "jkl")) ;; NB: the lines "A\n" and "B\n" should be enclosed by <p>. (tp "ul & ol" '(result (ul (li "A\n" (ol (li "a\n") (li "b\n")))) (ol (li "B\n" (ul (li "c\n") (li "d\n"))))) (page "- A" "## a" "## b" "" "# B" "-- c" "-- d")) (tp "ul & ol" '(result (ul (li "A\n" (ol (li "a\n")) (ul (li "b\n")))) (ol (li "B\n" (ul (li "c\n")) (ol (li "d\n"))))) (page "- A" "## a" "-- b" "# B" "-- c" "## d")) (tp "ul, ol and other blocks" '(result (pre " aaa\n") (ul (li "A\n" (ol (li "a\naa\n")) (ul (li "b\nbb\n")))) (ol (ol (ol (li "c\ncc\n"))) (ul (li "d\ndd\n")))) (page " aaa" "- A" "## a" "aa" "-- b" "bb" "" "### c" "cc" "-- d" "dd")) (tp "ul, ol and verb" '(result (ul (li "A\n" (pre "abba\nbaab\n") "AA\n") (li "B\n" (pre "cddc\ndccd\n"))) (pre "eee\n")) (page "- A" "{{{" "abba" "baab" "}}}" "AA" "- B" "{{{" "cddc" "dccd" "}}}" "" "{{{" "eee" "}}}")) ;;------------------------------------------------ (test-section "block elements (dl)") (tp "dl" '(result (p "aaa\n") (dl (dt "BBB\n") (dd (p "bbb\n")) (dt "ccc\n") (dd (p "CCC\n") (pre " ddd\n") (p "eee\n")) (dt "fff\n") (dd (p "\nggg\n"))) (p "hhh\n")) (page "aaa" ":BBB:bbb" ":ccc:CCC" " ddd" "eee" ":fff:" "ggg" "" "hhh")) (tp "dl & inline" '(result (dl (dt (a (@ (href "http://foo")) "http://foo")) (dd (p "aaa\nbb" (em "bbb"))))) (page ":http://foo:aaa" "bb''bbb''")) (tp "dl & other list" '(result (ul (ul (li "aaa\n" (dl (dt "bbb\n") (dd (p "ccc\n") (ul (li "ddd\n" (ol (li "eee\n"))))))))) (ol (li "fff\n" (dl (dt "ggg\n") (dd (p)))))) (page "-- aaa" ":bbb:ccc" "--- ddd" "#### eee" "# fff" ":ggg:")) (tp "dl & other list" '(result (ul (li "a\n" (dl (dt "b\n") (dd (p)))) (li "c\n"))) (page "- a" ":b:" "- c")) (tp "dl & other list" '(result (ul (ul (li "a\n" (dl (dt "b\n") (dd (p)))) (li "c\n")))) (page "-- a" ":b:" "-- c")) ;; NB: the last "iii" should be enclosed by <p>. (tp "dl & other blocks" '(result (pre " aaa\n") (dl (dt "bbb\n") (dd (p "ccc\nccc\n") (pre " ddd\n") (pre "eee\nfff\n") (pre "ggg\nhhh\n") (p "iii\n")))) (page " aaa" ":bbb:ccc" "ccc" " ddd" "{{{" "eee" "fff" "}}}" "{{{" "ggg" "hhh" "}}}" "iii")) ;;------------------------------------------------ (test-section "block elements (blockquote)") (tp "blockquote" '(result (p "aaa\n") (blockquote (p "bbb\nccc\n")) (p "ddd\n")) (page "aaa" "<<<" "bbb" "ccc" ">>>" "ddd")) (tp "unclosed blockquote" '(result (blockquote (p "aaa\n"))) (page "<<<" "aaa")) (tp "stray closing blockquote" '(result (p "aaa\n>>>\n")) (page "aaa" ">>>")) (tp "paragraph in blockquote" '(result (blockquote (p "aaa\n") (p "bbb\n") (pre " ccc\n"))) (page "<<<" "aaa" "" "bbb" " ccc" ">>>")) (tp "nested blockquote" '(result (p "aaa\n") (blockquote (p "bbb\n") (blockquote (blockquote (p "ccc\n")) (p "ddd\n")) (p "eee\n")) (p "fff\n")) (page "aaa" "<<<" "bbb" "<<<" "<<<" "ccc" ">>>" "ddd" ">>>" "eee" ">>>" "fff")) (tp "blockquote & lists" '(result (ul (li (blockquote (ul (li "aaa\n"))) "bbb\n") (li (blockquote (p "ccc\n") (ol (li "ddd\n"))))) (ol (li "eee\n"))) (page "- " "<<<" "- aaa" ">>>" "bbb" "- " "<<<" "ccc" "# ddd" ">>>" "# eee")) (tp "blockquote & dl" '(result (blockquote (dl (dt "aaa\n") (dd (p) (blockquote (p "bbb\n") (p "ccc\n")) (p "ddd\n")) (dt "eee\n") (dd (p))) (p "fff\n"))) (page "<<<" ":aaa:" "<<<" "bbb" "" "ccc" ">>>" "ddd" ":eee:" "" "fff")) ;;------------------------------------------------ (test-section "block elements (table)") (tp "basic table" '(result (table (@ (class "inbody") (cellspacing "0") (border "1")) (tr (@ (class "inbody")) (td (@ (class "inbody")) "a\n") (td (@ (class "inbody")) "b\n") (td (@ (class "inbody")) "c\n")) (tr (@ (class "inbody")) (td (@ (class "inbody")) "d\n") (td (@ (class "inbody")) "e\n") (td (@ (class "inbody")) "f\n"))) (table (@ (class "inbody") (cellspacing "0") (border "1")) (tr (@ (class "inbody")) (td (@ (class "inbody")) "g\n") (td (@ (class "inbody")) "h\n") (td (@ (class "inbody")) "i\n")) (tr (@ (class "inbody")) (td (@ (class "inbody")) "j\n") (td (@ (class "inbody")) "k\n") (td (@ (class "inbody")) "l\n")))) (page "||a||b||c||" "||d||e||f||" "" "||g||h||i||" "||j||k||l||") ) (tp "table & other block elements" '(result (blockquote (table (@ (class "inbody") (cellspacing "0") (border "1")) (tr (@ (class "inbody")) (td (@ (class "inbody")) "a\n"))) (ul (li "b\n")) (p "c\n") (table (@ (class "inbody") (cellspacing "0") (border "1")) (tr (@ (class "inbody")) (td (@ (class "inbody")) "d\n"))))) (page "<<<" "||a||" "- b" "" "c" "||d||" ">>>")) ;;------------------------------------------------ (test-section "block elements (hr)") (tp "hr" '(result (p "aa\nbb\n") (hr) (p "cc\ndd\n")) (page "aa" "bb" "----" "cc" "dd")) (tp "hr&pre" '(result (pre " aa\n bb\n") (hr) (pre " cc\n dd\n")) (page " aa" " bb" "----" " cc" " dd")) (tp "hr&list" '(result (ul (li "aa\n")) (hr) (p"cc\ndd\n")) (page "- aa" "----" "cc" "dd")) ;;------------------------------------------------ (test-section "block elements (headings)") (define (hid . lis) (wiliki:calculate-heading-id lis)) (tp "headings" `(result (h2 (@ (id ,(hid "aa"))) "aa\n") (h3 (@ (id ,(hid "bb" "aa"))) "bb\n") (h4 (@ (id ,(hid "cc" "bb" "aa"))) "cc\n") (h5 (@ (id ,(hid "dd" "cc" "bb" "aa"))) "dd\n") (h6 (@ (id ,(hid "ee" "dd" "cc" "bb" "aa"))) "ee\n")) (page "* aa" "** bb" "*** cc" "**** dd" "***** ee")) (tp "headings (id)" `(result (h2 (@ (id ,(hid "aa"))) "aa\n") (h5 (@ (id ,(hid "bb" "aa"))) "bb\n") (h3 (@ (id ,(hid "cc" "aa"))) "cc\n") (h5 (@ (id ,(hid "bb" "cc" "aa"))) "bb\n") (h2 (@ (id ,(hid "bb"))) "bb\n") (h3 (@ (id ,(hid "cc" "bb"))) "cc\n")) (page "* aa" "**** bb" "** cc" "**** bb" "* bb" "** cc")) (tp "headings&list, pre" `(result (p "aaa\n") (h2 (@ (id ,(hid "aa"))) "aa\n") (ul (li "bb\n")) (h3 (@ (id ,(hid "cc" "aa"))) "cc\n") (pre " dd\n") (h4 (@ (id ,(hid "ee" "cc" "aa"))) "ee\n")) (page "aaa" "* aa" "- bb" "** cc" " dd" "*** ee")) ;;------------------------------------------------ (test-section "wikiname") ;; default handler (tp "wikiname" `(result (p "[[aa]]\n")) (page "[[aa]]")) (tp "wikiname" `(result (p "bb[[aa]]\n")) (page "bb[[aa]]")) (tp "wikiname" `(result (p "bb[[aa\n")) (page "bb[[aa")) (tp "wikiname" `(result (p "bb[[aa[[cc\n")) (page "bb[[aa[[cc")) (tp "wikiname" `(result (p "bb[[[[cc\n")) (page "bb[[[[cc")) (tp "wikiname" `(result (p "bb[[[[cc]]\n")) (page "bb[[[[cc]]")) (test-end) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/test/test-wiliki.scm�������������������������������������������������������������������0000644�0000764�0000764�00000040301�11157425313�015641� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������;; ;; test for wiliki ;; ;; $Id: test-wiliki.scm,v 1.15 2007-11-05 21:38:00 shirok Exp $ (use srfi-1) (use srfi-13) (use gauche.test) (use gauche.parameter) (use gauche.version) (use www.cgi) (use sxml.ssax) (use sxml.sxpath) (use rfc.822) (use util.list) (use www.cgi.test) ;; need some modules that aren't available until later. (add-load-path "../util") (use sxml.xml-test) (add-load-path ".") ;; Generates dummy cgi script with parameters (define *gosh-path* (call-with-input-file "gosh-path" read-line)) (define *cgi-path* "_test/w.cgi") (define (generate-cgi . params) (with-output-to-file *cgi-path* (lambda () (print #`"#!,*gosh-path*") (write '(add-load-path "../src")) (write '(use wiliki)) (write `(define (main args) (wiliki-main (make <wiliki> :db-path "_test/testdata.dbm" :top-page "TEST" :title "Test" :description "Test wiliki" :debug-level 1 :language 'en :charsets '((jp . euc-jp) (en . euc-jp)) :image-urls '((#/^http:\/\/sourceforge.net\/sflogo/ allow)) :log-file "testdata.log" ,@params)))) )) (sys-chmod *cgi-path* #o700)) (test-start "wiliki") ;(use wiliki) ;(test-module 'wiliki) (sys-system "rm -rf _test") (sys-mkdir "_test" #o755) (generate-cgi) ;;-------------------------------------------------------- (test-section "basic operation") (test* "initial database generation" '(html (head (title "TEST") (base (@ (href "http://localhost/wiliki.cgi"))) ?*) (body ?@ (h1 (a (@ (href "wiliki.cgi?c=s&key=[[TEST]]")) "TEST")) (div ?*) (div ?*) (hr) (hr) (div ?*))) (values-ref (run-cgi-script->sxml *cgi-path*) 1) (test-sxml-select-matcher '(html))) (test* "base uri test" '(base (@ (href "https://foo.com/cgi-bin/w.cgi"))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((HTTPS . 1) (SERVER_NAME . "foo.com") (SERVER_PORT . 443) (SCRIPT_NAME . "/cgi-bin/w.cgi"))) 1) (test-sxml-select-matcher '(html head base))) (test* "base uri test" '(base (@ (href "http://foo.com:8080/cgi-bin/w.cgi"))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((SERVER_NAME . "foo.com") (SERVER_PORT . 8080) (SCRIPT_NAME . "/cgi-bin/w.cgi"))) 1) (test-sxml-select-matcher '(html head base))) ;;-------------------------------------------------------- (test-section "viewing (1)") (test* "via QUERY_STRING" '(head (!contain (title "TEST"))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "GET") (QUERY_STRING . "TEST"))) 1) (test-sxml-select-matcher '(html head))) (test* "via QUERY_STRING (p)" '(head (!contain (title "TEST"))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "GET") (QUERY_STRING . "p=TEST"))) 1) (test-sxml-select-matcher '(html head))) (test* "via PATH_INFO" '(head (!contain (title "TEST"))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "GET") (PATH_INFO . "/TEST"))) 1) (test-sxml-select-matcher '(html head))) (test* "non-existent page (QUERY_STRING)" '(html (head (!contain (title "Nonexistent page: ZZZ"))) (body (!contain (p "Create a new page: ZZZ" (a (@ (href "wiliki.cgi?p=ZZZ&c=n")) "?"))))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "GET") (QUERY_STRING . "ZZZ"))) 1) (test-sxml-select-matcher '(html))) (test* "non-existent page (QUERY_STRING, p)" '(html (head (!contain (title "Nonexistent page: ZZZ"))) (body (!contain (p "Create a new page: ZZZ" (a (@ (href "wiliki.cgi?p=ZZZ&c=n")) "?"))))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "GET") (QUERY_STRING . "p=ZZZ"))) 1) (test-sxml-select-matcher '(html))) (test* "non-existent page (QUERY_STRING, p)" '(html (head (!contain (title "Nonexistent page: ZZZ"))) (body (!contain (p "Create a new page: ZZZ" (a (@ (href "wiliki.cgi?p=ZZZ&c=n")) "?"))))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "GET") (QUERY_STRING . "p=ZZZ"))) 1) (test-sxml-select-matcher '(html))) (test* "non-existent page (PATH_INFO)" '(html (head (!contain (title "Nonexistent page: ZZZ"))) (body (!contain (p "Create a new page: ZZZ" (a (@ (href "wiliki.cgi?p=ZZZ&c=n")) "?"))))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "GET") (PATH_INFO . "/ZZZ"))) 1) (test-sxml-select-matcher '(html))) ;;-------------------------------------------------------- (test-section "editing") (let ((mtime-save #f)) (test* "edit screen" '(!contain (input (@ (type "submit") (name "preview") ?*)) (input (@ (type "submit") (name "commit") ?*)) (input (@ (type "hidden") (name "c") (value "c"))) (input (@ (type "hidden") (name "p") (value "TEST"))) (input (@ (type "checkbox") (name "donttouch") ?*)) (input (@ (name "mtime") (value ?mtime) ?*)) (textarea (@ (name "content") ?*) ?*)) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "POST")) :parameters '((c . e))) 1) (test-sxml-select-matcher '(html body form (or@ input textarea)) (lambda (alist) (set! mtime-save (x->integer (assq-ref alist '?mtime))) alist))) (test* "committing" '(("status" "302 Moved") ("location" "http://localhost/wiliki.cgi?TEST")) (values-ref (run-cgi-script->string *cgi-path* :environment '((REQUEST_METHOD . "GET")) :parameters `((c . c) (p . "TEST") (commit . "Commit") (mtime . ,mtime-save) (content . "This is a test page. [[LINK]]\r\n"))) 0)) (test* "check commit" '(!contain (p "This is a test page. LINK" (a (@ (href "wiliki.cgi?p=LINK&c=n")) "?"))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "GET")) :parameters '((p . "TEST"))) 1) (test-sxml-select-matcher '(html body p))) ) ;;-------------------------------------------------------- (test-section "creating a new page") (test* "edit screen" '(title "LINK") (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "POST")) :parameters '((c . e) (p . "LINK"))) 1) (test-sxml-select-matcher '(html head title))) (test* "committing" '(("status" "302 Moved") ("location" "http://localhost/wiliki.cgi?LINK")) (values-ref (run-cgi-script->string *cgi-path* :environment '((REQUEST_METHOD . "GET")) :parameters `((c . c) (p . "LINK") (commit . "Commit") (mtime . "") (content . "New page.\r\n[[TEST]]\r\n"))) 0)) (test* "check commit" '(!contain (p "New page.\n" (a (@ (href "wiliki.cgi?TEST")) "TEST"))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "GET")) :parameters '((p . "LINK"))) 1) (test-sxml-select-matcher '(html body p))) (test* "viewing check (PATH_INFO and QUERY_STRING mixed)" '(head (!contain (title "LINK"))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "GET") (PATH_INFO . "/LINK") (QUERY_STRING . "TEST&p=FOO"))) 1) (test-sxml-select-matcher '(html head))) ;;-------------------------------------------------------- (test-section "deleting a page") (let ((mtime-save #f)) (test* "edit screen (to delete)" '(!contain (input (@ (name "mtime") (value ?mtime) ?*))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "POST")) :parameters '((c . e) (p . "LINK"))) 1) (test-sxml-select-matcher '(html body form input) (lambda (alist) (set! mtime-save (x->integer (assq-ref alist '?mtime))) alist))) (test* "commit delete" '(("status" "302 Moved") ("location" "http://localhost/wiliki.cgi?TEST")) ;; redirected to the top page (values-ref (run-cgi-script->string *cgi-path* :environment '((REQUEST_METHOD . "GET")) :parameters `((c . c) (p . "LINK") (commit . "Commit") (mtime . ,mtime-save) (content . ""))) 0)) (test* "check deletion" '(title "Nonexistent page: LINK") (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "GET") (PATH_INFO . "/LINK"))) 1) (test-sxml-select-matcher '(html head title))) ) ;;-------------------------------------------------------- (test-section "InterWikiName") (let ((mtime-save #f)) ;; preparation (run-cgi-script->string *cgi-path* :environment '((REQUEST_METHOD . "GET")) :parameters `((c . c) (p . "InterWikiName") (commit . "Commit") (mtime . "") (content . ":WiLiKi:shiro.dreamhost.com/scheme/wiliki/wiliki.cgi?"))) ((test-sxml-select-matcher '(html body form input) (lambda (alist) (set! mtime-save (x->integer (assq-ref alist '?mtime))) alist)) '(!contain (input (@ (name "mtime") (value ?mtime) ?*))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "POST")) :parameters '((c . e) (p . "TEST"))) 1)) (run-cgi-script->string *cgi-path* :environment '((REQUEST_METHOD . "GET")) :parameters `((c . c) (p . "TEST") (commit . "Commit") (mtime . ,mtime-save) (content . "[[WiLiKi:Shiro]]\r\n"))) (test* "InterWikiName reference" '(!contain (p (a (@ (href "http://shiro.dreamhost.com/scheme/wiliki/wiliki.cgi?Shiro")) "WiLiKi:Shiro"))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "GET") (PATH_INFO . "TEST"))) 1) (test-sxml-select-matcher '(html body p))) ) ;;-------------------------------------------------------- (test-section "Some special pages") (test* "All Pages" `(body (!contain (h1 "Test: All Pages") (ul (li (a (@ (href "wiliki.cgi?InterWikiName")) "InterWikiName")) (li (a (@ (href "wiliki.cgi?TEST")) "TEST"))))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "GET")) :parameters '((c . a))) 1) (test-sxml-select-matcher '(html body))) (test* "Recent Changes" `(body (!contain (h1 "Test: Recent Changes") (table ;; table row consists of (timestamp ago link) (tr (td ?*) (td ?*) (td (a (@ (href "wiliki.cgi?TEST")) "TEST"))) (tr (td ?*) (td ?*) (td (a (@ (href "wiliki.cgi?InterWikiName")) "InterWikiName")))))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "GET")) :parameters '((c . r))) 1) (test-sxml-select-matcher '(html body))) (test* "Recent Changes (via virtual page)" `(body (!contain (h1 "RecentChanges") (table ;; table row consists of (timestamp ago link) (tr (td ?*) (td ?*) (td (a (@ (href "wiliki.cgi?TEST")) "TEST"))) (tr (td ?*) (td ?*) (td (a (@ (href "wiliki.cgi?InterWikiName")) "InterWikiName")))))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "GET") (PATH_INFO . "/RecentChanges"))) 1) (test-sxml-select-matcher '(html body))) (test* "Search result" `(body (!contain (h1 "Test: Search results of \"dreamhost\"") (ul (li (a (@ (href "wiliki.cgi?InterWikiName")) ?*) ?*)))) (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "GET")) :parameters '((c . s) (key . "dreamhost"))) 1) (test-sxml-select-matcher '(html body))) ;;-------------------------------------------------------- (test-section "Headings and TOC macro") (run-cgi-script->string *cgi-path* :environment '((REQUEST_METHOD . "GET")) :parameters `((c . c) (p . "Headings") (commit . "Commit") (mtime . "") (content . "[[$$toc]]\n** a\n* b\n*** c\n** d\n**** e\n*** f\n"))) (let ((page (values-ref (run-cgi-script->sxml *cgi-path* :environment '((REQUEST_METHOD . "GET") (PATH_INFO . "/Headings"))) 1))) (test* "Headings and TOC macro" (let* ((LIs ((sxpath '(// li)) page)) (hrefs (append-map (sxpath '(// href *text*)) LIs)) (bodies (append-map (sxpath '(// a *text*)) LIs)) (ids (map (lambda (uri) (rxmatch-substring (#/#(.*)/ uri) 1)) hrefs))) (sort (map list ids bodies) (lambda (a b) (string<? (cadr a) (cadr b))))) (let* ((HNs ((sxpath '(// (or@ h2 h3 h4 h5))) page)) (ids (append-map (sxpath '(// id *text*)) HNs)) (bodies (append-map (sxpath '(*text*)) HNs))) (map (lambda (id body) (list id (string-trim-right body))) ids bodies))) ) (test-end) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/util/����������������������������������������������������������������������������������0000755�0000764�0000764�00000000000�10775510107�012671� 5����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/util/sxml/�����������������������������������������������������������������������������0000755�0000764�0000764�00000000000�10741672224�013656� 5����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/util/sxml/xml-test.scm�����������������������������������������������������������������0000644�0000764�0000764�00000023677�10741672224�016156� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������;; ;; generic framework to test XML generation code ;; ;; Copyright (c) 2003 Scheme Arts, L.L.C., All rights reserved. ;; Copyright (c) 2003 Time Intermedia Corporation, All rights reserved. ;; See COPYING for terms and conditions of using this software ;; ;; $Id: xml-test.scm,v 1.1 2004-03-20 04:52:35 shirok Exp $ ;; This module provides the means of test the result of HTML ;; generating code, such as CGI programs. The output of ;; these code sometimes includes a information which may not be ;; able to predict at the time the test is written; an example ;; of such information is the timestamp and the session id. ;; ;; The test-xml-match? procedure uses a pattern to match the ;; output of the tested code, instead of doing literal match. ;; The pattern may include "don't care" node, and a pattern ;; variable that can be used to check certain constraints. ;; ;; test-xml-match? pattern input &optional extra-check ;; ;; Input may be a string or a list. If it is a list, ;; first it is converted to a string by calling tree->string ;; of text.tree module. ;; ;; Then, the input string is parsed by ssax XML parser, ;; to produce a SXML structure, which is matched to pattern. ;; ;; Pattern is an S-expression that resembles to SXML, but ;; can contain a pattern variable. The formal specification ;; of pattern is as follows: ;; ;; <pattern> : <node> ;; <node> : <string> | <pattern-variable> ;; | (<key> <attr-node>? <content> ...) ;; <key> : <literal-symbol> ;; ;; <attr-node> : (@ <content> ...) ;; | ?@ ;; ;; <content> : <node> ;; | (!seq <pattern> ...) ;; | (!permute <pattern> ...) ;; | (!or <pattern> ...) ;; | (!repeat <pattern> ...) ;; ;; <literal-symbol> : any symbol except that begins with '?' or '!' ;; <pattern-variable> : a symbol that begins with '?' ;; ;; <string> and <literal-symbol> matches to the input as is. ;; ;; <pattern-variable> matches any object in the input, in that place. ;; The matcher records the pattern variable and matched object, ;; which will be used for extra check performed by extra-check ;; procedure described below. ;; ;; (Current version doesn't care about the name of pattern variable, ;; but in future we may add a constraint that the same pattern variable ;; should refer to the isomorphic stucture. To represent a "don't care" ;; part, use a pattern variable ?_, which will be reserved for such ;; a purpose.) ;; ;; A special pattern variable ?@ matches an attr-node, if it is present. ;; If there's no attr-node, ?@ is ignored. It's convenient to silently ;; ignore attributes. ;; ;; A special pattern variable ?* matches as if (!repeat ?_), that is, ;; matches everything after. ;; ;; Attr node is treated specially. Its contents matches arbitrary ;; permutation of the pattern. ;; ;; (!seq <pattern> ...) ;; Matches the sequcne of <pattern> .... When it appears as ;; a <content>, <pattern> ... is taken as if it is spliced ;; into the sequence of <content>; that is, the following pattern: ;; ;; (ul (li "foo") (!seq (li "bar") (li "baz")) (li "oof")) ;; ;; matches the input: ;; ;; (ul (li "foo") (li "bar") (li "baz") (li "oof")) ;; ;; (!permute <pattern> ...) ;; Matches a sequence of any permutation of <pattern>s. ;; The permuted pattern is spliced to the containing ;; sequece of <content>; that is, the following pattern: ;; ;; (ul (li "foo") (!permute (li "bar") (li "baz")) (li "oof")) ;; ;; matches the input: ;; ;; (ul (li "foo") (li "baz") (li "bar") (li "oof")) ;; ;; (!or <pattern> ...) ;; ;; Matches any one of <pattern>s. The splicing rule is applied ;; recursively; the following pattern: ;; ;; (ul (li "foo") (!or (!seq (li "bar") (li "baz")) (li "ZZ"))) ;; ;; matches both of the following input: ;; ;; (ul (li "foo") (li "bar") (li "baz")) ;; (ul (li "foo") (li "ZZ")) ;; ;; (!repeat <pattern> ...) ;; ;; Matches zero or more occurence of input that matches <pattern> ... ;; The matched pattern variables are forgotten in every iteration ;; except the last one. A pattern: ;; ;; (dl (!repeat (dt ?_) (dd ?_))) ;; ;; matches the input: ;; ;; (dl (dt "foo") (dd "bar") (dt "foo2") (dd "bar2")) ;; ;; (!contain <pattern> ...) ;; ;; Matches any sequence that includes all of <pattern>s, in any ;; order. The input pattern may contain items that doesn't ;; match any of <pattern>s. It can be achieved by ;; (!permute ?* <pattern> ?* <pattern> ... <pattern> ?*), ;; but !contain is much more efficient. ;; ;; When an optional argument extra-check is given, it is ;; called with one argument, an assoc list of pattern variable ;; and the matched value. It can perform extra check, and returns ;; #f if the check fails, or #t if succeeds. (define-module sxml.xml-test (use srfi-1) (use srfi-13) (use gauche.test) (use util.combinations) (use text.tree) (use sxml.ssax) (use sxml.sxpath) (export test-xml-match? test-sxml-match? test-xml-select-matcher test-sxml-select-matcher)) (select-module sxml.xml-test) (define (pattern-var? obj) (and (symbol? obj) (string-prefix? "?" (symbol->string obj)))) (define (pattern-key? obj) (and (symbol? obj) (string-prefix? "!" (symbol->string obj)))) (define (attr-node? node) (and (pair? node) (eq? (car node) '@))) (define (sort-nodes nodes) (sort nodes (lambda (a b) (if (pair? a) (if (pair? b) (string<? (x->string (car a)) (x->string (car b))) #t) #f)))) (define (any-permutation pred seq) (call/cc (lambda (break) (permutations*-for-each (lambda (seq) (cond ((pred seq) => break))) seq equal?) #f))) ;; Match one pattern item. ;; Because of "splicing" nature of the pattern, it takes a list of inputs. ;; When matched, the continuation procedure is called with the rest of ;; inputs and the pattern binding alist. (define (match-pattern pat ls cont r) (cond ((eq? pat '?@) ;; specially treats attr-node match (cond ((null? ls) (cont ls r)) ((attr-node? (car ls)) (cont (cdr ls) (acons pat (car ls) r))) (else (cont ls r)))) ((eq? pat '?*) ;; matches the rest of the pattern. note for backtrack. (match-pattern '(!repeat ?_) ls cont r)) ((pattern-var? pat) (and (not (null? ls)) (cont (cdr ls) (acons pat (car ls) r)))) ((not (pair? pat)) (and (not (null? ls)) (equal? pat (car ls)) (cont (cdr ls) r))) ((attr-node? pat) (and (not (null? ls)) (attr-node? (car ls)) (any-permutation (cute match-contents (sort-nodes (cdr pat)) <> (lambda (more r) (and (null? more) (cont (cdr ls) r))) r) (sort-nodes (cdar ls))))) ((not (pattern-key? (car pat))) (and (pair? ls) (pair? (car ls)) (eq? (car pat) (caar ls)) (match-contents (cdr pat) (cdar ls) (lambda (more r) (and (null? more) (cont (cdr ls) r))) r))) (else (case (car pat) ((!seq) (match-contents (cdr pat) ls cont r)) ((!permute) (any-permutation (cut match-contents <> ls cont r) (cdr pat))) ((!contain) (any-permutation (cut match-contain <> ls cont r) (cdr pat))) ((!or) (any (cut match-pattern <> ls cont r) (cdr pat))) ((!repeat) (let loop ((ls ls) (r r)) (or (match-contents (cdr pat) ls loop r) (cont ls r)))) (else (error "unknown pattern directive:" (car pat))))) )) (define (match-contents pats ls cont r) (if (null? pats) (cont ls r) (match-pattern (car pats) ls (cut match-contents (cdr pats) <> cont <>) r))) (define (match-contain pats ls cont r) (cond ((null? pats) (cont '() r)) ;; discards remaining inputs ((null? ls) #f) ;; ran out inputs (else (or (match-pattern (car pats) ls (cute match-contain (cdr pats) <> cont <>) r) (match-contain pats (cdr ls) cont r))))) (define (match-input pattern input . opts) (let ((extra-check (get-optional opts (lambda (r) #t)))) (match-pattern pattern input (lambda (more r) (and (null? more) (extra-check r))) '()))) ;; Entry (define (test-sxml-match? pattern input . opts) (and (not (equal? input *test-error*)) (apply match-input pattern (list input) opts))) (define (test-xml-match? pattern input . opts) (and (not (equal? input *test-error*)) (apply match-input pattern (cdr (call-with-input-string (tree->string input) (cut ssax:xml->sxml <> '()))) opts))) (define (test-sxml-select-matcher path . maybe-extra-check) (let ((selector (sxpath path))) (lambda (pattern input) (and (not (equal? input *test-error*)) (apply match-input pattern ;; kludge to deal with *TOP* (selector (if (and (pair? input) (eq? (car input) '*TOP*)) input `(*TOP* ,input))) maybe-extra-check))))) (define (test-xml-select-matcher path . maybe-extra-check) (let ((selector (sxpath path))) (lambda (pattern input) (and (not (equal? input *test-error*)) (let ((parsed (call-with-input-string (tree->string input) (cut ssax:xml->sxml <> '())))) (apply match-input pattern (selector parsed) maybe-extra-check)))))) (provide "sxml/xml-test") �����������������������������������������������������������������WiLiKi-0.6.2/util/README����������������������������������������������������������������������������0000644�0000764�0000764�00000000152�10741672224�013551� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������This directory contains Scheme library files that will be incorporated in the future Gauche distribution. ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/emacs/���������������������������������������������������������������������������������0000755�0000764�0000764�00000000000�10741672223�013005� 5����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/emacs/README���������������������������������������������������������������������������0000644�0000764�0000764�00000000235�10741672223�013665� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������This directory contains an EmacsLisp program that enables browsing and editing WiLiKi contents from Emacs. The code is in an experimental stage (pre-alpha). �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/emacs/wiliki.el������������������������������������������������������������������������0000644�0000764�0000764�00000155330�10741672223�014626� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; wiliki.el --- Emacs client for WiLiKi ;; Copyright (C) 2004 Tokuya Kameshima. All rights reserved. ;; $Id: wiliki.el,v 1.12 2006-07-29 16:40:52 tkame Exp $ ;;; Installation: ;; Place wiliki.el in your load path and add the following lines to ;; your .emacs: ;; (autoload 'wiliki "wiliki" nil t) ;; (autoload 'wiliki-edit "wiliki" nil t) ;; To edit WiLiKi pages from emacs-w3m, add this to your .emacs: ;; (autoload 'w3m-edit-wiliki "wiliki" nil t) ;; (add-hook 'w3m-mode-hook ;; (lambda () ;; (define-key w3m-mode-map "w" 'w3m-edit-wiliki))) ;;; Usage: ;; To browse WiLiKi pages, type as follows: ;; M-x wiliki ;; Then, enter a base url of the site and the page name you want to ;; browse, or just enter the entire URL of the page. ;;; TODO: ;; - Don't ask the log message if the site doesn't have change logs. ;; - More page rendering for browsing. ;; - Character encoding detection. ;; - Proxy authentication. ;; - Code refactoring. ;; - Documentation. ;; This is based on http://homepage.mac.com/skimu/wiliki.el ;;; Code (eval-when-compile (require 'cl)) ;;; Configuration Variables: (defgroup wiliki nil "WiLiKi" :prefix "wiliki-" :group 'wiliki) (defcustom wiliki-home-base-url "http://www.shiro.dreamhost.com/scheme/wiliki/wiliki.cgi" "Default WiLiKi site to visit." :group 'wiliki :type 'string) (defcustom wiliki-sites '(("WiLiKi" "http://www.shiro.dreamhost.com/scheme/wiliki/wiliki.cgi" "http://www.shiro.dreamhost.com/scheme/wiliki/wiliki2.cgi") ("GaucheMemo" "http://www.shiro.dreamhost.com/scheme/gauche/gmemo/index.cgi") ("SchemeCrossReference" "www.shiro.dreamhost.com/scheme/wiliki/schemexref.cgi")) "List of WiLiKi sites. (SITE1 SITE2 ...) Each SITE consists of the following form: (SITE-NAME PRIMARY-BASE-URL OPTIONAL-BASE-URL ...)" :group 'wiliki :type '(repeat (cons :tag "Site" (string :tag "Name") (cons :tag "Base URL" (string :tag "Primary") (repeat :tag "Optional" (string :tag "")))))) (defcustom wiliki-site-regexp "wiliki" "Regexp with which a possible WiLiKi site's URL matches." :group 'wiliki :type 'regexp) (defcustom wiliki-http-proxy (let ((proxy (getenv "HTTP_PROXY"))) (if (not (string= proxy "")) proxy)) "URL of the proxy server to be used for HTTP requests. If nil, emacs-wiliki sends requests directly." :group 'wiliki :type '(choice (const :tag "Off" nil) (string :tag "URL"))) (defcustom wiliki-http-no-proxy-regexp nil "Regular expression of servers to be connected without proxy. If nil and `wiliki-http-proxy' is non-nil, emacs-wiliki sends requests via the proxy server `wiliki-http-proxy'." :group 'wiliki :type '(choice (const :tag "Off" nil) regexp)) (defcustom wiliki-default-coding-system (if (coding-system-p 'utf-8) 'utf-8 'euc-jp) "Default coding system for WiLiKi." :group 'wiliki :type 'symbol) (defcustom wiliki-use-other-window nil "If non-nil, wiliki page will be opened in another window." :group 'wiliki :type 'boolean) (defcustom wiliki-browse-url-browser-function browse-url-browser-function "Function to display a non-WiLiKi page in a WWW Browser." :group 'wiliki :type 'function) (defcustom wiliki-writer-macro-regexp "date" "Regular expression matching writer macro names." :group 'wiliki :type 'regexp) (defcustom wiliki-reader-macro-regexp "include\\|index\\|cindex\\|toc\\|img" "Regular expression matching reader macro names." :group 'wiliki :type 'regexp) (defcustom wiliki-mode-hook nil "Hook called in `wiliki-mode'." :group 'wiliki :type 'hook) (defcustom wiliki-edit-mode-hook nil "Hook called in `wiliki-edit-mode'." :group 'wiliki :type 'hook) (defcustom wiliki-log-mode-hook nil "Hook called in `wiliki-log-mode'." :group 'wiliki :type 'hook) (defcustom wiliki-commit-done-hook nil "Hook called after commit is done." :group 'wiliki :type 'hook) ;;; Internal variables: (defvar wiliki-emacs-wiliki-version "0.1pre") (defvar wiliki-http-user-agent (concat "Emacs-WiLiKi/" wiliki-emacs-wiliki-version)) (defvar wiliki-coding-system wiliki-default-coding-system) (defvar wiliki-use-lwp-for-commit t) (defvar wiliki-ask-log t) (defvar wiliki-mode-map nil) (defvar wiliki-edit-mode-map nil) (defvar wiliki-log-mode-map nil) (defvar wiliki-buffer-list nil "List of buffers created by wiliki-mode") (defconst wiliki-buffer " *Wiliki:Session*") (defvar wiliki-previous-window-config nil) (defvar wiliki-site-info-alist nil "List of information on each wiliki site.") ;;; Data Types (defstruct wiliki-site-info base-url site-name top-page interwikis page-list) ;; (setq x (make-wiliki-site-info :site-name "WiLiKi")) ;; (setf (wiliki-site-info-site-name x) "XXX") (defun wiliki-site-name-uniquly () (let ((site-name-list (mapcar (lambda (elem) (wiliki-site-info-site-name (cdr elem))) wiliki-site-info-alist)) (count 0) site-name) (while (and (setq site-name (if (zerop count) "Wiliki" (format "Wiliki<%d>" count))) (member site-name site-name-list)) (setq count (1+ count))) site-name)) (defun wiliki-site-info-setup () "Initialize `wiliki-site-info-alist'. You should call this function when you update `wiliki-sites'." (interactive) (setq wiliki-site-info-alist (mapcar (lambda (elem) (let ((site-name (car elem)) (base-url (car (cdr elem)))) (cons base-url (make-wiliki-site-info :base-url base-url :site-name site-name)))) wiliki-sites))) (defun wiliki-site-info (base-url) "Return wiliki site info data of BASE-URL. The data is stored in `wiliki-site-info-alist' list. If the data for BASE-URL does not exist in the list, new data is created." (if (not wiliki-site-info-alist) (wiliki-site-info-setup)) (or (cdr (assoc base-url wiliki-site-info-alist)) (let ((site-info (make-wiliki-site-info :base-url base-url :site-name (wiliki-site-name-uniquly)))) (setq wiliki-site-info-alist (cons (cons base-url site-info) wiliki-site-info-alist)) site-info))) (defun wiliki-base-url->top-page (base-url) (or (wiliki-site-info-top-page (wiliki-site-info base-url)) "")) (defun wiliki-base-url->site-name (base-url) (wiliki-site-info-site-name (wiliki-site-info base-url))) (defun wiliki-base-url->interwikis (base-url) (or (wiliki-site-info-interwikis (wiliki-site-info base-url)) (wiliki-update-interwikis base-url))) (defun wiliki-base-url->interwiki-url (base-url other-wiki) (let ((interwikis (wiliki-base-url->interwikis base-url))) (cdr (assoc other-wiki interwikis)))) (defun wiliki-base-url->page-list (base-url &optional force-fetch) (or (and (not force-fetch) (wiliki-site-info-page-list (wiliki-site-info base-url))) (wiliki-update-page-list base-url t))) (defun wiliki-parse-inter-wiki-name (&optional buffer) (save-excursion (if buffer (set-buffer buffer)) (let (interwikis) (set-buffer buf) (goto-char (point-min)) (while (re-search-forward "^:\\([^:]+\\):[ \t]*\n?[ \t]*\\([^:][^ \t\n]*\\)" nil t) (let* ((name (match-string-no-properties 1)) (url (match-string-no-properties 2)) (scheme (if (string-match "^\\(https?\\|ftp\\|mailto\\):" url) "" "http://"))) (setq interwikis (cons (cons name (concat scheme url)) interwikis)))) interwikis))) (defun wiliki-update-interwikis (base-url) (let* ((buf (wiliki-page-buffer base-url "InterWikiName")) (interwikis (wiliki-parse-inter-wiki-name buf))) (setf (wiliki-site-info-interwikis (wiliki-site-info base-url)) interwikis))) (defun wiliki-update-page-list (base-url &optional force-fetch) (let* ((buf (wiliki-page-buffer base-url "$all" force-fetch)) pages) (save-excursion (set-buffer buf) (goto-char (point-min)) (while (re-search-forward "\\[\\[\\(.*\\)\\]\\]" nil t) (setq pages (cons (cons (match-string-no-properties 1) nil) pages)))) (setf (wiliki-site-info-page-list (wiliki-site-info base-url)) (reverse pages)))) ;;; ;;; Utilities for URL ;;; (defconst wiliki-url-unreserved-chars '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?$ ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\) ?,) "A list of characters that are _NOT_ reserve in the URL spec. This is taken from draft-fielding-url-syntax-02.txt - check your local internet drafts directory for a copy.") (defun wiliki-url-hexify-string (str) "Escape characters in a string" (mapconcat (lambda (ch) (if (not (memq ch wiliki-url-unreserved-chars)) (format "%%%02x" ch) (char-to-string ch))) (encode-coding-string str wiliki-coding-system) "")) (defun wiliki-url-unhexify-string (string) "Decode a string escaped with '%'." (let ((result (mapconcat (lambda (str) (if (string-match "^%[0-9a-f][0-9a-f]$" str) (char-to-string (string-to-number (substring str 1) 16)) str)) (wiliki-scan-string "%[0-9a-f][0-9a-f]\\|." string) ""))) (decode-coding-string result wiliki-coding-system))) (defun wiliki-scan-string (regexp str) "Ruby's scan-like function." (let ((lst) (start 0)) (while (string-match regexp str start) (setq lst (cons (match-string 0 str) lst)) (setq start (match-end 0))) (reverse lst))) (defun wiliki-get-param-string (param-alist) (mapconcat (lambda (param) (concat (car param) "=" (wiliki-url-hexify-string (cdr param)))) param-alist "&")) (defun wiliki-parse-url (url &optional default-port) "parse url string and return a list of (method host port path), where method is symbol, host is a string, port is integer, path is string." (let ((method 'http) (host nil) (port (or default-port 80)) (path nil)) ;; Part1: get method (let ((idx (string-match "//" url))) (if idx (let ((mtd (substring url 0 idx))) (setq url (substring url (+ 2 idx))) (cond ((string-match "http:" mtd) (setq method 'http)) (t (error "Unknown method, %s" mtd)))))) ;; Part2: get path (let ((idx (string-match "/" url))) (if (not idx) (setq path "") (setq path (substring url idx)) (setq url (substring url 0 idx)))) ;; Part3: get host and port (let ((idx (string-match ":" url))) (if idx (let ((tmpp (string-to-int (substring url (+ idx 1))))) (setq host (substring url 0 idx)) (setq port tmpp)) (setq host url))) ;; Final: return result as list (list method host port path))) (defun wiliki-parse-proxy-url (url) (wiliki-parse-url url 3128)) (defun wiliki-urll-method (urll) (nth 0 urll)) (defun wiliki-urll-host (urll) (nth 1 urll)) (defun wiliki-urll-port (urll) (nth 2 urll)) (defun wiliki-urll-path (urll) (nth 3 urll)) (defun wiliki-recreate-url (urll) (format "%s://%s:%d%s" (wiliki-urll-method urll) (wiliki-urll-host urll) (wiliki-urll-port urll) (wiliki-urll-path urll))) ;; tests ;(wiliki-recreate-url (wiliki-parse-url "wo.bar/aho")) ;(wiliki-parse-url "http://foo.bar.com:8180/abara/cadabra") ;(wiliki-parse-url "http://foo.bar.com/abara/cadabra") ;(wiliki-parse-url "fobar.com:709/fo") ;(wiliki-parse-url "fo:/hage/hoge") ;;; ;;; Network interface ;;; (defun wiliki-parse-http-status-line () "Parse HTTP status line on the current point. Return a list of (http-version status-code reason-phrase)." (if (looking-at "\\(HTTP/[0-9]\\.[0-9]\\) \\([0-9]\\{3\\}\\) \\([^\r\n]+\\)") (progn (forward-line) (list (match-string 1) ; HTTP-Version (match-string 2) ; Status-Code (match-string 3))))) ; Reason-Phrase (defun wiliki-parse-header (charset) "Parse the header fields beginning from the current point of the buffer and return the result as an association list. The point is moved to the place after the header parsed. The format of the alist is (FIELD1 FIELD2 ...) where each FIELD is of the form (FIELD-NAME . FIELD-VALUE) FIELD-NAME is converted to lower-case." (catch 'bad-header-format (let* ((beg (point)) (end (or (re-search-forward "\r?\n\r?\n" nil t) (goto-char (point-max)))) (header-lines (decode-mime-charset-string (buffer-substring beg end) charset)) alist) (goto-char end) (with-temp-buffer (insert header-lines) (goto-char (point-min)) (while (and (not (looking-at "\r?\n")) (not (eobp))) (if (looking-at "^\\([^:\r\n]+\\):[ \t]*\\([^\r\n]*\\)") (setq alist (cons (cons (downcase (match-string 1)) (match-string 2)) alist)) (goto-char beg) (throw 'bad-header-format nil)) (forward-line)) alist)))) (defun wiliki-http-parse-response (&optional buffer default-charset) (with-current-buffer (or buffer (current-buffer)) (goto-char (point-min)) (let* ((http-stat (wiliki-parse-http-status-line)) (http-header (wiliki-parse-header 'raw-text)) (charset (let ((content-type (cdr (assoc "content-type" http-header)))) (if content-type (and (string-match "charset=\\(.*\\)" content-type) (intern (downcase (match-string 1 content-type)))) default-charset))) (wiliki-header (if (string-match "^text/plain;?" (cdr (assoc "content-type" http-header))) (wiliki-parse-header charset))) (body (decode-mime-charset-string (buffer-substring (point) (point-max)) charset))) (if (not (coding-system-p charset)) (setq charset wiliki-default-coding-system)) (list http-stat http-header wiliki-header charset body)))) (defmacro with-wiliki-response (session default-charset wiliki-params &rest body) `(let* ((response (wiliki-http-parse-response ,session ,default-charset)) (http-status (nth 0 response)) (http-header (nth 1 response)) (wiliki-header (nth 2 response)) (charset (nth 3 response)) (body (nth 4 response)) (header (append wiliki-header http-header))) (if (not (member (nth 1 http-status) '("200" ; OK "302"))) ; Moved Temporarily (error "HTTP error: %s %s" (nth 1 http-status) (nth 2 http-status)) (let (,@(mapcar (lambda (param) (list param `(cdr (assoc ,(symbol-name param) header)))) wiliki-params)) ,@body)))) ;; (put 'with-wiliki-response 'lisp-indent-function 2) (put 'with-wiliki-response 'lisp-indent-function 3) (defun wiliki-fetch-page-sentinel (base-url session) "Sentinel for nomarl wiki page. This is supporsed to be called when server closed connection" (with-wiliki-response session wiliki-coding-system (wiliki-lwp-version title mtime status) ;; `body' is also bound. (unless wiliki-lwp-version (error "Not a WiLiKi site.")) (let* ((buf (get-buffer-create (wiliki-buffer-name base-url title 'view))) pos-saved) (add-to-list 'wiliki-buffer-list buf) (with-current-buffer buf (setq pos-saved (point)) (setq buffer-read-only nil) (erase-buffer) (wiliki-mode) (if body (progn (insert body) (goto-char pos-saved))) (set-buffer-modified-p nil) (setq buffer-read-only t) (setq wiliki-site-info (wiliki-site-info base-url)) (setq wiliki-base-url base-url) (setq wiliki-coding-system charset) (setq wiliki-title title) (setq wiliki-mtime mtime) (setq wiliki-status status) (setq wiliki-editable t) ; XXX: how will you determine this? (setq wiliki-use-lwp-for-commit (if status t)) (if (string= wiliki-title "InterWikiName") (wiliki-update-interwikis base-url))) buf))) (defun wiliki-fetch-page-sentinel-html (base-url page session beg-regexp end-regexp regexp function) "Sentinel for html meta pages, e.g., \"All Pages\" and \"Recent Changes\". Create the page buffer with converting a html response. SESSION is a session buffer of PAGE on BASE-URL and the buffer contains the response from the server in html form. The contents must be a \"text/html\" data. If BEG-REGEXP is non-nil, it searches for regular expression REGEXP from position of the html data matching with BEG-REGEXP. If BEG-REGEXP is nil, it searches for REGEXP from the beginning of the html data. END-REGEXP bounds the search. The match found must not extend after the position matching END-REGEXP. With each occurrence of the match, FUNCTION is called. FUNCTION is a function returning a string which is inserted into the page buffer." (with-wiliki-response session wiliki-coding-system (date content-type) (if (not (string-match "^text/html" content-type)) (error "Not a html")) (let ((buf (get-buffer-create (wiliki-buffer-name base-url page))) pos-saved) (add-to-list 'wiliki-buffer-list buf) (with-current-buffer buf (setq pos-saved (point)) (setq buffer-read-only nil) (erase-buffer) (wiliki-mode) ;; (with-temp-buffer (insert body) (goto-char (point-min)) (let* ((beg (progn (if (and beg-regexp (not (re-search-forward beg-regexp nil t))) (goto-char (point-max))) (point))) (end (progn (if end-regexp (re-search-forward end-regexp nil t) (goto-char (point-max))) (point)))) (goto-char beg) (while (re-search-forward regexp end t) (let ((str (funcall function))) (if str (with-current-buffer buf (insert str))))))) (goto-char pos-saved) ;; (set-buffer-modified-p nil) (setq buffer-read-only t) (setq wiliki-site-info (wiliki-site-info base-url)) (setq wiliki-base-url base-url) (setq wiliki-coding-system charset) (setq wiliki-title page) ;; (setq wiliki-mtime mtime) ;; (time-to-seconds (date-to-time date)) (setq wiliki-editable nil) (if (string= wiliki-title "$all") (wiliki-update-page-list base-url))) buf))) ;; [redirect] http header ;; - HTTP Status-Code: 302 ;; - Location: wiliki.cgi?WiLiKi (defun wiliki-commit-sentinel-html (base-url page session) (let ((edit-buf (get-buffer (wiliki-buffer-name base-url page 'edit))) (conflict (with-wiliki-response session wiliki-coding-system (location content-type) (if (not location) t))) buf) (setq buf (wiliki-fetch base-url page)) ; get the latest page contents. (if conflict (let (mtime status) (delete-other-windows) (switch-to-buffer buf) ; show view page. (setq mtime wiliki-mtime) (setq status wiliki-status) (pop-to-buffer edit-buf) (setq wiliki-edit-mtime mtime) (setq wiliki-edit-status status) ; XXX ;; don't signal the error. (error "%s (conflict) - resolve the conflict and commit again" wiliki-edit-title)) (let (pos) (set-buffer edit-buf) (setq pos (point)) (set-buffer-modified-p nil) (wiliki-edit-quit) ;; Now we are in wiliki mode buffer of the updated page. (goto-char pos))))) (defun wiliki-commit-sentinel (base-url session) (with-wiliki-response session wiliki-coding-system (wiliki-lwp-version title mtime status) ;; `body' is bound. (let* ((edit-buf (get-buffer (wiliki-buffer-name base-url title 'edit))) buf) ;; update the view buffer anyway (setq buf (wiliki-fetch-page-sentinel base-url session)) (if (string= status "conflict") (progn (delete-other-windows) (switch-to-buffer buf) ; show view page. (pop-to-buffer edit-buf) (setq wiliki-edit-mtime mtime) (setq wiliki-edit-status status) ; XXX (error "%s (conflict) - resolve the conflict and commit again" wiliki-edit-title)) (let (pos) (set-buffer edit-buf) (setq pos (point)) (set-buffer-modified-p nil) (wiliki-edit-quit) ;; Now we are in wiliki mode buffer of the updated page. (goto-char pos)))))) ;;; ; (defun wiliki-fetch-recent-sentinel (proc event) ; "Sentinel for recent changes" ; ... ; (create-a-new-buffer-and-format-into-what-wiliki-mode-would-understand) ; (set-buffer newbuf) ; (wiliki-mode) ; (setq wiliki-editable nil) ;;; (defun wiliki-send-request (url method &optional content) "METHOD: \"GET\" or \"POST\"" (let* ((urll (wiliki-parse-url url)) (proxy (if (and wiliki-http-proxy (or (not wiliki-http-no-proxy-regexp) (not (string-match wiliki-http-no-proxy-regexp (wiliki-urll-host urll))))) (wiliki-parse-proxy-url wiliki-http-proxy))) (request-uri (if proxy (wiliki-recreate-url urll) (wiliki-urll-path urll))) (req (concat method " " request-uri " HTTP/1.0\r\n" "Host: " (wiliki-urll-host urll) "\r\n" ;; TODO: proxy authentication "User-Agent: " wiliki-http-user-agent "\r\n" (if content (concat "Content-Type: application/x-www-form-urlencoded\r\n" "Content-Length: " (number-to-string (length content)) "\r\n" "\r\n" content) "\r\n")))) (save-excursion (let* ((proc (open-network-stream "wiliki" wiliki-buffer (wiliki-urll-host (or proxy urll)) (wiliki-urll-port (or proxy urll)))) (session (process-buffer proc))) (set-buffer session) (erase-buffer) (set-buffer-process-coding-system 'no-conversion 'no-conversion) (set-process-sentinel proc 'ignore) (process-send-string proc req) ;; (while (memq (process-status proc) '(run open)) (accept-process-output proc)) proc)))) (defun wiliki-http-get (url) (wiliki-send-request url "GET")) (defun wiliki-http-post (url content) (wiliki-send-request url "POST" content)) ;;; ;;; Usefull functions in wiliki-mode ;;; (defun wiliki-buffer-name (base-url title &optional mode) (setq mode (cond ((eq mode 'edit) " Edit") ((eq mode 'log) " Log") (t ""))) (format "*WiLiKi* %s:%s%s" (wiliki-base-url->site-name base-url) (if (string= title "") (wiliki-base-url->top-page base-url) title) mode)) (defun wiliki-inter-wiki-name-p (base-url wikiname) (if (string-match "\\([^:]+\\):\\(.*\\)" wikiname) (let* ((interwiki (match-string 1 wikiname)) (page (match-string 2 wikiname)) (url (wiliki-base-url->interwiki-url base-url interwiki))) (if url (concat url page))))) (defun wiliki-find-wikiname-at-point () (let* ((current (point)) (line-start (progn (forward-line 0) (point))) (line-end (progn (forward-line 1) (point))) (open (progn (goto-char current) (search-backward "[[" line-start t))) (pre-close (progn (goto-char current) (search-backward "]]" (or open line-start) t))) (close (progn (goto-char current) (search-forward "]]" line-end t))) (post-open (progn (goto-char current) (search-forward "[[" (or close line-end) t)))) (goto-char current) (if (and open close (or (not pre-close) (< pre-close open)) (or (not post-open) (> post-open close))) (buffer-substring-no-properties (+ open 2) (- close 2)) nil))) (defun wiliki-site-base-url-p (base-url) "Return the list of (SITE-NAME PRIMARY-BASE-URL OPTIONAL-BASE-URLs ...) if BASE-URL is a base url of a WiLiKi site." (let ((list wiliki-sites)) (while (and list (not (member base-url (cdr (car list))))) (setq list (cdr list))) (car list))) (defun wiliki-site-p (url) "Return the base url part of URL if URL is a possibly WiLiKi site." (let ((base-url (if (string-match "\\(.*\\)\\?" url) (match-string 1 url) url))) (or (car (cdr (wiliki-site-base-url-p base-url))) (if (or (assoc base-url wiliki-site-info-alist) (string-match wiliki-site-regexp base-url)) base-url)))) (defun wiliki-pseudo-page-p (page) "Return non-nil if PAGE is a pseudo page (not a regular page)." (save-match-data (string-match "^\\$" page))) ;; ;; page view history ;; (defvar wiliki-history nil "List of page view history. First elemet of the list is the current page to view.") (defvar wiliki-history-forward nil "List of page view history for forward.") (defun wiliki-history-reset () (setq wiliki-history nil) (setq wiliki-history-forward nil)) (defun wiliki-history-push (elem) (setq wiliki-history-forward nil) (setq wiliki-history (cons elem wiliki-history))) (defun wiliki-history-current () "Return the current page." (car wiliki-history)) (defun wiliki-history-previous (&optional count) (or count (setq count 1)) (if (<= count 0) (wiliki-history-current) (let (elem) (while (and (> count 0) (cdr wiliki-history)) (setq elem (car wiliki-history)) (setq wiliki-history (cdr wiliki-history)) (setq wiliki-history-forward (cons elem wiliki-history-forward)) (setq count (1- count))) (if elem (wiliki-history-current))))) (defun wiliki-history-next (&optional count) (or count (setq count 1)) (if (<= count 0) (wiliki-history-current) (let (elem) (while (and (> count 0) wiliki-history-forward) (setq elem (car wiliki-history-forward)) (setq wiliki-history-forward (cdr wiliki-history-forward)) (setq wiliki-history (cons elem wiliki-history)) (setq count (1- count))) elem))) ;;; XXX (defun wiliki-set-mode-line () (setq mode-line-buffer-identification (nconc (propertized-buffer-identification "*WiLiKi*") (list (concat " (" (wiliki-base-url->site-name wiliki-base-url) ") " wiliki-title))))) (defun wiliki-decompose-wiliki-url (url) "Decompose a wiliki page url URL into (BASE-URL . PAGE)." (cond ((string-match "\\(.*\\.cgi\\)/\\([^\\?]*\\)" url) ; wiliki.cgi/Page (cons (match-string 1 url) (match-string 2 url))) ((string-match "\\(.*\\)\\?\\(.*&\\)*p=\\([^&]*\\)" url) ; wiliki.cgi?p=Page (cons (match-string 1 url) (match-string 3 url))) ((string-match "\\(.*\\)\\?\\([^&]*\\)" url) ; wiliki.cgi?Page (let ((base-url (match-string 1 url)) (page (match-string 2 url))) (if (not (string-match "=" page)) (cons base-url page)))))) (defvar wiliki-base-url-hist nil) (defun wiliki-read-base-url (&optional prompt default) "Prompt for a WiLiKi base URL or site name. Return the base URL as a string." (or wiliki-site-info-alist (wiliki-site-info-setup)) (or default (setq default (or (bound-and-true-p wiliki-base-url) wiliki-home-base-url))) (setq default (or (car (wiliki-site-base-url-p default)) default)) (setq prompt (format "%s (default %s): " (or prompt "Base URL or site name") default)) (let ((complete-table (append wiliki-sites wiliki-site-info-alist)) url-or-site-name) (setq url-or-site-name (completing-read prompt complete-table nil nil nil 'wiliki-base-url-hist default)) (or (car (cdr (assoc url-or-site-name wiliki-sites))) ; XXX url-or-site-name))) (defconst wiliki-refetch-item '("$refetch" . nil)) (defvar wiliki-page-hist nil) (defun wiliki-complete-page (string predicate what) ;; XXX: `base-url' must be bound. (let ((complete-table (cons wiliki-refetch-item (wiliki-base-url->page-list base-url)))) (if (eq what t) (all-completions string complete-table predicate) (try-completion string complete-table predicate)))) (defun wiliki-read-page (base-url &optional prompt default) "Prompt for a WikiName." (if (wiliki-decompose-wiliki-url base-url) nil ; BASE-URL contains page name. (let (page refetch) (save-window-excursion (or default (setq default "")) (setq prompt (format "%s (default %s): " (or prompt "WikiName") (if (string= default "") "{top page}" default))) (while (or (not page) (setq refetch (string= page (car wiliki-refetch-item)))) (if refetch (with-output-to-temp-buffer "*Completions*" (wiliki-base-url->page-list base-url t) (display-completion-list (all-completions "" 'wiliki-complete-page)))) (setq page (completing-read prompt 'wiliki-complete-page nil nil nil 'wiliki-page-hist default)))) page))) (defun wiliki-browse-url (url) (let ((browse-url-browser-function wiliki-browse-url-browser-function)) (message "invoking external browser for %s ..." url) (browse-url url) (sit-for 3) (message ""))) ;;; ;;; Interactive commands ;;; (defun wiliki (&optional base-url page) "Enter Emacs WiLiKi browser." (interactive (if current-prefix-arg (let* ((url (wiliki-read-base-url nil wiliki-home-base-url)) (page (wiliki-read-page url))) (list url page)))) (if (not (memq (current-buffer) wiliki-buffer-list)) (setq wiliki-previous-window-config (current-window-configuration))) (if base-url (let ((decomp-url (wiliki-decompose-wiliki-url base-url))) (if decomp-url (wiliki-view-page (car decomp-url) (wiliki-url-unhexify-string (cdr decomp-url))) (wiliki-view-page base-url page))) (let ((his (wiliki-history-current))) (if his (wiliki-view-page (car his) (cdr his) nil t) (wiliki-view-page wiliki-home-base-url ""))))) (defun wiliki-fetch (base-url page) "Fetch a WiLiKi page PAGE from url BASE-URL and return the page buffer." ;; This function is not interactive any more. ;; Use `wiliki-view-page', instead. (message "Retrieving %s from %s ..." (if (string= page "") "{top page}" page) base-url) ;; TODO: refactoring... (if (string-match "^\\$search:\\(.*\\)" page) (let* ((content `(("c" . "s") ("key" . ,(match-string 1 page)))) (proc (wiliki-http-post base-url (wiliki-get-param-string content)))) (prog1 (wiliki-fetch-page-sentinel-html base-url page (process-buffer proc) "<h1>" nil "<li><a href=\"[^\"]*\">\\(.*\\)</a\n*>\\(.*\\)</li" (lambda () (concat "- [[" (match-string 1) "]]" (match-string 2) "\n"))) (message ""))) (let* ((fmt (cond ((string= page "$all") "%s?c=a") ((string= page "$recent") "%s?c=r") ((string= page "") "%s?c=lv") ; workaround for the empty WikiName problem (t "%s?%s&c=lv"))) (url (format fmt base-url (wiliki-url-hexify-string page))) (proc (wiliki-http-get url)) (buf (cond ((string= page "$all") (wiliki-fetch-page-sentinel-html base-url page (process-buffer proc) "<h1>" nil "<li><a href=\"[^\"]*\">\\(.*\\)</a" (lambda () (concat "- [[" (match-string 1) "]]\n")))) ((string= page "$recent") (wiliki-fetch-page-sentinel-html base-url page (process-buffer proc) "<h1>" nil (concat "<tr><td>\\(.*\\)</td\n*>" "<td>\\(.*\\)</td\n*>" "<td><a href=\"[^\"]*\">\\(.*\\)</a") (lambda () (concat "||" (match-string 1) "||" (match-string 2) "||[[" (match-string 3) "]]||\n")))) (t (wiliki-fetch-page-sentinel base-url (process-buffer proc)))))) (if (string= page "") (setf (wiliki-site-info-top-page (wiliki-site-info base-url)) (with-current-buffer buf wiliki-title))) (message "") buf))) (defun wiliki-page-buffer (base-url page &optional force-fetch) "Return the buffer of PAGE on BASE-URL. If the page buffer does not exist, fetch the page from the server of BASE-URL. If FORCE-FETCH is non-nil, the page is forced to fetch from the server. You can explicitly specify the coding system for the access with \\[universal-coding-system-argument]." (or (and (not force-fetch) (get-buffer (wiliki-buffer-name base-url page))) (let ((wiliki-coding-system (or coding-system-for-read wiliki-coding-system))) (wiliki-fetch base-url page)))) (defun wiliki-view-page (base-url page &optional force-fetch no-history) "Visit and view WiLiKi page PAGE from url BASE-URL. If FORCE-FETCH is non-nil, the page is forced to fetch from the server." (interactive (let* ((url (wiliki-read-base-url)) (page (wiliki-read-page url))) (list url page))) (let ((decomp-url (wiliki-decompose-wiliki-url base-url))) (if decomp-url (progn (setq base-url (car decomp-url)) (setq page (wiliki-url-unhexify-string (cdr decomp-url)))))) (let ((buf (wiliki-page-buffer base-url page force-fetch))) (if wiliki-use-other-window (pop-to-buffer buf) (switch-to-buffer buf)) (if (not no-history) (wiliki-history-push (cons wiliki-base-url wiliki-title))) (message "%s" wiliki-title))) (defun wiliki-view-wikiname (wikiname &optional force-fetch) "View WiLiKi page of WIKINAME." (interactive (list (wiliki-read-page wiliki-base-url nil (wiliki-find-wikiname-at-point)) current-prefix-arg)) (let ((iwl (wiliki-inter-wiki-name-p wiliki-base-url wikiname)) decomp-url) (if iwl (if (and (setq decomp-url (wiliki-decompose-wiliki-url iwl)) (wiliki-site-p (car decomp-url))) (wiliki-view-page (car decomp-url) (cdr decomp-url) force-fetch) (wiliki-browse-url iwl)) (wiliki-view-page wiliki-base-url wikiname force-fetch)))) (defun wiliki-view-wikiname-at-point (&optional force-fetch) "View WiLiKi page with WikiName around the current point." (interactive "P") (let ((wikiname (wiliki-find-wikiname-at-point))) (if wikiname (wiliki-view-wikiname wikiname force-fetch) (error "Can't find wiki name around point")))) (defun wiliki-view-previous-page (&optional count) "View previous page. If COUNT is a positive number, move backward COUNT times in the history. If COUNT is a negative number, moving forward is performed." (interactive "p") (or count (setq count 1)) (let (func his) (if (>= count 0) (setq func 'wiliki-history-previous) (setq func 'wiliki-history-next) (setq count (- count))) (if (not (equal (cons wiliki-base-url wiliki-title) (wiliki-history-current))) (setq count (1- count))) (setq his (funcall func count)) (if his (wiliki-view-page (car his) (cdr his) nil t) (error "No more history.")))) (defun wiliki-view-next-page (&optional count) "View next page. See also `wiliki-view-previous-page'." (interactive "p") (or count (setq count 1)) (wiliki-view-previous-page (- count))) (defun wiliki-view-up-page (&optional refetch) "View the superior page of the current page." (interactive) (let ((upper-page (if (and (not (wiliki-pseudo-page-p wiliki-title)) (string-match "\\(.*\\):\\([^:]\\)" wiliki-title)) (match-string 1 wiliki-title) (wiliki-base-url->top-page wiliki-base-url)))) (if (string= wiliki-title upper-page) (error "No upper page") (wiliki-view-wikiname upper-page refetch)))) (defun wiliki-refetch () "Refetch the current page." (interactive) (wiliki-view-page wiliki-base-url wiliki-title t t)) (defvar wiliki-search-hist nil) (defun wiliki-search (key &optional force-fetch) "Search pages." (interactive (list (read-string "Search for: " nil 'wiliki-search-hist) current-prefix-arg)) (wiliki-view-wikiname (concat "$search:" key) force-fetch)) (defun wiliki-view-recent (&optional force-fetch) "View recent changes." (interactive "P") (wiliki-view-wikiname "$recent" force-fetch)) (defun wiliki-view-all (&optional force-fetch) "View list of all the pages." (interactive "P") (wiliki-view-wikiname "$all" force-fetch)) (defun wiliki-view-top (&optional force-fetch) "View the top page." (interactive) (if (string= wiliki-title (wiliki-base-url->top-page wiliki-base-url)) (error "Alreay on the top page")) (wiliki-view-wikiname (wiliki-base-url->top-page wiliki-base-url) force-fetch)) (defun wiliki-backlink (&optional force-fetch) "Search for the current page name." (interactive "P") (if (wiliki-pseudo-page-p wiliki-title) (error "Not a regular page.") (wiliki-search (format "[[%s]]" wiliki-title) force-fetch))) (defun wiliki-next-wikiname () "Move to next wikiname" (interactive) (search-forward "[[" nil t)) (defun wiliki-previous-wikiname () "Move back to previous wikiname" (interactive) (search-backward "]]" nil t)) (defun wiliki-view-with-external-browser () (interactive) (wiliki-browse-url (format "%s?%s" wiliki-base-url wiliki-title))) (defun wiliki-view-with-w3m () (interactive) (let ((wiliki-browse-url-browser-function 'w3m)) (wiliki-view-with-external-browser))) (defun wiliki-bury () "Bury wiliki buffers and restore the previous window configuration, if one exists." (interactive) (let ((buffer-list wiliki-buffer-list)) (while buffer-list (if (buffer-live-p (car buffer-list)) (progn (set-buffer (car buffer-list)) (bury-buffer))) (setq buffer-list (cdr buffer-list)))) (if wiliki-previous-window-config (set-window-configuration wiliki-previous-window-config))) (defun wiliki-quit () "Delete all wiliki buffers" (interactive) (if (y-or-n-p "Do you want to exit wiliki? ") (let ((config wiliki-previous-window-config)) (wiliki-history-reset) (while wiliki-buffer-list (kill-buffer (car wiliki-buffer-list)) (setq wiliki-buffer-list (cdr wiliki-buffer-list))) (setq wiliki-site-info-alist nil) (if (window-configuration-p config) (set-window-configuration config)) (setq wiliki-previous-window-config nil))) (message "")) ;;; for Wiliki Edit Mode (defun wiliki-edit (base-url &optional page force-fetch) "Enter wiliki edit mode." (interactive (let* ((url (wiliki-read-base-url nil wiliki-home-base-url)) (page (wiliki-read-page url))) (list url page current-prefix-arg))) (let ((decomp-url (wiliki-decompose-wiliki-url base-url))) (if decomp-url (setq base-url (car decomp-url) page (wiliki-url-unhexify-string (cdr decomp-url))))) (or page (setq page "")) (let* ((buf (wiliki-page-buffer base-url page force-fetch)) (editable (with-current-buffer buf wiliki-editable)) (edit-bufname (with-current-buffer buf (wiliki-buffer-name wiliki-base-url wiliki-title 'edit)))) (if (not editable) (error "Can't edit this page") (if (and (get-buffer edit-bufname) (buffer-modified-p (get-buffer edit-bufname)) (save-window-excursion (pop-to-buffer edit-bufname) (not (y-or-n-p (concat "The page is already in edit. " "Discard the changes and edit again? "))))) (message "Edit canceled by the user") (let ((config (current-window-configuration)) (edit-buf (get-buffer-create edit-bufname)) pos body base-url title mtime status use-lwp-for-commit) (with-current-buffer buf (setq pos (point) body (buffer-string) base-url wiliki-base-url charset wiliki-coding-system title wiliki-title mtime wiliki-mtime status wiliki-status use-lwp-for-commit wiliki-use-lwp-for-commit)) (add-to-list 'wiliki-buffer-list edit-buf) (set-buffer edit-buf) (erase-buffer) (wiliki-edit-mode) (setq wiliki-edit-base-url base-url) (setq wiliki-coding-system charset) (setq wiliki-edit-title title) (setq wiliki-edit-mtime mtime) (setq wiliki-edit-status status) (setq wiliki-use-lwp-for-commit use-lwp-for-commit) (setq wiliki-edit-previous-window-config config) (if wiliki-use-lwp-for-commit (setq mode-name (concat mode-name "/LWP"))) ; XXX (insert body) (goto-char pos) (set-buffer-modified-p nil) (or (eq buffer-undo-list t) (setq buffer-undo-list nil)) (if (interactive-p) (switch-to-buffer edit-buf) (pop-to-buffer edit-buf))) (message "Type C-c C-c to commit"))))) (defun wiliki-edit-this-page (refetch) "Enter wiliki edit mode for the current page." (interactive "P") (if (consp refetch) (wiliki-refetch)) (wiliki-edit wiliki-base-url wiliki-title)) (defun wiliki-edit-ediff () "Run ediff on the current WiLiKi edit buffer and its view buffer." (interactive) (let ((edit-buf (current-buffer)) (buf (get-buffer (wiliki-buffer-name wiliki-edit-base-url wiliki-edit-title)))) (ediff-buffers buf edit-buf))) (defun wiliki-commit (base-url page mtime &optional logmsg donttouch) (let ((param-alist (list (if wiliki-use-lwp-for-commit (cons "c" "lc") (cons "c" "c")) (cons "commit" "commit") (cons "p" page) (cons "mtime" (or mtime "0")) (cons "content" (buffer-string)) (cons "logmsg" (or logmsg "")))) proc) (if donttouch (setq param-alist (nconc param-alist '(("donttouch" . "on"))))) (message "Sending update to %s" base-url) (setq proc (wiliki-http-post base-url (wiliki-get-param-string param-alist))) (if wiliki-use-lwp-for-commit (wiliki-commit-sentinel base-url (process-buffer proc)) (wiliki-commit-sentinel-html base-url page (process-buffer proc))) (run-hooks 'wiliki-commit-done-hook))) (defun wiliki-edit-quit () "Quit editing page." (interactive) (if (or (not (buffer-modified-p)) (y-or-n-p "Discard the changes? ")) (let ((edit-buf (current-buffer)) (log-buf (get-buffer (wiliki-buffer-name wiliki-edit-base-url wiliki-edit-title 'log))) (config wiliki-edit-previous-window-config)) (if log-buf (progn (setq wiliki-buffer-list (delete log-buf wiliki-buffer-list)) (kill-buffer log-buf))) (setq wiliki-buffer-list (delete edit-buf wiliki-buffer-list)) (kill-buffer edit-buf) (if (window-configuration-p config) (set-window-configuration config)) (message "")))) (defun wiliki-edit-log () "Edit log message." (interactive) (if (eq major-mode 'wiliki-edit-mode) (let ((edit-buf (current-buffer)) (log-buf (get-buffer-create (wiliki-buffer-name wiliki-edit-base-url wiliki-edit-title 'log)))) (add-to-list 'wiliki-buffer-list log-buf) (pop-to-buffer log-buf) (wiliki-log-mode) (setq wiliki-edit-buf edit-buf) (message "Enter a log message. Type C-c C-c to commit")) (error "Not a Wiliki Edit Mode."))) (defun wiliki-edit-next-action (dont-touch) (interactive "P") (if (eq major-mode 'wiliki-edit-mode) (if (buffer-modified-p) (if wiliki-ask-log (wiliki-edit-log) (if (y-or-n-p "Do you want to commit? ") (wiliki-commit wiliki-edit-base-url wiliki-edit-title wiliki-edit-mtime nil dont-touch) (message ""))) (message "(No changes need to be committed)")) (error "Not a Wiliki Edit Mode."))) (defun wiliki-recenter-and-fontify (&optional arg) "Center point in window, redisplay frame, and fontify the current buffer if Font-Lock mode is enabled." (interactive "P") (recenter arg) (if font-lock-mode (font-lock-fontify-buffer))) (defun wiliki-log-done (dont-touch) "Finish editing the log message and commit the changes to the server. If DONT-TOUCH is non-nil, the page does not update 'Recent Changes'." (interactive "P") (if (eq major-mode 'wiliki-log-mode) (let ((logmsg (buffer-string))) ;; TODO: strip heading and tailing white spaces of the log message. (with-current-buffer wiliki-edit-buf (wiliki-commit wiliki-edit-base-url wiliki-edit-title wiliki-edit-mtime logmsg dont-touch))))) (defun wiliki-previous-comment (arg) (interactive "p")) (defun wiliki-next-comment (arg) (interactive "p")) ;;; ;;; ;;; (if wiliki-mode-map () (setq wiliki-mode-map (make-sparse-keymap)) (define-key wiliki-mode-map "\C-c\C-o" 'wiliki-view-wikiname-at-point) (define-key wiliki-mode-map "\C-m" 'wiliki-view-wikiname-at-point) (define-key wiliki-mode-map "\C-i" 'wiliki-next-wikiname) (define-key wiliki-mode-map "\C-\M-i" 'wiliki-previous-wikiname) (define-key wiliki-mode-map [(shift tab)] 'wiliki-previous-wikiname) (define-key wiliki-mode-map [(shift iso-lefttab)] 'wiliki-previous-wikiname) (define-key wiliki-mode-map " " 'scroll-up) (define-key wiliki-mode-map "[delete]" 'scroll-down) (define-key wiliki-mode-map "[backspace]" 'scroll-down) (define-key wiliki-mode-map "\C-?" 'scroll-down) (define-key wiliki-mode-map "a" 'wiliki-view-all) (define-key wiliki-mode-map "e" 'wiliki-edit-this-page) (define-key wiliki-mode-map "f" 'wiliki-view-wikiname) (define-key wiliki-mode-map "g" 'wiliki-view-page) (define-key wiliki-mode-map "l" 'wiliki-view-previous-page) (define-key wiliki-mode-map "n" 'wiliki-view-next-page) (define-key wiliki-mode-map "m" 'wiliki-view-with-w3m) (define-key wiliki-mode-map "M" 'wiliki-view-with-external-browser) (define-key wiliki-mode-map "p" 'wiliki-view-previous-page) (define-key wiliki-mode-map "q" 'wiliki-bury) (define-key wiliki-mode-map "Q" 'wiliki-quit) (define-key wiliki-mode-map "r" 'wiliki-view-recent) (define-key wiliki-mode-map "R" 'wiliki-refetch) (define-key wiliki-mode-map "s" 'wiliki-search) (define-key wiliki-mode-map "t" 'wiliki-view-top) (define-key wiliki-mode-map "u" 'wiliki-view-up-page)) (if wiliki-edit-mode-map () (setq wiliki-edit-mode-map (make-sparse-keymap)) (define-key wiliki-edit-mode-map "\C-c\C-c" 'wiliki-edit-next-action) (define-key wiliki-edit-mode-map "\C-c\C-q" 'wiliki-edit-quit) (define-key wiliki-edit-mode-map "\C-c?" 'wiliki-edit-ediff) (define-key wiliki-edit-mode-map "\C-i" 'wiliki-next-wikiname) (define-key wiliki-edit-mode-map [(shift tab)] 'wiliki-previous-wikiname) (define-key wiliki-edit-mode-map [(shift iso-lefttab)] 'wiliki-previous-wikiname) (define-key wiliki-edit-mode-map "\C-l" 'wiliki-recenter-and-fontify)) (if wiliki-log-mode-map () (setq wiliki-log-mode-map (make-sparse-keymap)) (define-key wiliki-log-mode-map "\C-c\C-c" 'wiliki-log-done) (define-key wiliki-log-mode-map "\M-p" 'wiliki-previous-comment) (define-key wiliki-log-mode-map "\M-n" 'wiliki-next-comment)) ;;; Faces (defface wiliki-header-1-face '((t (:weight bold :height 1.3 :inherit variable-pitch))) "Face for Wiliki headers of level 1.") (defface wiliki-header-2-face '((t (:weight bold :height 1.2 :inherit variable-pitch))) "Face for Wiliki headers of level 2.") (defface wiliki-header-3-face '((t (:weight bold :height 1.1 :inherit variable-pitch))) "Face for Wiliki headers of level 3.") (defface wiliki-header-4-face '((t (:weight bold :height 1.0 :inherit variable-pitch))) "Face for Wiliki headers of level 4.") (defface wiliki-header-5-face '((t (:weight bold :height 0.9 :inherit variable-pitch))) "Face for Wiliki headers of level 5 and below.") (defface wiliki-link-face '((((class color) (background light)) (:foreground "#551a8b" :bold t)) (((class color) (background dark)) (:foreground "cyan" :bold t)) (t (:bold t))) "Face for Wiliki links.") (defface wiliki-table-border-face '((((class color)) (:foreground "blue4")) (t (:bold t))) "Face for Wiliki table border.") (defface wiliki-table-rule-face '((((class color)) (:foreground "skyblue4")) (t (:bold t))) "Face for Wiliki table border.") (defface wiliki-verbatim-face '((((class color) (background light)) (:foreground "OliveDrab")) (((class color) (background dark)) (:foreground "LightSalmon")) (((type tty) (class color)) (:foreground "green")) (t (:italic t))) "Face for Wiliki verbatim texts.") (defface wiliki-bold-face '((t (:bold t))) "Face for Wiliki bold texts.") (defface wiliki-italic-face '((t (:italic t))) "Face for Wiliki italic texts.") (defvar wiliki-header-1-face 'wiliki-header-1-face) (defvar wiliki-header-2-face 'wiliki-header-2-face) (defvar wiliki-header-3-face 'wiliki-header-3-face) (defvar wiliki-header-4-face 'wiliki-header-4-face) (defvar wiliki-header-5-face 'wiliki-header-5-face) (defvar wiliki-link-face 'wiliki-link-face) (defvar wiliki-table-border-face 'wiliki-table-border-face) (defvar wiliki-table-rule-face 'wiliki-table-rule-face) (defvar wiliki-verbatim-face 'wiliki-verbatim-face) (defvar wiliki-bold-face 'wiliki-bold-face) (defvar wiliki-italic-face 'wiliki-italic-face) (defconst wiliki-any-char-regexp "\\(?:.\\|\n~\\)") (defvar wiliki-font-lock-emphasis-regions nil) (defun wiliki-font-lock-init () (set (make-local-variable 'wiliki-font-lock-emphasis-regions) nil) '((lambda (end) (setq wiliki-font-lock-emphasis-regions nil) nil))) (defun wiliki-fontify-later (face) `(ignore nil (setq wiliki-font-lock-emphasis-regions (cons (list (match-data) ,face) wiliki-font-lock-emphasis-regions)))) (defun wiliki-font-lock-fontify-delayed-regions () '((lambda (end) (if wiliki-font-lock-emphasis-regions (let ((match (nth 0 (car wiliki-font-lock-emphasis-regions)))) (set-match-data match) (goto-char (match-end 0)) (match-beginning 0)))) (2 (prog1 (nth 1 (car wiliki-font-lock-emphasis-regions)) (setq wiliki-font-lock-emphasis-regions (cdr wiliki-font-lock-emphasis-regions))) append))) (defun wiliki-font-lock-matcher (regexp) `(lambda (end) (wiliki-font-lock-search-no-face ,regexp end t))) (put 'wiliki-font-lock-matcher 'lisp-indent-function 1) (defvar wiliki-font-lock-syntactic-keywords `(("\n~" 0 "_"))) (defvar wiliki-font-lock-keywords `((eval . (wiliki-font-lock-init)) ("^;;.*" . font-lock-comment-face) ("^----$" . wiliki-bold-face) ; <hr> "^\\(<<<\\|>>>\\)$" ; <blockquote> ("^\\([-#]+\\) " (1 font-lock-function-name-face)) ; <ul> and <ol> (,(concat "^\\(||\\)\\(" wiliki-any-char-regexp "*?\\)\\(||\\)$") ; <table> (1 wiliki-table-border-face) (3 wiliki-table-border-face) ("||" (progn (goto-char (match-beginning 2)) (match-end 2)) (goto-char (match-end 0)) (0 wiliki-table-rule-face))) (,(wiliki-font-lock-matcher ; writer macro such as [[$date]] (concat "\\(\\[\\[\\)\\(\\$\\(" wiliki-writer-macro-regexp "\\)\\)\\( " wiliki-any-char-regexp "*?\\)?\\(\\]\\]\\)")) (1 font-lock-keyword-face) (2 font-lock-type-face) (4 font-lock-reference-face nil t) (5 font-lock-keyword-face)) (,(wiliki-font-lock-matcher ; reader macro such as [[$$toc]] (concat "\\(\\[\\[\\)\\(\\$\\$\\(" wiliki-reader-macro-regexp "\\)\\)\\( " wiliki-any-char-regexp "*?\\)?\\(\\]\\]\\)")) (1 font-lock-keyword-face) (2 font-lock-type-face) (4 font-lock-reference-face nil t) (5 font-lock-keyword-face)) (,(wiliki-font-lock-matcher ; unknown macro (concat "\\(\\[\\[\\)\\(\\$" wiliki-any-char-regexp "*?\\)\\(\\]\\]\\)")) (1 font-lock-keyword-face) (2 font-lock-warning-face) (3 font-lock-keyword-face)) (,(wiliki-font-lock-matcher ; [[WikiName]] (concat "\\(\\[\\[\\)\\(" wiliki-any-char-regexp "*?\\)\\(\\]\\]\\)")) (1 font-lock-keyword-face) (2 wiliki-link-face) (3 font-lock-keyword-face)) (,(concat "^\\(:\\)\\(" wiliki-any-char-regexp "*\\)\\(:\\)") ; <dl> (1 font-lock-keyword-face) ,(wiliki-fontify-later wiliki-bold-face) (3 font-lock-keyword-face)) (,(wiliki-font-lock-matcher ; <strong> (concat "\\('''\\)\\([^'\n]?" wiliki-any-char-regexp "*?\\)\\('''\\)")) (1 font-lock-keyword-face) ,(wiliki-fontify-later wiliki-bold-face) (3 font-lock-keyword-face)) (,(wiliki-font-lock-matcher ; <em> (concat "\\(''\\)\\([^'\n]?" wiliki-any-char-regexp "*?\\)\\(''\\)")) (1 font-lock-keyword-face) ,(wiliki-fontify-later wiliki-italic-face) (3 font-lock-keyword-face)) (".\\(~%\\)" (1 font-lock-warning-face)) ; <br> ;; [url] (,(wiliki-font-lock-matcher (concat "\\(\\[\\)\\(\\(https?\\|ftp\\)://\\S-*?\\)\\( +\\(" wiliki-any-char-regexp "*?\\)\\)?\\(\\]\\)")) (1 font-lock-keyword-face) (2 wiliki-link-face) (5 font-lock-reference-face) (6 font-lock-keyword-face)) (,(wiliki-font-lock-matcher "\\(https?\\|ftp\\)://\\S-*") ; url ;; XXX: http://foo''italic'' . wiliki-link-face) (,(wiliki-font-lock-matcher (concat "\\(\\[\\)\\(mailto:\\S-+@\\S-+\\)\\s-+\\(\\S-" wiliki-any-char-regexp "*\\)\\(\\]\\)")) (1 font-lock-keyword-face) (2 wiliki-link-face) (3 font-lock-reference-face) (4 font-lock-keyword-face)) (,(concat "^\\(\\*+\\) " ; <h2>, <h3>, <h4>, ... wiliki-any-char-regexp "*") (0 (let* ((len (- (match-end 1) (match-beginning 1))) (face-name (format "wiliki-header-%d-face" (min len 5)))) (intern face-name)) keep)) ;; fontify body portion of '''...''', ''...'', and :...: ;; These fontifications are delayed until here. ,(wiliki-font-lock-fontify-delayed-regions) ("^~" (0 font-lock-warning-face t)) ("^\\({{{\\)\n\\(\\(.*\n\\)*?\\)\\(}}}\\)$" ; <pre> (1 font-lock-keyword-face) (2 wiliki-verbatim-face t) ; override faces (4 font-lock-keyword-face))) "Default expressions to highlight in Wiliki modes.") (defun wiliki-font-lock-search-no-face (regexp &optional bound noerror face) (or bound (setq bound (point-max))) (let ((saved (point)) (move-to-beg-func (if face 'text-property-not-all 'text-property-any)) (move-to-end-func (if face 'text-property-any 'text-property-not-all)) found) (while (and (not found) (re-search-forward regexp bound t)) ; search roughly (let* ((beg (or (funcall move-to-beg-func (match-beginning 0) bound 'face face) bound)) (end (or (funcall move-to-end-func beg bound 'face face) bound))) (if (and (< beg (match-beginning 0)) (< (match-end 0) end)) (setq found (point)) (goto-char beg) (if (re-search-forward regexp end 'move) (setq found (point)))))) (or found (cond ((null noerror) (error "search failed")) ((eq noerror t) (goto-char saved) nil) (t (goto-char bound) nil))))) ;;; Mode definitions (defun wiliki-mode () "Major mode to communicate WiLiKi. \\{wiliki-mode-map}" (interactive) (make-local-variable 'wiliki-site-info) (make-local-variable 'wiliki-base-url) (make-local-variable 'wiliki-title) (make-local-variable 'wiliki-mtime) (make-local-variable 'wiliki-status) (make-local-variable 'wiliki-editable) (make-local-variable 'wiliki-use-lwp-for-commit) (make-local-variable 'wiliki-coding-system) (set (make-local-variable 'font-lock-support-mode) 'fast-lock-mode) (set (make-local-variable 'font-lock-defaults) '(wiliki-font-lock-keywords t t nil backward-paragraph)) (set (make-local-variable 'font-lock-syntactic-keywords) wiliki-font-lock-syntactic-keywords) (setq major-mode 'wiliki-mode) (setq mode-name "WiLiKi") (make-local-variable 'kill-buffer-hook) (use-local-map wiliki-mode-map) (run-hooks 'wiliki-mode-hook)) ;; (defun wiliki-edit-mode () (define-derived-mode wiliki-edit-mode text-mode "Wiliki-Edit" "Major mode to edit and commit WiLiKi page. \\{wiliki-edit-mode-map}" (interactive) (make-local-variable 'wiliki-edit-base-url) (make-local-variable 'wiliki-edit-title) (make-local-variable 'wiliki-edit-mtime) (make-local-variable 'wiliki-edit-status) (make-local-variable 'wiliki-edit-previous-window-config) (make-local-variable 'wiliki-use-lwp-for-commit) (make-local-variable 'wiliki-coding-system) (set (make-local-variable 'font-lock-defaults) '(wiliki-font-lock-keywords t t nil backward-paragraph)) (set (make-local-variable 'font-lock-syntactic-keywords) wiliki-font-lock-syntactic-keywords) (set (make-local-variable 'font-lock-multiline) t) (setq major-mode 'wiliki-edit-mode) (setq mode-name "WiLiKi-Edit") (set (make-local-variable 'comment-start) ";;") (use-local-map wiliki-edit-mode-map) (make-local-variable 'kill-buffer-hook) ;; (wiliki-set-mode-line)) (run-hooks 'wiliki-edit-mode-hook)) (define-derived-mode wiliki-log-mode text-mode "Wiliki-Log" "Major mode to edit WiLiKi log message. \\{wiliki-log-mode-map}" (make-local-variable 'wiliki-edit-buf) (make-local-variable 'kill-buffer-hook) (run-hooks 'wiliki-log-mode-hook)) ;;; tiny hack for w3m (defun w3m-edit-wiliki (&optional no-check) ;; TODO: run `w3m-reload-this-page' when commit is done successfully. (interactive "P") (if (or (wiliki-site-p w3m-current-url) no-check) (wiliki-edit w3m-current-url nil t) (error "Not a WiLiKi page."))) (provide 'wiliki) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/README���������������������������������������������������������������������������������0000644�0000764�0000764�00000000213�11157564734�012602� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������This is WiLiKi, a Wiki engine written in Scheme. Visit the official site for the details. http://practical-scheme.net/wiliki/wiliki.cgi �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/configure������������������������������������������������������������������������������0000755�0000764�0000764�00000254423�11501274532�013632� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.65 for WiLiKi 0.6.2. # # Report bugs to <shiro@acm.org>. # # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, # 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, # Inc. # # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi as_nl=' ' export as_nl # Printing a long string crashes Solaris 7 /usr/bin/printf. as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo # Prefer a ksh shell builtin over an external printf program on Solaris, # but without wasting forks for bash or zsh. if test -z "$BASH_VERSION$ZSH_VERSION" \ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='print -r --' as_echo_n='print -rn --' elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='printf %s\n' as_echo_n='printf %s' else if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' as_echo_n='/usr/ucb/echo -n' else as_echo_body='eval expr "X$1" : "X\\(.*\\)"' as_echo_n_body='eval arg=$1; case $arg in #( *"$as_nl"*) expr "X$arg" : "X\\(.*\\)$as_nl"; arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; esac; expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" ' export as_echo_n_body as_echo_n='sh -c $as_echo_n_body as_echo' fi export as_echo_body as_echo='sh -c $as_echo_body as_echo' fi # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # Unset variables that we do not need and which cause bugs (e.g. in # pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" # suppresses any "Segmentation fault" message there. '((' could # trigger a bug in pdksh 5.2.14. for as_var in BASH_ENV ENV MAIL MAILPATH do eval test x\${$as_var+set} = xset \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # CDPATH. (unset CDPATH) >/dev/null 2>&1 && unset CDPATH if test "x$CONFIG_SHELL" = x; then as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which # is contrary to our usage. Disable this feature. alias -g '\${1+\"\$@\"}'='\"\$@\"' setopt NO_GLOB_SUBST else case \`(set -o) 2>/dev/null\` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi " as_required="as_fn_return () { (exit \$1); } as_fn_success () { as_fn_return 0; } as_fn_failure () { as_fn_return 1; } as_fn_ret_success () { return 0; } as_fn_ret_failure () { return 1; } exitcode=0 as_fn_success || { exitcode=1; echo as_fn_success failed.; } as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : else exitcode=1; echo positional parameters were not saved. fi test x\$exitcode = x0 || exit 1" as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1" if (eval "$as_required") 2>/dev/null; then : as_have_required=yes else as_have_required=no fi if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR as_found=false for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. as_found=: case $as_dir in #( /*) for as_base in sh bash ksh sh5; do # Try only shells that exist, to save several forks. as_shell=$as_dir/$as_base if { test -f "$as_shell" || test -f "$as_shell.exe"; } && { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : CONFIG_SHELL=$as_shell as_have_required=yes if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : break 2 fi fi done;; esac as_found=false done $as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : CONFIG_SHELL=$SHELL as_have_required=yes fi; } IFS=$as_save_IFS if test "x$CONFIG_SHELL" != x; then : # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also # works around shells that cannot unset nonexistent variables. BASH_ENV=/dev/null ENV=/dev/null (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV export CONFIG_SHELL exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} fi if test x$as_have_required = xno; then : $as_echo "$0: This script requires a shell more modern than all" $as_echo "$0: the shells that I found on your system." if test x${ZSH_VERSION+set} = xset ; then $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" $as_echo "$0: be upgraded to zsh 4.3.4 or later." else $as_echo "$0: Please tell bug-autoconf@gnu.org and shiro@acm.org $0: about your system, including any error possibly output $0: before this message. Then install a modern shell, or $0: manually run the script under such a shell if you do $0: have one." fi exit 1 fi fi fi SHELL=${CONFIG_SHELL-/bin/sh} export SHELL # Unset more variables known to interfere with behavior of common tools. CLICOLOR_FORCE= GREP_OPTIONS= unset CLICOLOR_FORCE GREP_OPTIONS ## --------------------- ## ## M4sh Shell Functions. ## ## --------------------- ## # as_fn_unset VAR # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_fn_exit # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir" } # as_fn_mkdir_p # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : eval 'as_fn_append () { eval $1+=\$2 }' else as_fn_append () { eval $1=\$$1\$2 } fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : eval 'as_fn_arith () { as_val=$(( $* )) }' else as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } fi # as_fn_arith # as_fn_error ERROR [LINENO LOG_FD] # --------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the # script with status $?, using 1 if that was 0. as_fn_error () { as_status=$?; test $as_status -eq 0 && as_status=1 if test "$3"; then as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3 fi $as_echo "$as_me: error: $1" >&2 as_fn_exit $as_status } # as_fn_error if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || $as_echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits as_lineno_1=$LINENO as_lineno_1a=$LINENO as_lineno_2=$LINENO as_lineno_2a=$LINENO eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null fi if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p='mkdir -p "$as_dir"' else test -d ./-p && rmdir ./-p as_mkdir_p=false fi if test -x / >/dev/null 2>&1; then as_test_x='test -x' else if ls -dL / >/dev/null 2>&1; then as_ls_L_option=L else as_ls_L_option= fi as_test_x=' eval sh -c '\'' if test -d "$1"; then test -d "$1/."; else case $1 in #( -*)set "./$1";; esac; case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( ???[sx]*):;;*)false;;esac;fi '\'' sh ' fi as_executable_p=$as_test_x # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" test -n "$DJDIR" || exec 7<&0 </dev/null exec 6>&1 # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` # # Initializations. # ac_default_prefix=/usr/local ac_clean_files= ac_config_libobj_dir=. LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= # Identity of this package. PACKAGE_NAME='WiLiKi' PACKAGE_TARNAME='wiliki' PACKAGE_VERSION='0.6.2' PACKAGE_STRING='WiLiKi 0.6.2' PACKAGE_BUGREPORT='shiro@acm.org' PACKAGE_URL='' ac_subst_vars='LTLIBOBJS LIBOBJS ALL_LINGUAS GAUCHE_PKGARCHDIR GAUCHE_PKGLIBDIR GAUCHE_PKGINCDIR EXEEXT OBJEXT SOEXT GAUCHE_CESCONV GAUCHE_INSTALL GAUCHE_PACKAGE GAUCHE_CONFIG GOSH target_alias host_alias build_alias LIBS ECHO_T ECHO_N ECHO_C DEFS mandir localedir libdir psdir pdfdir dvidir htmldir infodir docdir oldincludedir includedir localstatedir sharedstatedir sysconfdir datadir datarootdir libexecdir sbindir bindir program_transform_name prefix exec_prefix PACKAGE_URL PACKAGE_BUGREPORT PACKAGE_STRING PACKAGE_VERSION PACKAGE_TARNAME PACKAGE_NAME PATH_SEPARATOR SHELL' ac_subst_files='' ac_user_opts=' enable_option_checking ' ac_precious_vars='build_alias host_alias target_alias' # Initialize some variables set by options. ac_init_help= ac_init_version=false ac_unrecognized_opts= ac_unrecognized_sep= # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. # (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' psdir='${docdir}' libdir='${exec_prefix}/lib' localedir='${datarootdir}/locale' mandir='${datarootdir}/man' ac_prev= ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval $ac_prev=\$ac_option ac_prev= continue fi case $ac_option in *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *) ac_optarg=yes ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ | --dataroo | --dataro | --datar) ac_prev=datarootdir ;; -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error "invalid feature name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval enable_$ac_useropt=no ;; -docdir | --docdir | --docdi | --doc | --do) ac_prev=docdir ;; -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) docdir=$ac_optarg ;; -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) ac_prev=dvidir ;; -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error "invalid feature name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval enable_$ac_useropt=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) ac_prev=htmldir ;; -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ | --ht=*) htmldir=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localedir | --localedir | --localedi | --localed | --locale) ac_prev=localedir ;; -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) localedir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) ac_prev=pdfdir ;; -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) pdfdir=$ac_optarg ;; -psdir | --psdir | --psdi | --psd | --ps) ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error "invalid package name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval with_$ac_useropt=\$ac_optarg ;; -without-* | --without-*) ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error "invalid package name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval with_$ac_useropt=no ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) as_fn_error "unrecognized option: \`$ac_option' Try \`$0 --help' for more information." ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. case $ac_envvar in #( '' | [0-9]* | *[!_$as_cr_alnum]* ) as_fn_error "invalid variable name: \`$ac_envvar'" ;; esac eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` as_fn_error "missing argument to $ac_option" fi if test -n "$ac_unrecognized_opts"; then case $enable_option_checking in no) ;; fatal) as_fn_error "unrecognized options: $ac_unrecognized_opts" ;; *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; esac fi # Check all directory arguments for consistency. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir do eval ac_val=\$$ac_var # Remove trailing slashes. case $ac_val in */ ) ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` eval $ac_var=\$ac_val;; esac # Be sure to have absolute directory names. case $ac_val in [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac as_fn_error "expected an absolute directory name for --$ac_var: $ac_val" done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe $as_echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || as_fn_error "working directory cannot be determined" test "X$ac_ls_di" = "X$ac_pwd_ls_di" || as_fn_error "pwd does not report name of working directory" # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$as_myself" || $as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_myself" : 'X\(//\)[^/]' \| \ X"$as_myself" : 'X\(//\)$' \| \ X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$as_myself" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` srcdir=$ac_confdir if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." as_fn_error "cannot find sources ($ac_unique_file) in $srcdir" fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error "$ac_msg" pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then srcdir=. fi # Remove unnecessary trailing slashes from srcdir. # Double slashes in file names in object file debugging info # mess up M-x gdb in Emacs. case $srcdir in */) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; esac for ac_var in $ac_precious_vars; do eval ac_env_${ac_var}_set=\${${ac_var}+set} eval ac_env_${ac_var}_value=\$${ac_var} eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} eval ac_cv_env_${ac_var}_value=\$${ac_var} done # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF \`configure' configures WiLiKi 0.6.2 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/wiliki] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of WiLiKi 0.6.2:";; esac cat <<\_ACEOF Report bugs to <shiro@acm.org>. _ACEOF ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d "$ac_dir" || { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for guested configure. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF WiLiKi configure 0.6.2 generated by GNU Autoconf 2.65 Copyright (C) 2009 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi ## ------------------------ ## ## Autoconf initialization. ## ## ------------------------ ## cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by WiLiKi $as_me 0.6.2, which was generated by GNU Autoconf 2.65. Invocation command line was $ $0 $@ _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` /usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. $as_echo "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; 2) as_fn_append ac_configure_args1 " '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi as_fn_append ac_configure_args " '$ac_arg'" ;; esac done done { ac_configure_args0=; unset ac_configure_args0;} { ac_configure_args1=; unset ac_configure_args1;} # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 $as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) { eval $ac_var=; unset $ac_var;} ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( *${as_nl}ac_space=\ *) sed -n \ "s/'\''/'\''\\\\'\'''\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" ;; #( *) sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac $as_echo "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------------- ## ## File substitutions. ## ## ------------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac $as_echo "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo cat confdefs.h echo fi test "$ac_signal" != 0 && $as_echo "$as_me: caught signal $ac_signal" $as_echo "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h $as_echo "/* confdefs.h */" > confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_URL "$PACKAGE_URL" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer an explicitly selected file to automatically selected ones. ac_site_file1=NONE ac_site_file2=NONE if test -n "$CONFIG_SITE"; then ac_site_file1=$CONFIG_SITE elif test "x$prefix" != xNONE; then ac_site_file1=$prefix/share/config.site ac_site_file2=$prefix/etc/config.site else ac_site_file1=$ac_default_prefix/share/config.site ac_site_file2=$ac_default_prefix/etc/config.site fi for ac_site_file in "$ac_site_file1" "$ac_site_file2" do test "x$ac_site_file" = xNONE && continue if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 $as_echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special files # actually), so we avoid doing that. DJGPP emulates it as a regular file. if test /dev/null != "$cache_file" && test -f "$cache_file"; then { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 $as_echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 $as_echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 $as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 $as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then # differences in whitespace do not lead to failure. ac_old_val_w=`echo x $ac_old_val` ac_new_val_w=`echo x $ac_new_val` if test "$ac_old_val_w" != "$ac_new_val_w"; then { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 $as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} ac_cache_corrupted=: else { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 $as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} eval $ac_var=\$ac_old_val fi { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 $as_echo "$as_me: former value: \`$ac_old_val'" >&2;} { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 $as_echo "$as_me: current value: \`$ac_new_val'" >&2;} fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) as_fn_append ac_configure_args " '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 $as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} as_fn_error "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 fi ## -------------------- ## ## Main body of script. ## ## -------------------- ## ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Extract the first word of "gosh", so it can be a program name with args. set dummy gosh; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_path_GOSH+set}" = set; then : $as_echo_n "(cached) " >&6 else case $GOSH in [\\/]* | ?:[\\/]*) ac_cv_path_GOSH="$GOSH" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_path_GOSH="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi GOSH=$ac_cv_path_GOSH if test -n "$GOSH"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GOSH" >&5 $as_echo "$GOSH" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi # Extract the first word of "gauche-config", so it can be a program name with args. set dummy gauche-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_path_GAUCHE_CONFIG+set}" = set; then : $as_echo_n "(cached) " >&6 else case $GAUCHE_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_GAUCHE_CONFIG="$GAUCHE_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_path_GAUCHE_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi GAUCHE_CONFIG=$ac_cv_path_GAUCHE_CONFIG if test -n "$GAUCHE_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GAUCHE_CONFIG" >&5 $as_echo "$GAUCHE_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi # Extract the first word of "gauche-package", so it can be a program name with args. set dummy gauche-package; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_path_GAUCHE_PACKAGE+set}" = set; then : $as_echo_n "(cached) " >&6 else case $GAUCHE_PACKAGE in [\\/]* | ?:[\\/]*) ac_cv_path_GAUCHE_PACKAGE="$GAUCHE_PACKAGE" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_path_GAUCHE_PACKAGE="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi GAUCHE_PACKAGE=$ac_cv_path_GAUCHE_PACKAGE if test -n "$GAUCHE_PACKAGE"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GAUCHE_PACKAGE" >&5 $as_echo "$GAUCHE_PACKAGE" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi # Extract the first word of "gauche-install", so it can be a program name with args. set dummy gauche-install; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_path_GAUCHE_INSTALL+set}" = set; then : $as_echo_n "(cached) " >&6 else case $GAUCHE_INSTALL in [\\/]* | ?:[\\/]*) ac_cv_path_GAUCHE_INSTALL="$GAUCHE_INSTALL" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_path_GAUCHE_INSTALL="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi GAUCHE_INSTALL=$ac_cv_path_GAUCHE_INSTALL if test -n "$GAUCHE_INSTALL"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GAUCHE_INSTALL" >&5 $as_echo "$GAUCHE_INSTALL" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi # Extract the first word of "gauche-cesconv", so it can be a program name with args. set dummy gauche-cesconv; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_path_GAUCHE_CESCONV+set}" = set; then : $as_echo_n "(cached) " >&6 else case $GAUCHE_CESCONV in [\\/]* | ?:[\\/]*) ac_cv_path_GAUCHE_CESCONV="$GAUCHE_CESCONV" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_path_GAUCHE_CESCONV="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi GAUCHE_CESCONV=$ac_cv_path_GAUCHE_CESCONV if test -n "$GAUCHE_CESCONV"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GAUCHE_CESCONV" >&5 $as_echo "$GAUCHE_CESCONV" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi SOEXT=`"$GAUCHE_CONFIG" --so-suffix` OBJEXT=`"$GAUCHE_CONFIG" --object-suffix` EXEEXT=`"$GAUCHE_CONFIG" --executable-suffix` GAUCHE_PKGINCDIR=`"$GAUCHE_CONFIG" --pkgincdir` GAUCHE_PKGLIBDIR=`"$GAUCHE_CONFIG" --pkglibdir` GAUCHE_PKGARCHDIR=`"$GAUCHE_CONFIG" --pkgarchdir` ALL_LINGUAS="ja" GAUCHE_PACKAGE_CONFIGURE_ARGS="`echo ""$ac_configure_args"" | sed 's/\\""\`\$/\\\&/g'`" { $as_echo "$as_me:${as_lineno-$LINENO}: creating ${PACKAGE_NAME}.gpd" >&5 $as_echo "$as_me: creating ${PACKAGE_NAME}.gpd" >&6;} "$GAUCHE_PACKAGE" make-gpd "$PACKAGE_NAME" \ -version "$PACKAGE_VERSION" \ -configure "./configure $GAUCHE_PACKAGE_CONFIGURE_ARGS" echo $PACKAGE_VERSION > VERSION ac_config_files="$ac_config_files Makefile src/Makefile doc/Makefile test/Makefile po/Makefile" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, we kill variables containing newlines. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 $as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) { eval $ac_var=; unset $ac_var;} ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) # `set' does not quote correctly, so add quotes: double-quote # substitution turns \\\\ into \\, and sed turns \\ into \. sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; #( *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then test "x$cache_file" != "x/dev/null" && { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 $as_echo "$as_me: updating cache $cache_file" >&6;} cat confcache >$cache_file else { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 $as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that # take arguments), then branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. ac_script=' :mline /\\$/{ N s,\\\n,, b mline } t clear :clear s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g t quote s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g t quote b any :quote s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g s/\[/\\&/g s/\]/\\&/g s/\$/$$/g H :any ${ g s/^\n// s/\n/ /g p } ' DEFS=`sed -n "$ac_script" confdefs.h` ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ac_i=`$as_echo "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : ${CONFIG_STATUS=./config.status} ac_write_fail=0 ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 $as_echo "$as_me: creating $CONFIG_STATUS" >&6;} as_write_fail=0 cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} export SHELL _ASEOF cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi as_nl=' ' export as_nl # Printing a long string crashes Solaris 7 /usr/bin/printf. as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo # Prefer a ksh shell builtin over an external printf program on Solaris, # but without wasting forks for bash or zsh. if test -z "$BASH_VERSION$ZSH_VERSION" \ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='print -r --' as_echo_n='print -rn --' elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='printf %s\n' as_echo_n='printf %s' else if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' as_echo_n='/usr/ucb/echo -n' else as_echo_body='eval expr "X$1" : "X\\(.*\\)"' as_echo_n_body='eval arg=$1; case $arg in #( *"$as_nl"*) expr "X$arg" : "X\\(.*\\)$as_nl"; arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; esac; expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" ' export as_echo_n_body as_echo_n='sh -c $as_echo_n_body as_echo' fi export as_echo_body as_echo='sh -c $as_echo_body as_echo' fi # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # Unset variables that we do not need and which cause bugs (e.g. in # pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" # suppresses any "Segmentation fault" message there. '((' could # trigger a bug in pdksh 5.2.14. for as_var in BASH_ENV ENV MAIL MAILPATH do eval test x\${$as_var+set} = xset \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # CDPATH. (unset CDPATH) >/dev/null 2>&1 && unset CDPATH # as_fn_error ERROR [LINENO LOG_FD] # --------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the # script with status $?, using 1 if that was 0. as_fn_error () { as_status=$?; test $as_status -eq 0 && as_status=1 if test "$3"; then as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3 fi $as_echo "$as_me: error: $1" >&2 as_fn_exit $as_status } # as_fn_error # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_fn_exit # as_fn_unset VAR # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : eval 'as_fn_append () { eval $1+=\$2 }' else as_fn_append () { eval $1=\$$1\$2 } fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : eval 'as_fn_arith () { as_val=$(( $* )) }' else as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } fi # as_fn_arith if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || $as_echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null fi if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir" } # as_fn_mkdir_p if mkdir -p . 2>/dev/null; then as_mkdir_p='mkdir -p "$as_dir"' else test -d ./-p && rmdir ./-p as_mkdir_p=false fi if test -x / >/dev/null 2>&1; then as_test_x='test -x' else if ls -dL / >/dev/null 2>&1; then as_ls_L_option=L else as_ls_L_option= fi as_test_x=' eval sh -c '\'' if test -d "$1"; then test -d "$1/."; else case $1 in #( -*)set "./$1";; esac; case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( ???[sx]*):;;*)false;;esac;fi '\'' sh ' fi as_executable_p=$as_test_x # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 6>&1 ## ----------------------------------- ## ## Main body of $CONFIG_STATUS script. ## ## ----------------------------------- ## _ASEOF test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by WiLiKi $as_me 0.6.2, which was generated by GNU Autoconf 2.65. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ on `(hostname || uname -n) 2>/dev/null | sed 1q` " _ACEOF case $ac_config_files in *" "*) set x $ac_config_files; shift; ac_config_files=$*;; esac cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 # Files that config.status was made for. config_files="$ac_config_files" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ac_cs_usage="\ \`$as_me' instantiates files and other configuration actions from templates according to the current configuration. Unless the files and actions are specified as TAGs, all are instantiated by default. Usage: $0 [OPTION]... [TAG]... -h, --help print this help, then exit -V, --version print version number and configuration settings, then exit --config print configuration, then exit -q, --quiet, --silent do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE Configuration files: $config_files Report bugs to <shiro@acm.org>." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ WiLiKi config.status 0.6.2 configured by $0, generated by GNU Autoconf 2.65, with options \\"\$ac_cs_config\\" Copyright (C) 2009 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' test -n "\$AWK" || AWK=awk _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # The default lists apply if the user does not specify any file. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) $as_echo "$ac_cs_version"; exit ;; --config | --confi | --conf | --con | --co | --c ) $as_echo "$ac_cs_config"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift case $ac_optarg in *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; esac as_fn_append CONFIG_FILES " '$ac_optarg'" ac_need_defaults=false;; --he | --h | --help | --hel | -h ) $as_echo "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) as_fn_error "unrecognized option: \`$1' Try \`$0 --help' for more information." ;; *) as_fn_append ac_config_targets " $1" ac_need_defaults=false ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion shift \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 CONFIG_SHELL='$SHELL' export CONFIG_SHELL exec "\$@" fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX $as_echo "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Handling of arguments. for ac_config_target in $ac_config_targets do case $ac_config_target in "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; "src/Makefile") CONFIG_FILES="$CONFIG_FILES src/Makefile" ;; "doc/Makefile") CONFIG_FILES="$CONFIG_FILES doc/Makefile" ;; "test/Makefile") CONFIG_FILES="$CONFIG_FILES test/Makefile" ;; "po/Makefile") CONFIG_FILES="$CONFIG_FILES po/Makefile" ;; *) as_fn_error "invalid argument: \`$ac_config_target'" "$LINENO" 5;; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: # after its creation but before its name has been assigned to `$tmp'. $debug || { tmp= trap 'exit_status=$? { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status ' 0 trap 'as_fn_exit 1' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || as_fn_error "cannot create a temporary directory in ." "$LINENO" 5 # Set up the scripts for CONFIG_FILES section. # No need to generate them if there are no CONFIG_FILES. # This happens for instance with `./config.status config.h'. if test -n "$CONFIG_FILES"; then ac_cr=`echo X | tr X '\015'` # On cygwin, bash can eat \r inside `` if the user requested igncr. # But we know of no other shell where ac_cr would be empty at this # point, so we can use a bashism as a fallback. if test "x$ac_cr" = x; then eval ac_cr=\$\'\\r\' fi ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null` if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then ac_cs_awk_cr='\r' else ac_cs_awk_cr=$ac_cr fi echo 'BEGIN {' >"$tmp/subs1.awk" && _ACEOF { echo "cat >conf$$subs.awk <<_ACEOF" && echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && echo "_ACEOF" } >conf$$subs.sh || as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 ac_delim_num=`echo "$ac_subst_vars" | grep -c '$'` ac_delim='%!_!# ' for ac_last_try in false false false false false :; do . ./conf$$subs.sh || as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` if test $ac_delim_n = $ac_delim_num; then break elif $ac_last_try; then as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi done rm -f conf$$subs.sh cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 cat >>"\$tmp/subs1.awk" <<\\_ACAWK && _ACEOF sed -n ' h s/^/S["/; s/!.*/"]=/ p g s/^[^!]*!// :repl t repl s/'"$ac_delim"'$// t delim :nl h s/\(.\{148\}\)..*/\1/ t more1 s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ p n b repl :more1 s/["\\]/\\&/g; s/^/"/; s/$/"\\/ p g s/.\{148\}// t nl :delim h s/\(.\{148\}\)..*/\1/ t more2 s/["\\]/\\&/g; s/^/"/; s/$/"/ p b :more2 s/["\\]/\\&/g; s/^/"/; s/$/"\\/ p g s/.\{148\}// t delim ' <conf$$subs.awk | sed ' /^[^""]/{ N s/\n// } ' >>$CONFIG_STATUS || ac_write_fail=1 rm -f conf$$subs.awk cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACAWK cat >>"\$tmp/subs1.awk" <<_ACAWK && for (key in S) S_is_set[key] = 1 FS = "" } { line = $ 0 nfields = split(line, field, "@") substed = 0 len = length(field[1]) for (i = 2; i < nfields; i++) { key = field[i] keylen = length(key) if (S_is_set[key]) { value = S[key] line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) len += length(value) + length(field[++i]) substed = 1 } else len += 1 + keylen } print line } _ACAWK _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" else cat fi < "$tmp/subs1.awk" > "$tmp/subs.awk" \ || as_fn_error "could not setup config files machinery" "$LINENO" 5 _ACEOF # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/ s/:*\${srcdir}:*/:/ s/:*@srcdir@:*/:/ s/^\([^=]*=[ ]*\):*/\1/ s/:*$// s/^[^=]*=[ ]*$// }' fi cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 fi # test -n "$CONFIG_FILES" eval set X " :F $CONFIG_FILES " shift for ac_tag do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;; esac case $ac_mode$ac_tag in :[FHL]*:*);; :L* | :C*:*) as_fn_error "invalid tag \`$ac_tag'" "$LINENO" 5;; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac ac_save_IFS=$IFS IFS=: set x $ac_tag IFS=$ac_save_IFS shift ac_file=$1 shift case $ac_mode in :L) ac_source=$1;; :[FH]) ac_file_inputs= for ac_f do case $ac_f in -) ac_f="$tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || as_fn_error "cannot find input file: \`$ac_f'" "$LINENO" 5;; esac case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac as_fn_append ac_file_inputs " '$ac_f'" done # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input='Generated from '` $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' `' by configure.' if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 $as_echo "$as_me: creating $ac_file" >&6;} fi # Neutralize special characters interpreted by sed in replacement strings. case $configure_input in #( *\&* | *\|* | *\\* ) ac_sed_conf_input=`$as_echo "$configure_input" | sed 's/[\\\\&|]/\\\\&/g'`;; #( *) ac_sed_conf_input=$configure_input;; esac case $ac_tag in *:-:* | *:-) cat >"$tmp/stdin" \ || as_fn_error "could not create $ac_file" "$LINENO" 5 ;; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` as_dir="$ac_dir"; as_fn_mkdir_p ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix case $ac_mode in :F) # # CONFIG_FILE # _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # If the template does not know about datarootdir, expand it. # FIXME: This hack should be removed a few years after 2.60. ac_datarootdir_hack=; ac_datarootdir_seen= ac_sed_dataroot=' /datarootdir/ { p q } /@datadir@/p /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p' case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 $as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_datarootdir_hack=' s&@datadir@&$datadir&g s&@docdir@&$docdir&g s&@infodir@&$infodir&g s&@localedir@&$localedir&g s&@mandir@&$mandir&g s&\\\${datarootdir}&$datarootdir&g' ;; esac _ACEOF # Neutralize VPATH when `$srcdir' = `.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_sed_extra="$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s|@configure_input@|$ac_sed_conf_input|;t t s&@top_builddir@&$ac_top_builddir_sub&;t t s&@top_build_prefix@&$ac_top_build_prefix&;t t s&@srcdir@&$ac_srcdir&;t t s&@abs_srcdir@&$ac_abs_srcdir&;t t s&@top_srcdir@&$ac_top_srcdir&;t t s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t s&@builddir@&$ac_builddir&;t t s&@abs_builddir@&$ac_abs_builddir&;t t s&@abs_top_builddir@&$ac_abs_top_builddir&;t t $ac_datarootdir_hack " eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$tmp/subs.awk" >$tmp/out \ || as_fn_error "could not create $ac_file" "$LINENO" 5 test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&5 $as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&2;} rm -f "$tmp/stdin" case $ac_file in -) cat "$tmp/out" && rm -f "$tmp/out";; *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";; esac \ || as_fn_error "could not create $ac_file" "$LINENO" 5 ;; esac done # for ac_tag as_fn_exit 0 _ACEOF ac_clean_files=$ac_clean_files_save test $ac_write_fail = 0 || as_fn_error "write failure creating $CONFIG_STATUS" "$LINENO" 5 # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || as_fn_exit $? fi if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} fi ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/configure.in���������������������������������������������������������������������������0000644�0000764�0000764�00000004060�11501274512�014220� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������dnl dnl Configuring wiliki dnl Process this file with autoconf to generate 'configure'. dnl dnl $Id: configure.in,v 1.19 2007-07-14 05:33:19 shirok Exp $ AC_PREREQ(2.54) AC_INIT(WiLiKi, 0.6.2, shiro@acm.org) dnl If you want to use the system name (OS, architecture, etc) in the dnl configure, uncomment the following line. In such a case, you need dnl to copy config.guess and config.sub from automake distribution. dnl AC_CANONICAL_SYSTEM dnl Set up gauche related commands. The commands are set by scanning dnl PATH. You can override them by "GOSH=/my/gosh ./configure" etc. AC_PATH_PROG([GOSH], gosh) AC_PATH_PROG([GAUCHE_CONFIG], gauche-config) AC_PATH_PROG([GAUCHE_PACKAGE], gauche-package) AC_PATH_PROG([GAUCHE_INSTALL], gauche-install) AC_PATH_PROG([GAUCHE_CESCONV], gauche-cesconv) dnl Usually these parameters are set by AC_PROG_CC, but we'd rather use dnl the same one as Gauche has been compiled with. SOEXT=`"$GAUCHE_CONFIG" --so-suffix` OBJEXT=`"$GAUCHE_CONFIG" --object-suffix` EXEEXT=`"$GAUCHE_CONFIG" --executable-suffix` AC_SUBST(SOEXT) AC_SUBST(OBJEXT) AC_SUBST(EXEEXT) GAUCHE_PKGINCDIR=`"$GAUCHE_CONFIG" --pkgincdir` GAUCHE_PKGLIBDIR=`"$GAUCHE_CONFIG" --pkglibdir` GAUCHE_PKGARCHDIR=`"$GAUCHE_CONFIG" --pkgarchdir` AC_SUBST(GAUCHE_PKGINCDIR) AC_SUBST(GAUCHE_PKGLIBDIR) AC_SUBST(GAUCHE_PKGARCHDIR) dnl Check for headers. dnl Add your macro calls to check required headers, if you have any. dnl Check for other programs. dnl Add your macro calls to check existence of programs, if you have any. dnl Check for libraries dnl Add your macro calls to check required libraries, if you have any. ALL_LINGUAS="ja" AC_SUBST(ALL_LINGUAS) dnl Creating gpd (gauche package description) file GAUCHE_PACKAGE_CONFIGURE_ARGS="`echo ""$ac_configure_args"" | sed 's/[\\""\`\$]/\\\&/g'`" AC_MSG_NOTICE([creating ${PACKAGE_NAME}.gpd]) "$GAUCHE_PACKAGE" make-gpd "$PACKAGE_NAME" \ -version "$PACKAGE_VERSION" \ -configure "./configure $GAUCHE_PACKAGE_CONFIGURE_ARGS" dnl Output echo $PACKAGE_VERSION > VERSION AC_OUTPUT(Makefile src/Makefile doc/Makefile test/Makefile po/Makefile) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/install-sh�����������������������������������������������������������������������������0000755�0000764�0000764�00000012736�10741672224�013733� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/bin/sh # # install - install a program, script, or datafile # This comes from X11R5 (mit/util/scripts/install.sh). # # Copyright 1991 by the Massachusetts Institute of Technology # # Permission to use, copy, modify, distribute, and sell this software and its # documentation for any purpose is hereby granted without fee, provided that # the above copyright notice appear in all copies and that both that # copyright notice and this permission notice appear in supporting # documentation, and that the name of M.I.T. not be used in advertising or # publicity pertaining to distribution of the software without specific, # written prior permission. M.I.T. makes no representations about the # suitability of this software for any purpose. It is provided "as is" # without express or implied warranty. # # Calling this script install-sh is preferred over install.sh, to prevent # `make' implicit rules from creating a file called install from it # when there is no Makefile. # # This script is compatible with the BSD install script, but was written # from scratch. It can only install one file at a time, a restriction # shared with many OS's install programs. # set DOITPROG to echo to test this script # Don't use :- since 4.3BSD and earlier shells don't like it. doit="${DOITPROG-}" # put in absolute paths if you don't have them in your path; or use env. vars. mvprog="${MVPROG-mv}" cpprog="${CPPROG-cp}" chmodprog="${CHMODPROG-chmod}" chownprog="${CHOWNPROG-chown}" chgrpprog="${CHGRPPROG-chgrp}" stripprog="${STRIPPROG-strip}" rmprog="${RMPROG-rm}" mkdirprog="${MKDIRPROG-mkdir}" transformbasename="" transform_arg="" instcmd="$mvprog" chmodcmd="$chmodprog 0755" chowncmd="" chgrpcmd="" stripcmd="" rmcmd="$rmprog -f" mvcmd="$mvprog" src="" dst="" dir_arg="" while [ x"$1" != x ]; do case $1 in -c) instcmd="$cpprog" shift continue;; -d) dir_arg=true shift continue;; -m) chmodcmd="$chmodprog $2" shift shift continue;; -o) chowncmd="$chownprog $2" shift shift continue;; -g) chgrpcmd="$chgrpprog $2" shift shift continue;; -s) stripcmd="$stripprog" shift continue;; -t=*) transformarg=`echo $1 | sed 's/-t=//'` shift continue;; -b=*) transformbasename=`echo $1 | sed 's/-b=//'` shift continue;; *) if [ x"$src" = x ] then src=$1 else # this colon is to work around a 386BSD /bin/sh bug : dst=$1 fi shift continue;; esac done if [ x"$src" = x ] then echo "install: no input file specified" exit 1 else true fi if [ x"$dir_arg" != x ]; then dst=$src src="" if [ -d $dst ]; then instcmd=: chmodcmd="" else instcmd=mkdir fi else # Waiting for this to be detected by the "$instcmd $src $dsttmp" command # might cause directories to be created, which would be especially bad # if $src (and thus $dsttmp) contains '*'. if [ -f $src -o -d $src ] then true else echo "install: $src does not exist" exit 1 fi if [ x"$dst" = x ] then echo "install: no destination specified" exit 1 else true fi # If destination is a directory, append the input filename; if your system # does not like double slashes in filenames, you may need to add some logic if [ -d $dst ] then dst="$dst"/`basename $src` else true fi fi ## this sed command emulates the dirname command dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` # Make sure that the destination directory exists. # this part is taken from Noah Friedman's mkinstalldirs script # Skip lots of stat calls in the usual case. if [ ! -d "$dstdir" ]; then defaultIFS=' ' IFS="${IFS-${defaultIFS}}" oIFS="${IFS}" # Some sh's can't handle IFS=/ for some reason. IFS='%' set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` IFS="${oIFS}" pathcomp='' while [ $# -ne 0 ] ; do pathcomp="${pathcomp}${1}" shift if [ ! -d "${pathcomp}" ] ; then $mkdirprog "${pathcomp}" else true fi pathcomp="${pathcomp}/" done fi if [ x"$dir_arg" != x ] then $doit $instcmd $dst && if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi else # If we're going to rename the final executable, determine the name now. if [ x"$transformarg" = x ] then dstfile=`basename $dst` else dstfile=`basename $dst $transformbasename | sed $transformarg`$transformbasename fi # don't allow the sed command to completely eliminate the filename if [ x"$dstfile" = x ] then dstfile=`basename $dst` else true fi # Make a temp file name in the proper directory. dsttmp=$dstdir/#inst.$$# # Move or copy the file name to the temp name $doit $instcmd $src $dsttmp && trap "rm -f ${dsttmp}" 0 && # and set any options; do chmod last to preserve setuid bits # If any of these fail, we abort the whole thing. If we want to # ignore errors from any of these, just make sure not to ignore # errors from the above "$doit $instcmd $src $dsttmp" command. if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi && # Now rename the file to the real destination. $doit $rmcmd -f $dstdir/$dstfile && $doit $mvcmd $dsttmp $dstdir/$dstfile fi && exit 0 ����������������������������������WiLiKi-0.6.2/HACKING��������������������������������������������������������������������������������0000644�0000764�0000764�00000000263�11157564676�012723� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������To build from CVS sources: Requirements: autoconf 2.52 Gauche-0.8.14 After checking out the source tree, run ./DIST gen which calls autoconf to create configure file. ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/Makefile.in����������������������������������������������������������������������������0000644�0000764�0000764�00000003477�11501262022�013760� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# # $Id: Makefile.in,v 1.3 2006-04-22 01:14:33 shirok Exp $ # # General info SHELL = @SHELL@ prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ srcdir = @srcdir@ datadir = @datadir@ datarootdir = @datarootdir@ VPATH = $(srcdir) # These may be overridden by make invocators DESTDIR = GOSH = "@GOSH@" GAUCHE_CONFIG = "@GAUCHE_CONFIG@" GAUCHE_PACKAGE = "@GAUCHE_PACKAGE@" GAUCHE_CESCONV = "@GAUCHE_CESCONV@" INSTALL = "@GAUCHE_INSTALL@" # Other parameters SOEXT = @SOEXT@ OBJEXT = @OBJEXT@ EXEEXT = @EXEEXT@ # Module-specific stuff PACKAGE = WiLiKi ARCHFILES = SCMFILES = HEADERS = CONFIG_GENERATED = Makefile config.cache config.log config.status \ configure.lineno autom4te*.cache $(PACKAGE).gpd HEADER_INSTALL_DIR = "$(DESTDIR)@GAUCHE_PKGINCDIR@" SCM_INSTALL_DIR = "$(DESTDIR)@GAUCHE_PKGLIBDIR@" ARCH_INSTALL_DIR = "$(DESTDIR)@GAUCHE_PKGARCHDIR@" all : cd src; $(MAKE) cd doc; $(MAKE) cd po; $(MAKE) check : cd test; $(MAKE) check install : all cd src; $(MAKE) install cd doc; $(MAKE) install cd po; $(MAKE) install $(INSTALL) -m 444 -T $(SCM_INSTALL_DIR)/.packages $(PACKAGE).gpd uninstall : cd src; $(MAKE) uninstall cd doc; $(MAKE) uninstall cd po; $(MAKE) uninstall $(INSTALL) -U $(SCM_INSTALL_DIR)/.packages $(PACKAGE).gpd clean : cd src; $(MAKE) clean cd doc; $(MAKE) clean cd test; $(MAKE) clean cd po; $(MAKE) clean rm -rf core $(GENERATED) *~ *.log distclean : clean cd src; $(MAKE) distclean cd doc; $(MAKE) distclean cd test; $(MAKE) distclean cd po; $(MAKE) distclean rm -rf $(CONFIG_GENERATED) maintainer-clean : clean cd src; $(MAKE) maintainer-clean cd doc; $(MAKE) maintainer-clean cd test; $(MAKE) maintainer-clean cd po; $(MAKE) maintainer-clean rm -rf $(CONFIG_GENERATED) configure �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/VERSION��������������������������������������������������������������������������������0000644�0000764�0000764�00000000006�11501274533�012756� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������0.6.2 ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/AUTHORS��������������������������������������������������������������������������������0000644�0000764�0000764�00000000034�10741672224�012763� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Shiro Kawai (shiro@acm.org) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/INSTALL��������������������������������������������������������������������������������0000644�0000764�0000764�00000000763�11157564775�012772� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������[Quick instruction to install wiliki] See the following URL for detailed instruction in Japanese: http://practical-scheme.net/wiliki/wiliki.cgi?WiLiKi%3a%a5%ea%a5%d5%a5%a1%a5%ec%a5%f3%a5%b9%a5%de%a5%cb%a5%e5%a5%a2%a5%eb Requirements ------------ Gauche 0.8.14 or later Installation ------------ The standard configure+make installs necessary modules. % ./configure % make % make install Then you need to copy src/wiliki.cgi to your cgi script diretory, and edit the settings. �������������WiLiKi-0.6.2/ChangeLog������������������������������������������������������������������������������0000644�0000764�0000764�00000112501�11501274373�013466� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������2010-12-12 Shiro Kawai <shiro@acm.org> * release 0.6.2 * configure.in, */Makefile.in: Modified to work if gauche is installed under pathnames containing spaces. 2010-12-05 Shiro Kawai <shiro@acm.org> * src/wiliki/parse.scm (fmt-line): Added a new formatting primitive """...""" for <code>...</code>. This is something I had in my mind for long time. I hope this won't disturb existing content too much. 2010-07-14 Shiro Kawai <shiro@acm.org> * src/wiliki/edit.scm (cmd-commit-edit), src/wiliki/macro.scm (post-comment): Heuristic spam checks for # of urls and url ratio are moved from cmd-commit-edit to post-comment, for legitimate wiki pages may include or consist of lots of urls. It's unlikely the case for comments. 2010-05-23 Shiro Kawai <shiro@acm.org> * src/wiliki/macro.scm (post-comment): Avoid updating timestamp of the commented page if the comment is rejected as spam by cmd-commit-edit. * src/wiliki/edit.scm (cmd-commit-edit): Record spam rejection reason to the event log. 2010-05-22 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (default-format-wikiname): Fixed a bug that can produce an invalid regexp while searching InterWikiName. 2010-04-25 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (wiliki:default-head-elements): Allow a list in :style-sheet. 2010-01-23 Shiro Kawai <shiro@acm.org> * src/wiliki/core.scm (wiliki:spam-blacklist etc.): Added crude blacklisting mechanism for stealth spamming. * src/wiliki/edit.scm: Check spam blacklist on commit. 2010-01-16 Shiro Kawai <shiro@acm.org> * src/wiliki/auth.scm, test/auth.scm: Added simple authentication and session management module. Note: This module won't work with Gauche 0.9 or earlier. 2010-01-12 Shiro Kawai <shiro@acm.org> * src/wiliki/rss.scm (rss-source, rss-url-format): Make the title and url format customizable. 2010-01-03 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (<wiliki-formatter>), src/wiliki/format.scm (<wiliki-formatter-base>): Splitted the base formatter (with minimal functionality) and the default formatter (for web rendering). This change allows the new wiliki app to customize formatting by subclassing <wiliki-formatter> and defining method specialized for the subclass, instead of setting slots of (wiliki:formatter). The old way is still supported for the backward compatibility, but is deprecated. * src/wiliki.scm (wiliki:default-head-elements), src/wiliki/format.scm (wiliki:format-head-title): Allow customizing 'title' element in the html head by specializing wiliki:format-head-title. 2010-01-02 Shiro Kawai <shiro@acm.org> * src/wiliki/macro.scm (comment): Avoid formatting when the current page is not set. It occurs during formatting as RSS. * src/wiliki/page.scm (wiliki:page-circular?): Tolerate having boolean value inside page-stack. 2010-01-01 Shiro Kawai <shiro@acm.org> * src/wiliki/core.scm (wiliki-main): Fixed a bug that left wiliki:event-log-drain #<undef> if event-log-file wasn't specified. 2009-11-18 Shiro Kawai <shiro@acm.org> * src/wiliki/core.scm (wiliki:log-event): Added event-log-file slot to <wiliki>. If it is set, call for wiliki:log-event are recorded to the named file. (In retrospect, we should name the current "log file" as "journal" and name this event log as log file...) * src/wiliki/edit.scm, src/wiliki/macro.scm: Records spam rejection events by wiliki:log-event. 2009-05-02 Shiro Kawai <shiro@acm.org> * src/wiliki/edit.scm (cmd-commit-edit): tighten the threshold of filtering spams with bunch of URLs. 2009-03-22 Shiro Kawai <shiro@acm.org> * po/Makefile.in (MSGDIR): Append DESTDIR for proper packaging. 2009-03-16 Shiro Kawai <shiro@acm.org> * release 0.6.1 * src/wiliki/core.scm (db-try-open): more retries when db is busy. 2009-03-15 Shiro Kawai <shiro@acm.org> * src/wiliki.scm ('e' action): Redirect to normal view if the request is via GET and 't' parameter is not given. This is to prevent search engines from referencing the urls with c=e attached. ('n' action): Wikiname to a nonexistent page now uses c=n instead of c=e to indicate that it is for new page. This action can be invoked via GET. It returns normal view if the page already exists. (wiliki:make-navi-button): Use POST, accordingly. 2009-03-09 Shiro Kawai <shiro@acm.org> * src/wiliki/edit.scm (cmd-commit-edit): small tweak against spams. 2008-12-05 Shiro Kawai <shiro@acm.org> * src/wiliki/rss.scm: Updated for new wiliki.core API. Added ability to generate per-item 'description' field. * test/rss.scm: added. 2008-11-10 Shiro Kawai <shiro@acm.org> * src/wiliki/edit.scm (cmd-commit-edit): some more ad-hoc spam filters. 2008-07-24 Shiro Kawai <shiro@acm.org> * src/wiliki/core.scm (db-try-open): Fixed db-open retry for less 'cannot open database for write' error. * src/wiliki/edit.scm (cmd-preview, cmd-commit-edit): Allow 'limited in editable? slot of wiliki, which allows limited kind of editing (e.g. comments). * src/wiliki.scm: Changed accordingly. * src/wiliki/macro.scm (comment-input-and-display): Hide comment input area if wiliki is read-only. * src/wiliki/history.scm: Hide link to 'edit' if the wiliki is not editable. 2008-07-23 Shiro Kawai <shiro@acm.org> * src/wiliki/macro.scm (tag): Added simple tagging interface. [[$$tag name ...]] creates links to a virtual page `Tag:name', which lists all pages that include '[[$$tag name]]'. The virtual page caches the search result, in order to avoid excessive load from crawlers. * src/wiliki/core.scm (wiliki:db-search-content, wiliki:db-record-content-find): Exclude comments from search. 2008-07-15 Shiro Kawai <shiro@acm.org> * src/wiliki/edit.scm (cmd-commit-edit): Set wiliki:page-stack during expanding writer macros so that the writer macro can obtain the current page via wiliki:current-page. 2008-05-05 Shiro Kawai <shiro@acm.org> * src/wiliki/edit.scm (cmd-commit-edit): slightly changed ad-hoc spam detection. 2008-04-01 Shiro Kawai <shiro@acm.org> * src/wiliki/core.scm (let-macro-keywords*): Changed keyword argument syntax from key:val to key=val, for ':' is more likely to be in VAL and confusing. * src/wiliki/macro.scm (post-comment): Filter more suspicious spams. 2008-03-29 Shiro Kawai <shiro@acm.org> * src/wiliki/macro.scm (post-comment): Avoid touching a page when the comment is rejected. 2008-02-20 Shiro Kawai <shiro@acm.org> * src/wiliki/scr-macros.scm (srfi-implementors-map): updated the use of old api wiliki-db-* for the new api wiliki:db-*. 2008-02-13 Shiro Kawai <shiro@acm.org> * release 0.6 2008-02-12 Shiro Kawai <shiro@acm.org> * src/wiliki/db.scm: added missing select-module that caused mysterious failures. * src/wiliki/core.scm, src/wiliki.scm: some fixes 2008-01-11 Shiro Kawai <shiro@acm.org> * Migrated repository to Subversion. 2007-12-21 Shiro Kawai <shiro@acm.org> * src/wiliki/format.scm, src/wiliki/parse.scm: moved wiliki.format's wiliki:format-line-plainly to wiliki.parse as wiliki-remove-markup. The old binding is kept for the compatibility. * src/wiliki/core.scm: added wiliki:db-raw-get and wiliki:db-raw-put! for accesses without using <wiliki-page>. Mainly for the apps that want to keep raw data other than pages in the db. 2007-11-05 Shiro Kawai <shiro@acm.org> * src/wiliki/core.scm: changed wiliki-db-* API to wiliki:db-* API. Made wiliki:db-record->page a method to take wiliki instance, so that it can be specialized by subclassing wiliki. Added wiliki:page->db-record and wiliki:page-class methods for more customization. * src/wiliki/db.scm: Compatibility functions (wiliki-db-*) are moved to here. 2007-10-13 Shiro Kawai <shiro@acm.org> * src/wiliki/wiliki.scm, src/wiliki/core.scm (wiliki-main): Moved wiliki-main from wiliki to wiliki.core. * src/wiliki/core.scm (wiliki:run-action): Wrapped the action body by a generic function wiliki:run-action. This allows the application to do preprocess/postprocess request handling by subclassing <wiliki> and specializing wiliki:run-action. 2007-10-12 Shiro Kawai <shiro@acm.org> * src/wiliki/core.scm (let-macro-keywords*): Added a macro to handle named argument handling for macro arguments. Named arguments can be given in the form of key:arg (note: there's no space around colon). * src/wiliki/macro.scm (comment): Allowed to specify comment sort order and the position of textarea using named arguments, 'order:' and 'textarea:', respectively. 2007-10-11 Shiro Kawai <shiro@acm.org> * src/wiliki/core.scm (wiliki-with-db): when rwmode is :write and the db has already been open with :read, we reopen the db in write mode. (The permission check should be done in the caller). This is needed to create top page automatically within 'v'-command. (define-wiliki-action): Allow to add authentication procedure. This is experimental. API may change. * src/wiliki.scm: removed autoloading of wiliki.util, for it is no longer used (the functions have been moved to wiliki.core). * src/wiliki/format.scm (wiliki:format-content): cache the formatted SXML result to the page's content slot. It allows calling wiliki:format-content multiple times during page creation without cost. 2007-07-18 Shiro Kawai <shiro@acm.org> * src/wiliki/page.scm: A bit of API fix. Planning to make all wiliki-related APIs named 'wiliki:foo', not 'wiliki-foo'. * src/wiliki/macro.scm (comment): Changed comment page name so that they won't appear in $$index macros which intend to pick the parent pages. Also added a virtual page to navigate clicks from the breadcrumb links on the comment pages. 2007-07-17 Shiro Kawai <shiro@acm.org> * src/wiliki/core.scm (wiliki-db-touch!): added. push the specified page to RecentChanges. * src/wiliki/macro.scm (post-comment): when comment is posted, pushes the parent page into RecentChanges. (comment): Only show summary if $$comment macro appears in the included page. 2007-07-16 Shiro Kawai <shiro@acm.org> * src/wiliki/core.scm: make macro alists parameters, so that the renderer can control macro interpretation (e.g. prohibit reader macros while rendering exiting comments). * src/wiliki/macro.scm: changed comment store form; use one page per a comment, so that we can avoid unclosed markups from messing up the rest of the page. 2007-07-13 Shiro Kawai <shiro@acm.org> * src/wiliki/core.scm: Reorganizing the source tree. Features needed to build a custom wiliki site is put into wiliki.core. The main wiliki module is an example implementation on top of wiliki.core. * src/wiliki/edit.scm: Reorganized to be a separate module instead of an autoloaded part of wiliki.scm. * src/wiliki/macro.scm: Reorganized to depend only on wiliki.core, not wiliki. * src/wiliki.scm: Moved fundamental framework stuff into wiliki.core. * src/wiliki/db.scm, src/wiliki/util.scm: integrated to wiliki.core. These modules are kept just for the compatibility. 2007-06-21 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (wiliki-main): Sets current-error-port's buffering mode to :line, in order to avoid messing up Apache log. (Should it be the default in www.cgi? Or should it be up to the application's main *.cgi file? Needs to think over.) Also bind the parameter 'wiliki' before entering cgi-main, so that it will be avaiable when error page is created. (cv-in, cv-out): make more permissive, for errors within these functions prevents error page from being shown, making diagnostic difficult. 2007-06-03 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (setup-textdomain): look at language-range in HTTP_ACCEPT_LANGUAGE a bit more closely to choose the language catalog. 2007-05-18 Shiro Kawai <shiro@acm.org> * src/wiliki/format.scm (expand-page): Fixed a bug that drops stuff following ##()-style macros. 2007-05-02 Shiro Kawai <shiro@acm.org> * src/wiliki/edit.scm (edit-form): put preview/commit button before preview box for the convenience. * src/wiliki/rss.scm (rss-format): put (title-of (wiliki)) in rdf-title. * src/wiliki.scm (s): Show search key in the page title. (wiliki:default-head-elements): Fix link element of RDF auto discoverty (rel=alternative should be rel=alternate). * src/wiliki/macro.scm (toc): if named page is not found, emit the original macro form, instead of toc of the current page. * src/wiliki/parse.scm (fmt-line): changed the formatting order so that bracket names can be included inside emphasize/strong. (Patch from Tatsuya BIZENN). * src/wiliki/history.scm (cmd-history): Paging histories. Alternate colors every row for readability. 2007-05-01 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (wiliki:make-navi-button): Change form method of navi buttons to GET, so that users can get the proper url on their browser. * src/wiliki/macro.scm (handle-reader-macro, handle-writer-macro): Chaneged macro argument syntax---now you can include whitespaces in an argument by surrounding the argument by double quotes. To include a double quote inside double-quoted argument, use two consecutive double quotes (CSV-ish, since we just use text.csv to parse the arguments, with #\space as a delimiting character). * 0.6_pre2: not a significant meaning, but rather for the convenience to register those changes. * src/wiliki.scm (wiliki:breadcrumb-links): make the $$path macro feature below to a utility function. * src/wiliki/macro.scm : renamed $$path -> $$breadcrumb-links * src/wiliki.scm (wiliki:default-page-header) : include breadcrumb links. * src/wiliki.scm (wiliki:top-link etc.) : make those commands a form button instead of anchor links, to prevent web spiders from traversing edit & edit history pages, causing heavy server traffic. * src/wiliki.scm (wiliki:menu-links) : dropped language switch link. It has not been very useful. * src/wiliki.scm (setup-textdomain): honor Accept-Language header to switch the message catalog. * po/ja.po: updated. 2007-04-30 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (wiliki:wikiname-anchor): allow an optional argument to customize the anchor string. * src/wiliki/macro.scm (path): added $$path macro that generates so-called breadcrumb links. 2007-04-05 Shiro Kawai <shiro@acm.org> * src/wiliki/rssmix.scm (extract-from-rdf): Accept dc:date without time part. 2007-03-06 Shiro Kawai <shiro@acm.org> * src/wiliki/edit.scm (cmd-commit-edit): A fix on the makeshift spam filtering (includes opening quote in the match, so that we can pass an HTML A tag in the code, in which usually quotes are escaped). Also added another spam measure to see if the same string is written into both contents and log message. 2007-02-20 Shiro Kawai <shiro@acm.org> * src/wiliki/edit.scm (cmd-commit-edit): Added a very ad-hoc filter to avoid spam---if content or logmsg includes something look like HTML A tag, we abort commit and redirect to the toppage. A valid content could include an A tag (when pasted raw HTML into verbatim block). We'll see how this becomes a problem or not. 2006-04-27 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (v): allow pagenames with whitespaces to be created. (fix from yaegashi). 2006-04-26 Shiro Kawai <shiro@acm.org> * po/Makefile.in, DIST: include *.gmo files in tarball. It appears that the target environment can have older msgfmt which doesn't handle encoding well. * src/wiliki.scm (<wiliki>): added gettext-paths slot to specify additional paths to search message catalogs. * src/wiliki/edit.scm, src/wiliki/history.scm: added a feature of editing older versions. Useful to revert from spams. * src/wiliki.scm, src/wiliki/log.scm: adjustment for the above change. * po/ja.po: ditto. 2006-04-21 Shiro Kawai <shiro@acm.org> * Makefile.in, configure.in, po/Makefile.in, src/wiliki.scm: switched from makeshift message catalog to text.gettext for message localization. The message catalogs are installed under $(datadir)/locale/$lingua/LC_MESSAGES/, thus --prefix now matters. * po/ja.po : Japanese message catalog. * src/wiliki/mcatalog.scm, src/wiliki/msgs.jp.euc, src/extract.scm: Removed. 2006-04-20 Shiro Kawai <shiro@acm.org> * src/wiliki/rssmix.scm (rss-page): fix charset output to reflect gauche's default encoding. 2005-09-04 Shiro Kawai <shiro@acm.org> * src/wiliki/format.scm, src/wiliki/page.scm : Splitted <wiliki-page> routines into wiliki.page module, which is independent from other parts. 2005-08-22 Shiro Kawai <shiro@acm.org> * src/wiliki.scm: Rewrote the main action dispatcher using define-wiliki-action. Removed a chunk of legacy code (it may break some existing macros). 2005-08-20 Shiro Kawai <shiro@acm.org> * src/wiliki/format.scm, src/wiliki/parse.scm: Splitted string->sxml parser part into wiliki.parse module, which will be the bottom level of wiliki formatter (it is self-contained, e.g. does not depend on any other part of wiliki). This is a part of the large refactoring towards 0.6. 2005-08-17 Shiro Kawai <shiro@acm.org> * release 0.5.3 * src/wiliki.scm (wiliki:default-head-elements): added LINK tag for RSS auto discovery. (default-format-wikiname): Allow whitespaces within WikiNames. (wiliki:search-box): added submit button to the search form. * src/wiliki/format.scm, src/wiliki/history.scm: added META tag for the head element of edit-history pages so that robots won't follow every link of the revisions and differences. 2005-08-10 Shiro Kawai <shiro@acm.org> * release 0.5.2 2005-07-26 Shiro Kawai <shiro@acm.org> * src/wiliki/db.scm: added wiliki-db-fold and wiliki-db-for-each * src/wiliki/macro.scm: fixed the error handling code. fixed define-reader-macro etc to avoid using receive to bind args, for the # of arguments given to the macro can exceed the limit of # of values. * src/wiliki/scr-macros.scm: added as a sample of auxiliary macros. * configure.in, Makefile.in, src/Makefile.in: adapted to the new build scheme. Now it installs gpd file so that gauche-package can display the package version. And configure.in no longer depends on gauche-specific autoconf macros. 2005-05-27 Shiro Kawai <shiro@acm.org> * release 0.5.1 * src/wiliki/format.scm (fmt-line): accept telnet:// as a valid protocol, as well as mailto, http(s) and ftp. * src/wiliki/format.scm (fmt-lines generator): fixed a problem of context-passing between included pages. We only need to pass information of nestings of headings, which is required to generate proper heading IDs for tha page that consists of included ones. Other context information could screw fmt-lines. 2005-05-12 Shiro Kawai <shiro@acm.org> * src/wiliki/format.scm (mailto): prevent creating an empty anchor tag for mailto. * src/wiliki/macro.scm (toc): fixed a bug in arranging headers into a tree. 2005-03-26 Shiro Kawai <shiro@acm.org> * src/wiliki/format.scm (fmt-lines): fixed a call to a local function with wrong number of arguments. 2004-05-23 Shiro Kawai <shiro@acm.org> * release 0.5 * doc/Makefile.in : suppress making docs for the time being; it's not ready. * src/wiliki/rssmix.scm, src/rssmix.cgi : splitted customizable part and library part. 2004-04-04 Shiro Kawai <shiro@acm.org> * doc/* : start adding documentation. Yet to determine the format. 2004-04-03 Shiro Kawai <shiro@acm.org> * src/wiliki2html: removed. The function is implemented by 'wiliki' command. * bin/wiliki: added. A general command-line tool to handle wiliki database. * test/test-bin.scm: added. 2004-04-02 Shiro Kawai <shiro@acm.org> * src/wiliki/format.scm (fmt-lines): fixed a bug that caused infinite loop (thanks to Kouhei Sutou for a patch). This changes behavior of ul/ol inside blockquote, but I believe the previous behavior was wrong. 2004-03-29 Shiro Kawai <shiro@acm.org> * src/format.scm (fmt-lines) : fixed a bug that caused infinite loop (thanks to Kouhei Sutou for a patch). 2004-03-21 Shiro Kawai <shiro@acm.org> * src/wiliki/db.scm, src/wiliki.scm : made wiliki.db only depend on wiliki.format. The APIs are renamed. Compatibility functions are moved to wiliki.scm. * src/wiliki/*.scm : adapted to the new wiliki.db api. 2004-03-19 Shiro Kawai <shiro@acm.org> * renamed the directory aux/ to util/, for Windows doesn't like the file name 'aux'. Yuck. * src/wiliki/format.scm : made formatting customization routines methods of <wiliki-formatter>. The closure members in <wiliki-formatter> are retained for the compatibility of 0.5_pre2, but deprecated. The preferable way is to subclass <wiliki-formatter> and override methods. 2004-03-07 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (get-page-name): display toppage when null string is given to the 'p' parameter in QUERY_STRING (Patch from Tokuya Kameshima). 2004-02-10 Shiro Kawai <shiro@acm.org> * src/wiliki/format.scm (fmt-line): fixed a bug that caused infinite loop when there's an unmatched "[[" in a line. 2004-02-09 Shiro Kawai <shiro@acm.org> * src/wiliki2.cgi (my-page-content): make 'Topics' of side-bar a wiki-link (suggested by Zukeran Shin). * src/wiliki/edit.scm (cmd-commit-edit): make top page not deleted even if the content is empty (suggested by Kimura Fuyuki). * src/wiliki/format.scm (fmt-line): let em and strong take the innermost apostrophes instead of first-match. 2004-02-04 Shiro Kawai <shiro@acm.org> * src/wiliki/format.scm (fmt-line): fixed a problem of emphasizing phrase containing apostrophe. 2004-01-31 Shiro Kawai <shiro@acm.org> * src/wiliki.scm : looking up CGI parameters from cgi-metavariables first, instead of getting them directly by sys-getenv. This makes the host program to parameterize wiliki more easily. 2004-01-21 Shiro Kawai <shiro@acm.org> * src/wiliki/format.scm (fmt-line): added hook to parse ##() macro. (wiliki:format-macro): ditto. (<wiliki-formatter>): macro slot for ##()-macro formatter. 2004-01-19 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (wiliki:version): added procedure to get wiliki version. * src/wiliki/edit.scm (edit-form) : make "don't update recent changes" a label of the checkbox. 2004-01-12 Shiro Kawai <shiro@acm.org> * src/wiliki/format.scm, src/wiliki/macro.scm, src/wiliki/util.scm : revised anchoring of headings (uses 'id' instead of 'a', and also uses hash value rather than ordinal numbers). $$toc macro is also revised to handle $$included page properly. 2004-01-11 Shiro Kawai <shiro@acm.org> * various files: more fixes for new format handling. * src/wiliki.scm : export various formatting functions for user customization. * src/wiliki2.cgi, src/wiliki2.css : added a sample cgi to show how to customize page display. * src/wiliki.css : renamed from wiliki-sample.css for consistency. * configure.in : 0.5_pre1 2004-01-08 Shiro Kawai <shiro@acm.org> * src/wiliki/format.scm : yet another snapshot of refactoring formatter. format-lines is rewritten using SXML. 2003-12-31 Shiro Kawai <shiro@acm.org> * another snapshot of refactoring formatter. wiliki.format is decoupled completely. 2003-12-30 Shiro Kawai <shiro@acm.org> * working snapshot of refactoring formatter. more changes to come. 2003-12-29 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (get-page-name): changed to use PATH_INFO instead of REQUEST_URI * test/test-wiliki.scm : more tests. 2003-12-21 Shiro Kawai <shiro@acm.org> * test/test-wiliki.scm : more tests. * src/wiliki/edit.scm: added missing </p> in the text editing help message. 2003-12-18 Shiro Kawai <shiro@acm.org> * aux/*, test/test-wiliki.scm : creating a scaffold for solid testing. * src/wiliki/db.scm : fix behavior of nested with-db form. 2003-12-17 Shiro Kawai <shiro@acm.org> * src/wiliki/wiliki.scm (<wiliki>): added 'protocol' and 'server-port' slot. (full-script-path-of) : calculate full URL of script, with consideration of protocol scheme and server port. (url, url-full) : use full-script-path-of. also omit l=lang parameter if lang matches the wiliki's default language. (html-page) : use full-script-path-of to emit base path. * src/wiliki/rss.scm (rss-format): use full-script-path-of to generate page URL. * src/wiliki/edit.scm (cmd-commit-edit) : avoid writing log and db if the content isn't changed. * src/wiliki/macro.scm (define-reader-macro) : generates anchor URL without "p=", so that browser can use cached page to hop around within the page in normal circumstances. * src/wiliki.scm (debug-level): fixed bad method name. (cmd-view): added code to workaround when top page name is changed. 2003-11-19 Shiro Kawai <shiro@acm.org> * src/wiliki.scm, src/wiliki/macro.scm : added missing "provide" directives. * src/wiliki2html : added. 2003-10-09 YAEGASHI Takeshi <t@keshi.org> * debian: new directory: Debian packaging files. * DIST_EXCLUDE: do not include config.status, config.log and debian directory in the release distribution. 2003-10-07 Shiro Kawai <shiro@acm.org> * release 0.4 * src/wiliki/format.scm : allow the InterWikiName list to have protocol scheme (http, https, ftp, mailto). Patch by Yaegashi Takeshi. 2003-09-01 Shiro Kawai <shiro@acm.org> * src/wiliki/edit.scm (edit-form): added class attribute to textareas of edit screen. 2003-08-31 Shiro Kawai <shiro@acm.org> * src/wiliki/db.scm (wdb-search-content): use case-insensitive search * src/wiliki.scm (expand-writer-macros): fix regexp so that args for writer macros can be handled. * src/wiliki/format.scm (format-colored-box): use :style attribute instead of :bgcolor, so that it won't interfere with different style sheets. * src/wiliki.scm (language-link): fixed a broken url generation * src/wiliki/edit.scm, src/wiliki/format.scm, src/wiliki/history.scm: Incorporated auto-merge feature to conflict handling. If logging feature is on, wiliki tries to merge both edits. Even if logging feature is not on, it shows diff, so it's much easier to find out what is edited. 2003-08-30 Shiro Kawai <shiro@acm.org> * src/wiliki.scm, src/wiliki/history.scm, src/wiliki/log.scm, src/wiliki/format.scm: First snapshot of integrating history module. If the log file name is given to :log-file slot of wiliki, the history feature is turned on. There are still some missing features. 2003-08-23 Shiro Kawai <shiro@acm.org> * src/wiliki/format.scm : rewrote formatting engine to produce more "correct" html (not quite, but almost correct). * test/format.scm : added lots of patholocigal cases. * src/wiliki-sample.css : added blockquote style. 2003-08-19 Shiro Kawai <shiro@acm.org> * src/wiliki.scm, src/wiliki/format.scm : Oops. Changing the default link to pathname notation had one undesirable side effect---it interferes with PageName begins with '/'. So the link use old ?PageName notation now. 2003-08-18 Shiro Kawai <shiro@acm.org> * src/wiliki.scm, src/wiliki/format.scm : Changed precedence of wikiname recoginition in URL. Now the pathname notation (e.g. http://foo/bar/wiliki.cgi/PageName) is the highest precedence, "?p=PageName" comes next, and "?PageName" is the last. The default format of the link of formatted page is also changed to use pathname notation. 2003-08-17 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (<wiliki>) : added customization parameter textarea-rows and textarea-cols (Patch from knok). * src/wiliki.scm (expand-writer-macros) : bug fix: not to expand writer macros in verbatim block. * src/wiliki/format.scm (format-page): changed not to show language links (->Japanese/->English) at edit and preview pages, for it causes problems in state tracking. * src/wiliki.cgi, src/wiliki.scm (error-page), src/wiliki/db.scm (db-try-open), src/wiliki/macro.scm (handle-expansion): Added debug-level to <wiliki>, and controls whether the diagnostic messages should be shown on webpage or not. The default is set so that it won't give away internal information (such as database path, stack trace, etc). * src/wiliki-sample.css : added "macroerror" class in pre, for error diagnostic messages. 2003-07-09 Shiro Kawai <shiro@acm.org> * src/wiliki/db.scm (db-try-open): fixed the bug that wiliki didn't create intitial database. 2003-07-04 Shiro Kawai <shiro@acm.org> * src/wiliki/db.scm (db-try-open): fixed a typo of keyword parameter for dbm-open (Patch from kou) * src/wiliki.scm (main): changed so that all commands except edit will open the database in read-only mode (Suggested by kou). 2003-06-06 Shiro Kawai <shiro@acm.org> * src/wiliki/db.scm (with-db): capture EAVAIL error from dbm-open and retry after some delay. * src/wiliki/format.scm (format-parts): recognize mailto: scheme (as suggested by Hisazumi Kenji). 2003-05-11 Shiro Kawai <shiro@acm.org> * src/wiliki/macro.scm (toc): fixed a bug in referencing the anchor within the same page; this bug has been incorporated by adding base element in the document in order to support pagename by path component. 2003-05-03 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (wiliki-main): allow pagenames to be specified by appending extra path component like "wiliki.cgi/PageName". 2003-04-21 Shiro Kawai <shiro@acm.org> * Makefile, src/Makefile.am, test/Makefile.am, configure.in : Removed automake dependency. * src/wiliki.scm, src/wiliki/db.scm : separated database access layer. 2003-04-06 Shiro Kawai <shiro@acm.org> * src/wiliki/macro.scm : fixed function call wikiname-anchor -> format-wikiname-anchor. sort the result of $$index and $$cindex alphabetically. * src/wiliki.scm (wdb-search): allow optional comparison method for sorting the result. * Makefile.am and other files : adapted to automake * src/wiliki.scm, src/wiliki/format.scm : separated formatting stuff into a module. 2003-03-31 Shiro Kawai <shiro@acm.org> * src/wiliki/macro.scm : capture error in macro expander. * src/wiliki.scm, src/wiliki/msgs.jp.euc: fixed the text formatting instruction message. 2003-03-05 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (format-wiki-name, cmd-view), src/wiliki/macro.scm (handle-virtual-page, virtual-page?) : Added "virtual page" feature (Patch from Hisazumi Kenji). * src/wiliki.scm (format-parts): in URI formatting, omitting protocol scheme part when a server name is not given; allows the same page to be used from http and https (Patch from YAEGASHI Takeshi). 2003-03-04 Shiro Kawai <shiro@acm.org> * src/wiliki/rss.scm (rss-format) : added missing rdf:about attribute in the item element. 2003-02-26 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (format-parts) : recognize https and ftp as valid protocols to make a link. 2003-02-21 Shiro Kawai <shiro@acm.org> * Makefile.in : added extract target. * src/wiliki.scm (cmd-view): show "create new page" link when nonexitent page is specified. 2003-02-14 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (cmd-recent-changes): experimentally added how-long-since display in "Recent Changes" page. 2003-02-13 Shiro Kawai <shiro@acm.org> * release 0.3 2003-02-12 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (make-line-fetcher): fixed a problem with comments and line continations in a verbatim block; the line fetcher itself needs to recognize "{{{" and "}}}" to switch the mode. 2003-02-11 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (format-content): added comment syntax, revised table syntax (use '||' instead of '|' as a delimiter), and revised formatting routine to comply HTML (mostly). 2003-02-10 Shiro Kawai <shiro@acm.org> * src/extract.scm : improved format of multiline string. * src/wiliki.scm : allow title to be set. * src/wiliki/msgs.jp.euc : changed some messages. * src/wiliki/macro.scm : fixed problem related to the change of return value of wdb-search. 2003-02-08 Shiro Kawai <shiro@acm.org> * src/wiliki/pasttime.scm : a feature to display the time since last modified. * src/wiliki/rss.scm : added RSS support. * src/wiliki.scm : Removed cgi-name slot from <wiliki>. It is now derived from CGI metavariables SCRIPT_NAME. Added db-type slot to <wiliki>, so that dbm system other than gdbm can be used. Added table support (using PukiWiki syntax, i.e. '|' as the delimiter). 2003-02-06 Shiro Kawai <shiro@acm.org> * src/wiliki.scm : completed charset support, using new features of www.cgi in upcoming Gauche-0.6.7. 2002-12-26 Shiro Kawai <shiro@acm.org> * src/wiliki.scm : added charset support, as suggested by Fumitoshi UKAI. Not completed yet. * test/* : started writing simple tests. 2002-12-21 Shiro Kawai <shiro@acm.org> * Makefile.in, src/wiliki/msgs.jp.euc : changed Makefile so that the japanese message file msgs.jp is converted to the gauche's internal encoding during make. 2002-12-18 Shiro Kawai <shiro@acm.org> * release 0.2 * src/wiliki/macro.scm : support inline-image by $$img macro. * src/wiliki.scm: added style-sheet support, and inline-image allow/deny rules. 2002-12-09 Shiro Kawai <shiro@acm.org> * src/wiliki.scm (redirect-page) : fixed a problem of redirecting a page whose name containing special characters such as '='. 2002-12-01 Shiro Kawai <shiro@acm.org> * src/wiliki.scm : various fixes: - added "{{{" and "}}}" to denote <pre> </pre>. - used redirection to display the fresh page after editing, to prevent multi-posting by reloading. - swap "Preview again" and "Commit" button in the preview screen, for consistency with the edit screen. - show update conflict screen even in preview; it caused internal error in the previous version. - keep language setting across edit. * src/wiliki/msgs.jp : modified accordingly. * src/wiliki/macro.scm : fixed toc macro expander to accomodate "{{{" tag. 2002-10-07 Shiro Kawai <shiro@acm.org> * src/wiliki.scm: fixed a problem that the text in the textarea of preview and edit screen wasn't html-escaped. 2002-09-29 Shiro Kawai <shiro@acm.org> * release 0.1 (alpha) * src/wiliki.scm : removed the parameter 'page', for the same info is available from the parameter page-format-history. A procedure current-formatting-page is defined for the convenience. * src/wiliki/macro.scm : escape the index line of $$toc correctly. 2002-09-26 Shiro Kawai <shiro@acm.org> * src/wiliki.scm : adapted to Gauche 0.6.3. checks Gauche version near the beginning. adds fragment anchor names to headings. added 'page' parameter. * src/wiliki/macro.scm : $$toc creates a link to the headings. 2002-05-21 Shiro Kawai <shiro@acm.org> * src/wiliki/macro.scm : separated reader/writer macro handling routines here. Added $$toc reader macro * src/wiliki.scm : added a checkbox in editing screen to set "don't update 'Recent Changes'" option (so called "sage" feature). Also hide "Edit" link in the edit screen. 2002-03-30 Shiro Kawai <shiro@acm.org> * emacs/wiliki.el : finish header parsing. * src/extract.scm : adapted to Gauche-0.5.1 and later * src/wiliki/msgs.jp : added messages 2002-03-03 Shiro Kawai <shiro@acm.org> * src/wiliki.scm : added lwp-version to the lightweight protocol header. change the lightweight protocol command to "lv". * emacs/wiliki.el : added (not finished yet). 2002-03-02 Shiro Kawai <shiro@acm.org> * src/wiliki.scm : added plaintext mode. * src/wiliki.scm : made the current <wiliki> object, the current language and the current db parameters; this simplifies the code a lot. * src/wiliki.scm : switch charset by the language. * src/wiliki.scm : added $$include macro. implement simple parameter mechanism (define-parameter and parameterize*). * src/wiliki.scm : added $$cindex macro. 2002-03-01 Shiro Kawai <shiro@acm.org> * src/wiliki.scm : escape special characters in wiki name formatting. * src/wiliki.scm (cmd-commit-edit) : delete page if it contains only whitespace characters. (string-null? is not enough, for some browsers sends extra \n in some cases.). * src/wiliki.scm : added search box. * src/wiliki.scm : added $$index reader macro. 2002-02-27 Shiro Kawai <shiro@acm.org> * src/wiliki.scm : sort search result. * src/wiliki.scm : enabled deletion of page. allow '<' and '>' in WikiName. 2001-01-14 Shiro Kawai <shiro@acm.org> * src/wiliki.scm : fixed WikiName parse routine to deal with nested "[[" and "]]"'s for InterWikiName, and correctly escape WikiName reference in URL. 2001-01-13 Shiro Kawai <shiro@acm.org> * various files : autoconfiscated * src/wiliki.scm, src/wiliki/mcatalog.scm, src/wiliki/msgs.jp : separated language-dependent messages to the separate message catalog. 2001-12-12 Shiro Kawai <shiro@acm.org> * src/wiliki.scm : added named url ([URL name]) formatting rule. added InterWikiName feature. 2001-12-05 Shiro Kawai <shiro@acm.org> * src/wiliki.scm: fixed a bug that escapes URL twice. fix the problem that the page named "c" couldn't be viewed. added <h4>. allow <dt> to have colons. 2001-11-28 Shiro Kawai <shiro@acm.org> * src/wiliki.scm : added preview feature. 2001-11-27 Shiro Kawai <shiro@acm.org> * src/wiliki.scm : added back-link search feature and update conflict detection. 2001-11-22 Shiro Kawai <shiro@acm.org> * src/wiliki.scm : added recent-changes feature, and bilingual feature for messages. 2001-11-22 Shiro Kawai <shiro@acm.org> * src/wiliki.scm : added per-page parameters �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WiLiKi-0.6.2/COPYING��������������������������������������������������������������������������������0000644�0000764�0000764�00000002222�11157576155�012757� 0����������������������������������������������������������������������������������������������������ustar �shiro���������������������������shiro������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ Copyright (c) 2000-2009 Shiro Kawai <shiro@acm.org> 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. ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������