Index: /lang/scheme/bloscheme/bloscheme.scm
===================================================================
--- /lang/scheme/bloscheme/bloscheme.scm (revision 612)
+++ /lang/scheme/bloscheme/bloscheme.scm (revision 626)
@@ -5,34 +5,12 @@
 (use util.list)
 (use srfi-1)
-(use srfi-13)
 (use srfi-19)
 (use www.cgi)
-(use gauche.parameter)
 
-(define *blog-title* "Bloscheme Test")
-(define *author* "id:jknaoya")
 (define *data-regexp* #/.txt$/)
 (define *data-directory* "data")
-(define *plugin-directory* "plugins")
 (define *entry-number* 7)
-(define *default-flavour* "html")
-(define *server-root* #f) ; Auto if #f
-; (define *server-root* "http://example.com")
 
-(define path-info (make-parameter "/"))
-(define flavour (make-parameter "html"))
-(define title (make-parameter *blog-title*))
-(define template-hash-table
-  (make-parameter
-    (hash-table
-      'eq?
-      `(title . ,(title))
-      )))
-(define-method object-apply ((ht <hash-table>) (name <symbol>))
-               (hash-table-get ht name)
-               )
-(define (set-template-variable name val)
-  (hash-table-put! (template-hash-table) name val)
-  )
+(load "./template.scm")
 
 ; 設定に従いファイルを列挙し、
@@ -57,54 +35,58 @@
 ; PATH_INFO にしたがってエントリをフィルタリング
 ; プラグイン?みたいなのもフィルタとして実装できる?
-(define (filter-by-path-info params files)
-  (rxmatch-cond
-    ((rxmatch #/^\/(\d{4})\/?$/ (path-info))
-     [#f year]
-     (set! year (string->number year))
-     (filter (lambda (file)
-               (= (date-year (hash-table-get file 'date)) year))
-             files)
-     )
-    ((rxmatch #/^\/(\d{4})\/(\d\d)\/?$/ (path-info))
-     [#f year month]
-     (set! year  (string->number year))
-     (set! month (string->number month))
-     (filter (lambda (file)
-               (and (= (date-year  (hash-table-get file 'date)) year)
-                    (= (date-month (hash-table-get file 'date)) month)))
-             files)
-     )
-    ((rxmatch #/^\/(\d{4})\/(\d\d)\/(\d\d)\/?$/ (path-info))
-     [#f year month day]
-     (set! year  (string->number year))
-     (set! month (string->number month))
-     (set! day   (string->number day))
-     (filter (lambda (file)
-               (and (= (date-year  (hash-table-get file 'date)) year)
-                    (= (date-month (hash-table-get file 'date)) month)
-                    (= (date-day   (hash-table-get file 'date)) day)))
-             files)
-     )
-    (else
-      (if (not (string=? (path-info) "/"))
-        ; individual
-        (filter (lambda (file)
-                  (string-prefix? (path-info) (hash-table-get file 'name)))
-                files)
-        ; index
-        files)
-      ))
+(define (filter-by-path-info files)
+  #?=files
+  (let1 path-info (cgi-get-metavariable "PATH_INFO")
+        (if path-info
+          (rxmatch-cond
+            ((rxmatch #/^\/(\d{4})\/?$/ path-info)
+             [#f year]
+             (set! year (string->number year))
+             (filter (lambda (file)
+                       (= (date-year (hash-table-get file 'date)) year))
+                     files)
+             )
+            ((rxmatch #/^\/(\d{4})\/(\d\d)\/?$/ path-info)
+             [#f year month]
+             (set! year  (string->number year))
+             (set! month (string->number month))
+             (filter (lambda (file)
+                       (and (= (date-year  (hash-table-get file 'date)) year)
+                            (= (date-month (hash-table-get file 'date)) month)))
+                     files)
+             )
+            ((rxmatch #/^\/(\d{4})\/(\d\d)\/(\d\d)\/?$/ path-info)
+             [#f year month day]
+             (set! year  (string->number year))
+             (set! month (string->number month))
+             (set! day   (string->number day))
+             (filter (lambda (file)
+                       (and (= (date-year  (hash-table-get file 'date)) year)
+                            (= (date-month (hash-table-get file 'date)) month)
+                            (= (date-day   (hash-table-get file 'date)) day)))
+                     files)
+             )
+            (else
+              (if (not (string=? path-info "/"))
+                ; individual
+                (filter (lambda (file)
+                          (string=? (hash-table-get file 'name) path-info))
+                        files)
+                ; index
+                (take files *entry-number*))
+              ))
+          ; index
+          (take files *entry-number*)
+          )
+        )
   )
 
 ; ソートするフィルタ
-(define (sort-entries params files)
+(define (sort-entries files)
+  #?=files
   (stable-sort files
                (lambda (a b)
                  (file-mtime>? (hash-table-get a 'path) (hash-table-get b 'path)))
                ))
-
-; プラグイン参照用
-(define (last params files)
-  files)
 
 ; 適用フィルタの定義
@@ -113,102 +95,24 @@
     sort-entries
     filter-by-path-info
-    last
     ))
-
-; ref に指定したフィルタのまえに proc を追加する
-(define (add-filter ref proc)
-  (update! *filters* (lambda (filters)
-                       (receive (before after) (split-at filters (list-index (pa$ eq? ref) filters))
-                                (append before (list proc) after))))
-  )
 
 (define (main args)
   (cgi-main
     (lambda (params)
-      (define plugins (directory-list *plugin-directory*
-                                      :filter (lambda (path)
-                                                (not (rxmatch #/^_|^(\.|\.\.)/ path))
-                                                )))
-      (define (process plugins)
-        (if (not (null? plugins))
-          (begin
-            (load #`"./,|*plugin-directory*|/,(car plugins)")
-            (process (cdr plugins))
-            ))
-        )
-      (process plugins)
 
-      (receive (dir name ext) (decompose-path (or (cgi-get-metavariable "PATH_INFO") "/"))
-               (flavour   (or ext *default-flavour*))
-               (path-info (if (and name (not (string=? name "index")))
-                            (string-join (list dir name) "/")
-                            (if (string=? dir "")
-                              "/"
-                              dir)))
-               )
-
-      (if (not *server-root*)
-        (set! *server-root* (string-append "http://" (cgi-get-metavariable "SERVER_NAME"))))
-
-
-      (let ([template-variables
-              `((files . ,(fold (lambda args ; フィルタを順に適用する
-                                  (apply (car args) params (cdr args)))
-                                (list-files)
-                                *filters*))
-                (home  . ,(cgi-get-metavariable "SCRIPT_NAME"))
-                (path  . ,(values-ref (decompose-path (or (cgi-get-metavariable "SCRIPT_NAME") "")) 0))
-                )])
-        (for-each set-template-variable
-                  (map car template-variables) (map cdr template-variables))
-        )
-
-      (load #`"./template-,(flavour).scm")
-
-      (tree->string (result (template-hash-table))))
-
-    :on-error (lambda (c)
-                (use text.html-lite)
-                `(,(cgi-header :content-type "text/html; charset=UTF-8" :status "500 Internal Server Error")
-                  ,(html-doctype :type :xhtml-1.0-strict)
-                  ,(html:html
-                     (html:head
-                       (html:title "Error " (html-escape-string (condition-ref c 'message)))
-                       (html:style :type "text/css" "
-                                   body {
-                                   margin: 0 10%;
-                                   background: #fff;
-                                   color: #555;
-                                   }
-
-                                   h1 {
-                                   color: #d06c6b;
-                                   font-weight: normal;
-                                   }
-
-                                   pre {
-                                   font-size: 90%;
-                                   padding: 1em;
-                                   line-height: 1.2;
-                                   background: #efefef;
-                                   border: 1px solid #ccc;
-                                   color: #555;
-                                   }
-                                   ")
-                                   )
-                       (html:body
-                         (html:h1 "Error")
-                         (html:pre (html-escape-string
-                                     (call-with-output-string
-                                       (cut
-                                         with-error-to-port
-                                         <>
-                                         ; 現在のスタックを表示しちゃうみたい
-                                         (cut report-error c)))))
-                         ) ; /body
-                       ) ; /html
-                     )
-                  )
-                ))
+      ; フィルタを順に適用する
+      (define files (fold (lambda args
+                            (apply (car args) (cdr args)))
+                          (list-files)
+                          *filters*))
+      (tree->string (result
+                      (hash-table
+                        'eq?
+                        `(files . ,files)
+                        `(home  . ,(cgi-get-metavariable "SCRIPT_NAME"))
+                        `(path  . ,(values-ref (decompose-path (cgi-get-metavariable "SCRIPT_NAME")) 0))
+                        `(title . "Bloscheme Test")
+                        )))))
+  0)
 
 
Index: /lang/scheme/bloscheme/template.scm
===================================================================
--- /lang/scheme/bloscheme/template.scm (revision 626)
+++ /lang/scheme/bloscheme/template.scm (revision 626)
@@ -0,0 +1,110 @@
+(use text.html-lite)
+(use text.tree)
+
+(define (result stash-table)
+  (define (stash name)
+    (html-escape-string (hash-table-get stash-table name)))
+  (define (stash-raw name)
+    (hash-table-get stash-table name))
+
+  `("Content-Type: text/html; charset=UTF-8\r\n\r\n"
+    ,(html-doctype :type :xhtml-1.0-strict)
+    ,(html:html
+       (html:head
+         (html:title (stash 'title))
+         (html:meta :name "keywords" :content "norobot")
+         (html:style :type "text/css" "
+                     body {
+                     background: #fff;
+                     color: #555;
+                     padding: 0 10%;
+                     line-height: 1.75;
+                     }
+
+                     .all {
+                     width: 45em;
+                     }
+
+                     a:link {
+                     color: #d06c6b;
+                     }
+
+                     a:visited {
+                     color: #b44e4d;
+                     }
+
+                     a:hover {
+                     text-decoration: none;
+                     }
+
+                     h1, h2, h3 {
+                     font-weight: normal;
+                     }
+
+                     .entry {
+                     border-top: 1px solid #ddd;
+                     padding: 1em 0;
+                     }
+
+                     h3 {
+                     color: #d06c6b;
+                     margin: 0 0 1em 0;
+                     }
+
+                     dl.information {
+                     margin: 0;
+                     color: #ccc;
+                     font-size: 80%;
+                     text-align: right;
+                     }
+
+                     dt, dd {
+                     display: inline;
+                     }
+
+                     #top a:link,
+                     #top a:visited,
+                     #top a:hover,
+                     #top a {
+                     text-decoration: none;
+                     }
+
+                     #footer {
+                     font-size: 80%;
+                     color: #999;
+                     text-align: center;
+                     }
+                     ")
+                     )
+         (html:body
+           (html:div
+             :class "all"
+             (html:h1 :id "top" (html:a :href (string-append (stash 'home) "/")  (stash 'title)))
+             (html:div :class "section"
+                       (html:h2 "Days")
+                       (map (lambda (file)
+                              (html:div :class "entry"
+                                        (html:h3
+                                          (html:a :href (string-join (list (stash 'home) (hash-table-get file 'name)) "")
+                                                  (html-escape-string (hash-table-get file 'title))))
+                                        (html:div :class "entry-body"
+                                                  (string-join (hash-table-get file 'body) "\n"))
+                                        (html:dl :class "information"
+                                                 (html:dt "DateTime")
+                                                 (html:dd (date->string (hash-table-get file 'date) "~Y-~m-~d ~H:~M:~S"))
+                                                 )
+                                        ))
+                            (stash-raw 'files)))
+             (html:div :id "footer"
+                       (html:p
+                         "Gauche "
+                         (gauche-version)
+                         " on "
+                         (gauche-architecture))
+                       (html:p (html:a :href "http://d.hatena.ne.jp/jknaoya/" "id:jknaoya"))
+                       )
+             ) ; /div.all
+           ) ; /body
+         ) ; /html
+       )
+    )