[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[kahua-dev:00773] Kahua で RSS (xml DOCTYPE 宣言したい)
初めまして，柴田といいます．
KahuaでRSSを出力するようなコードを書いてみました．
RSSでは下のようなxml宣言を付けて文字コードを指定しないといけません．
<?xml version="1.0" encoding="euc-jp" ?> <-----これ
<rss version="2.0">
<channel>
<title>top title</title>
<link>
.....
でも，Kahuaのrender-procが扱うnodesは，
下の2個なのでxml宣言を付けられません．(多分)
a) (node-set (html (head (title .....))))
b) ((html (head (title ....))))
そこで，下のようなSXML nodeも扱えるようにkahua.serverをいじって，
<html>タグなど外側にDOCTYPE宣言とxml宣言を書けるようにしてみました．
(*TOP* (*PI* version "foo" )
(*DECL* "baa")
(html (head (title ...)..).))
これは
<?version foo ?>
<!DOCTYPE baa >
<html>
<head>
<title>
...
</title>
..
</head>
.
</html>
と出力されます．
ツッコミ等おねがいします．
--------------------------------------------------------------------------------
diff -c ../Kahua-0.2.8/src/kahua/server.scm ./server.scm
*** ../Kahua-0.2.8/src/kahua/server.scm 2004-08-11 21:15:58.000000000 +0900
--- ./server.scm 2004-09-23 18:56:24.000000000 +0900
***************
*** 246,257 ****
;; default render proc
;; TODO: should apply interp-html-rec to all nodes!
(define (kahua-render-proc nodes context)
(let* ((expanded
(cond ((procedure? nodes) (car (rev-nodes (exec '() nodes))))
((eq? (car nodes) 'node-set) (cadr nodes))
(else (car nodes))))
! (interp (get-interp expanded)))
! (interp expanded context values)))
(define-values (add-interp! get-interp)
(let ((table (make-hash-table))
--- 246,281 ----
;; default render proc
;; TODO: should apply interp-html-rec to all nodes!
(define (kahua-render-proc nodes context)
+ ;; '(*TOP* (*PI* a... ) (*DECL* b...) (html ...))
+ ;; -> '(("<?" a... "?>")("<!DOCTYPE " b.... " >"))
+ (define (get-declarations nodes)
+ (define (iter node)
+ (let1 node-name (sxml:node-name node)
+ (cond ((eq? '*PI* node-name)
+ `("<?" ,(cadr node) " " ,(caddr node) " ?>\n"))
+ ((eq? '*DECL* node-name)
+ `("<!DOCTYPE " ,(cadr node) " >\n"))
+ (else #f))))
+ (filter-map iter (sxml:content-raw nodes)))
+ ;; '(*TOP* (*PI* ... ) (*DECL* ...) (html ...)) -> '(html ...)
+ (define (filter-declaration-node nodes)
+ (car (filter
+ (lambda (node) (not (eq? '*DECL* (sxml:node-name node))))
+ (sxml:content nodes))))
+
(let* ((expanded
(cond ((procedure? nodes) (car (rev-nodes (exec '() nodes))))
((eq? (car nodes) 'node-set) (cadr nodes))
+ ((eq? (car nodes) '*TOP*) (filter-declaration-node nodes))
(else (car nodes))))
! (interp (get-interp expanded))
! (cont (if (and (pair? nodes)
! (eq? (car nodes) '*TOP*))
! (lambda (nds cntx)
! (values
! (append (get-declarations nodes) nds) cntx))
! values)))
! (interp expanded context cont)))
(define-values (add-interp! get-interp)
(let ((table (make-hash-table))
--------------------------------------------------------------------------------
;;kahua-webでrss出力するentry
; <page-data>:id -> String
(define (page-url page)
(kahua-self-uri-full #`"show,(pagename-join
(map uri-encode-string
(pagename-split
(ref (find-kahua-instance <page-data> page) 'name))))"))
; <page-data>:id -> String
(define (page-title page)
(base-pagename (ref (find-kahua-instance <page-data> page) 'name)))
; <page-data>:id -> String
(define (pubdate-mtime page)
(let1 secs (ref (find-kahua-instance <page-data> page) 'mtime)
(sys-strftime "%a, %d %b %Y %H:%M:%S +0000" (sys-localtime secs))))
(define-entry (rss)
(let* ((full-url (kahua-self-uri-full))
; (List <page-data>:id)
(entries (ref (find-kahua-instance <page-set> "recent-changes")
'pages)))
;; SXML
`(*TOP*
(*PI* xml "version=\"1.0\" encoding=\"euc-jp\"")
(rss (@ (version "2.0"))
(extra-header (@ (name "content-type")
(value "text/xml; charset=euc-jp")))
(channel
(title "*top title*")
(link ,full-url)
(description "*description of this site*")
(lastBuildDate ,(pubdate-mtime (car entries)))
,@(map (lambda (entry)
`(item
(title ,(page-title entry))
(link ,(page-url entry))
(pubDate ,(pubdate-mtime entry))))
entries))))))
--------------------------------------------------------------------------------