Gauche:SXML:SXSLT:tree-transを使ってsxmlを処理する
yamasushi(2013/03/22 10:07:58 UTC) sxmlを処理するのにtree-transをつかってみました。
(use sxml.tree-trans) (use srfi-13) ;string (use srfi-1)
; sxml特殊文字のハンドラ ; html5の文字参照をつかう (define (tokushumoji-handler x) (cond ((and (symbol? x) (ref hash-html5-entities x #f) ) => identity ) ((symbol? x) (string-append "&" (symbol->string x))) ((number? x) ($ string $ integer->char x ) ) (else (error (format #f "unknown ~a" x) ) ) ) )
(※hash-html5-entitiesは"大きな変換テーブルを使うとき"で用意します。)
; listのなかの連続する文字列を連結 (define (list-string-concatenate l) ;#?=l (cond ((null? l) '()) ((pair? l) (receive (head tail) (span string? l) (if (null? head) (cons (car tail) ($ list-string-concatenate $ cdr tail) ) (cons (string-concatenate head) (list-string-concatenate tail)) ) ) ) (else l) ) )
; sxmlの特殊文字を文字列にする ; htmlpragで読み込んだsxml用 ; ( HtmlPrag http://www.neilvandyke.org/htmlprag/ ) (define (sxml-tokushu sx) (post-order sx `( (|&| . ,(^(trigger x) (tokushumoji-handler x) ) ) ; (*text* . ,(^(trigger x) x ) ) (*default* . ,(^ x (list-string-concatenate x) ) ) ) ) )
; sxmlを文字列にする ; TODO テーブル内テーブルはどうなる? ; TODO テーブル要素内の改行をとると、テーブルでレイアウトしているときに困る ; 単純にテーブルを使っているときと区別する必要? ; TODO string-trim-both はどれくらい必要か? (define (sxml->string sx) (define (line-handler nl x) ($ (cut string-append <> nl ) $ string-trim-both $ string-concatenate x) ) ; (post-order sx `( (img ( ( |@| . ,(^ (t . sl) (string-concatenate sl) ) ) ( alt . ,(^ (t s) (format #f "~a\n" s) )) ( title . ,(^ (t s) (format #f "~a\n" s) )) ( *text* . ,(^(t s) s ) ) ( *default* . ,(^ _ "" ) ) ) . ,(^ (t . sl) (string-concatenate sl) ) ) ; (style *preorder* . ,(^ x "" ) ) ; style削除 (script *preorder* . ,(^ x "" ) ) ; script削除 (*PI* *preorder* . ,(^ x "" ) ) ; *PI*削除 (*DECL* *preorder* . ,(^ x "" ) ) ; *DECL*削除 (*COMMENT* *preorder* . ,(^ x "" ) ) ; コメント削除 (|@| *preorder* . ,(^ x "" ) ) ; 属性削除 (br . ,(^ x "\n" ) ) ; brは改行 (hr . ,(^ x "\n" ) ) ; hrは改行 ; (|&| . ,(^(trigger x) (tokushumoji-handler x) ) ) ; 特殊文字 ; (p . ,(^ (trigger . x) (line-handler "\n\n" x) ) ) (h1 . ,(^ (trigger . x) (line-handler "\n\n" x) ) ) (h2 . ,(^ (trigger . x) (line-handler "\n\n" x) ) ) (h3 . ,(^ (trigger . x) (line-handler "\n\n" x) ) ) (h4 . ,(^ (trigger . x) (line-handler "\n\n" x) ) ) (h5 . ,(^ (trigger . x) (line-handler "\n\n" x) ) ) (h6 . ,(^ (trigger . x) (line-handler "\n\n" x) ) ) ; (span . ,(^ (trigger . x) (line-handler "\n" x) ) ) ; ;リストの処理 (ul . ,(^ (trigger . x) (line-handler "\n\n" x) ) ) (li . ,(^ (trigger . x) (line-handler "\n" x) ) ) ; (th . ,(^ (trigger . x) ($ string-concatenate $ append x '("\t") ) ) ) (td . ,(^ (trigger . x) ($ string-concatenate $ append x '("\t") ) ) ) ; 余分についた\tをとってから改行 (tr . ,(^ (trigger . x) (line-handler "\n" x) ) ) (*text* . ,(^(trigger x) ;#?=trigger ;#?=x (cond ( (string? x) (string-trim-both x) ) ( else x) ) ) ) ; (*default* . ,(^ x ;#?=x ($ string-concatenate $ cdr x) ) ) ) ) )
tableなどの構造に注目した変換。
; listのなかのlistをspliceする ; (a b c ( d (e) f) g h .. ) --> ( a b c d (e) f g h) ; == `(a b c ,@'(d (e) f) g h) ; (a b c () g h .. ) --> ( a b c g h) ; == `(a b c ,@'() g h) (define (list-splice l) (cond ((null? l) '()) ((pair? l) (append (if ($ list? $ car l) (car l) ($ list $ car l) ) ($ list-splice $ cdr l) ) ) ) ) ; sxmlを文字列のリストにする (define (sxml->string-list sx) (define (node-handler x) ($ filter (^x (or (and (string? x) ($ not $ string-null? x) ($ not $ #/^\s*$/ x ) ) (pair? x ) ) ) $ map (^x (cond ((string? x) (string-trim-both x)) ((pair? x) (if (null? (cdr x) ) (car x) x ) ) (else x))) $ list-splice $ list-string-concatenate x) ) (define list-handler ($ list $ node-handler $) ) ;#?=sx (post-order sx `( (img ( ( |@| . ,(^ ( _ . sl ) (string-concatenate sl)) ) ( alt . ,(^ ( _ s ) (format #f "~a\n" s) )) ( title . ,(^ ( _ s ) (format #f "~a\n" s) )) ( *text* . ,(^ (t s) s ) ) ( *default* . ,(^ _ "" ) ) ) . ,(^ (t . sl) (string-concatenate sl)) ) ; (style *preorder* . ,(^ x "" ) ) ; style削除 (script *preorder* . ,(^ x "" ) ) ; script削除 (*PI* *preorder* . ,(^ x "" ) ) ; *PI*削除 (*DECL* *preorder* . ,(^ x "" ) ) ; *DECL*削除 (*COMMENT* *preorder* . ,(^ x "" ) ) ; コメント削除 (|@| *preorder* . ,(^ x "" ) ) ; 属性削除 (br *preorder* . ,(^ x "\n" ) ) ; brは (hr *preorder* . ,(^ x "\n" ) ) ; hrは改行 ; (|&| . ,(^(trigger x) (tokushumoji-handler x) ) ) ; 特殊文字 ; (table . ,(^ (t . x) (list-handler x) ) ) (tr . ,(^ (t . x) (list-handler x) ) ) (th . ,(^ (t . x) (list-handler x) ) ) (td . ,(^ (t . x) (list-handler x) ) ) (ul . ,(^ (t . x) (list-handler x) ) ) (li . ,(^ (t . x) (list-handler x) ) ) ; (div . ,(^ (t . x) (list-handler x) ) ) ; (*text* . ,(^ x (cadr x) ) ) (*default* . ,(^ (t . x) (node-handler x) ) ) ) ) )
Tags: sxml.tree-trans, SXML, SXSLT