| 1 | (use srfi-1) |
|---|
| 2 | (use srfi-19) |
|---|
| 3 | (use sxml.serializer) |
|---|
| 4 | |
|---|
| 5 | (define lambda-news (lambda () |
|---|
| 6 | (call-with-input-file "news.dat" |
|---|
| 7 | (lambda (in) |
|---|
| 8 | (let ((news (read in))) |
|---|
| 9 | (map (lambda (ns) |
|---|
| 10 | (let ((y (list-ref (car ns) 0)) |
|---|
| 11 | (m (list-ref (car ns) 1)) |
|---|
| 12 | (d (list-ref (car ns) 2)) |
|---|
| 13 | (h (list-ref (car ns) 3)) |
|---|
| 14 | (i (list-ref (car ns) 4)) |
|---|
| 15 | (s 1)) |
|---|
| 16 | (let ((dt (make-date 0 s i h d m y 0))) |
|---|
| 17 | `(entry |
|---|
| 18 | (title ,(date->string dt "~Y/~m/~d(~a)")) |
|---|
| 19 | (id ,(string-append "http://scheme-users.jp/index.html#news" (date->string dt "~Y~m~d~H~M~S"))) |
|---|
| 20 | (link (@ (href ,(string-append "http://scheme-users.jp/index.html#news" (date->string dt "~Y~m~d~H~M~S"))))) |
|---|
| 21 | (updated ,(date->string dt "~Y-~m-~dT~H:~M:~SZ")) |
|---|
| 22 | (content (@ (type "html")) |
|---|
| 23 | ,(call-with-output-string |
|---|
| 24 | (lambda (out) |
|---|
| 25 | (srl:sxml->xml (cons 'p (cdr ns)) out)))))))) |
|---|
| 26 | (take news 20))))))) |
|---|
| 27 | |
|---|
| 28 | (define main (lambda (args) |
|---|
| 29 | (srl:parameterizable |
|---|
| 30 | `(feed (@ (xmlns "http://www.w3.org/2005/Atom")) |
|---|
| 31 | (title "Scheme-users.jp") |
|---|
| 32 | (link (@ (href "http://scheme-users.jp/"))) |
|---|
| 33 | (updated ,(date->string (current-date) "~Y-~m-~dT~H:~M:~SZ")) |
|---|
| 34 | (auther (name "Scheme-users.jp")) |
|---|
| 35 | (id "http://scheme-users.jp/") |
|---|
| 36 | ,@(lambda-news)) |
|---|
| 37 | "atom.xml" |
|---|
| 38 | '(omit-xml-declaration . #f) |
|---|
| 39 | '(cdata-section-elements . (content))) |
|---|
| 40 | 0)) |
|---|
