| 1 | (use srfi-19) ;; make-date date->string |
|---|
| 2 | (use sxml.serializer) |
|---|
| 3 | |
|---|
| 4 | (define lambda-news (lambda () |
|---|
| 5 | (call-with-input-file "news.dat" |
|---|
| 6 | (lambda (in) |
|---|
| 7 | (let ((news (read in))) |
|---|
| 8 | (map (lambda (ns) |
|---|
| 9 | (let ((y (list-ref (car ns) 0)) |
|---|
| 10 | (m (list-ref (car ns) 1)) |
|---|
| 11 | (d (list-ref (car ns) 2)) |
|---|
| 12 | (h (list-ref (car ns) 3)) |
|---|
| 13 | (i (list-ref (car ns) 4)) |
|---|
| 14 | (s 1)) |
|---|
| 15 | (let ((dt (make-date 0 s i h d m y 0))) |
|---|
| 16 | `(li (@ (id ,(string-append "news" (date->string dt "~Y~m~d~H~M~S")))) |
|---|
| 17 | (span (@ (class "date")) ,(date->string dt "~Y/~m/~d(~a)")) |
|---|
| 18 | " : " ,@(cdr ns))))) |
|---|
| 19 | news)))))) |
|---|
| 20 | |
|---|
| 21 | (define main (lambda (args) |
|---|
| 22 | (call-with-output-file "news.html" |
|---|
| 23 | (lambda (out) |
|---|
| 24 | (display "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>" out) |
|---|
| 25 | (newline out) |
|---|
| 26 | (display "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"" out) |
|---|
| 27 | (newline out) |
|---|
| 28 | (display "\t\"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">" out) |
|---|
| 29 | (newline out) |
|---|
| 30 | (srl:sxml->xml |
|---|
| 31 | `(html (@ (xmlns "http://www.w3.org/1999/xhtml") (xml:lang "ja")) |
|---|
| 32 | (head |
|---|
| 33 | (meta (@ (http-equiv "Content-Type") (content "text/html; charset=UTF-8"))) |
|---|
| 34 | (meta (@ (http-equiv "Content-Language") (content "ja"))) |
|---|
| 35 | (meta (@ (name "keywords") (content "Scheme,Lisp,Lambda,NEWS"))) |
|---|
| 36 | (meta (@ (name "description") (content "LAMBDA NEWS - Scheme/Lisp 界の日々の記録。"))) |
|---|
| 37 | (link (@ (rel "shortcut icon") (href "favicon.ico") (type "image/x-icon"))) |
|---|
| 38 | (link (@ (rel "stylesheet") (type "text/css") (href "index.css"))) |
|---|
| 39 | (link (@ (rel "alternate") (type "application/atom+xml") (title "Scheme-users.jp Atom Feed") (href "http://scheme-users.jp/atom.xml"))) |
|---|
| 40 | (title "LAMBDA NEWS - Scheme-users.jp")) |
|---|
| 41 | (body |
|---|
| 42 | (p (@ (style "margin-left:0;")) |
|---|
| 43 | (a (@ (href "http://scheme-users.jp/")) |
|---|
| 44 | (img (@ (src "./images/top.png") (alt "scheme-users.jp") (style "border:none;"))))) |
|---|
| 45 | (h1 "LAMBDA NEWS") |
|---|
| 46 | (ul ,@(lambda-news)))) |
|---|
| 47 | out) |
|---|
| 48 | (newline out))) |
|---|
| 49 | 0)) |
|---|
