From 1181bd6f59bcd5430c66471b23912d6e167ef83b Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 27 Jan 2009 00:03:42 -0600 Subject: [PATCH] Converting Farkup, html.components and lcs.diff2html to xml.interpolate --- basis/farkup/farkup.factor | 5 +- basis/html/components/components-tests.factor | 16 ++-- basis/html/components/components.factor | 104 ++++++++++++-------------- basis/lcs/diff2html/diff2html.factor | 86 +++++++++++---------- basis/xml/data/data.factor | 3 + basis/xml/interpolate/interpolate.factor | 3 +- 6 files changed, 108 insertions(+), 109 deletions(-) rewrite basis/lcs/diff2html/diff2html.factor (77%) diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index 4403d743d6..ccd12b83f2 100644 --- a/basis/farkup/farkup.factor +++ b/basis/farkup/farkup.factor @@ -232,8 +232,11 @@ M: vector (write-farkup) [ (write-farkup) ] map ; M: f (write-farkup) ; +: farkup>xml ( string -- xml ) + parse-farkup (write-farkup) ; + : write-farkup ( string -- ) - parse-farkup (write-farkup) write-xml-chunk ; + farkup>xml write-xml-chunk ; : convert-farkup ( string -- string' ) [ write-farkup ] with-string-writer ; diff --git a/basis/html/components/components-tests.factor b/basis/html/components/components-tests.factor index b4247e6e30..09bb5860ad 100644 --- a/basis/html/components/components-tests.factor +++ b/basis/html/components/components-tests.factor @@ -31,7 +31,7 @@ TUPLE: color red green blue ; ] with-string-writer ] unit-test -[ "" ] [ +[ "\" name=\"red\" type=\"hidden\"/>" ] [ [ "red" hidden render ] with-string-writer @@ -39,13 +39,13 @@ TUPLE: color red green blue ; [ ] [ "'jimmy'" "red" set-value ] unit-test -[ "" ] [ +[ "" ] [ [ "red" 5 >>size render ] with-string-writer ] unit-test -[ "" ] [ +[ "" ] [ [ "red" 5 >>size render ] with-string-writer @@ -105,7 +105,7 @@ TUPLE: color red green blue ; [ ] [ t "delivery" set-value ] unit-test -[ "Delivery" ] [ +[ "Delivery" ] [ [ "delivery" @@ -116,7 +116,7 @@ TUPLE: color red green blue ; [ ] [ f "delivery" set-value ] unit-test -[ "Delivery" ] [ +[ "Delivery" ] [ [ "delivery" @@ -133,7 +133,7 @@ M: link-test link-href drop "http://www.apple.com/foo&bar" ; [ ] [ link-test "link" set-value ] unit-test -[ "<Link Title>" ] [ +[ "<Link Title>" ] [ [ "link" link new render ] with-string-writer ] unit-test @@ -149,7 +149,7 @@ M: link-test link-href drop "http://www.apple.com/foo&bar" ; [ ] [ "java" "mode" set-value ] unit-test -[ "int x = 4;\n" ] [ +[ "int x = 4;" ] [ [ "code" "mode" >>mode render ] with-string-writer ] unit-test @@ -163,6 +163,8 @@ M: link-test link-href drop "http://www.apple.com/foo&bar" ; [ t ] [ [ "object" inspector render ] with-string-writer + USING: splitting sequences ; + "\"" split "'" join ! replace " with ' for now [ "object" value [ describe ] with-html-writer ] with-string-writer = ] unit-test diff --git a/basis/html/components/components.factor b/basis/html/components/components.factor index 6f35ba5d97..c8a4b20ca7 100644 --- a/basis/html/components/components.factor +++ b/basis/html/components/components.factor @@ -4,12 +4,12 @@ USING: accessors kernel namespaces io math.parser assocs classes classes.tuple words arrays sequences splitting mirrors hashtables combinators continuations math strings inspector fry locals calendar calendar.format xml.entities -validators urls present -xmode.code2html lcs.diff2html farkup +validators urls present xml.writer xml.interpolate xml +xmode.code2html lcs.diff2html farkup io.streams.string html.elements html.streams html.forms ; IN: html.components -GENERIC: render* ( value name renderer -- ) +GENERIC: render* ( value name renderer -- xml ) : render ( name renderer -- ) prepare-value @@ -19,38 +19,36 @@ GENERIC: render* ( value name renderer -- ) [ f swap ] if ] 2dip - render* + render* write-xml-chunk [ render-error ] when* ; ; +: render-input ( value name type -- xml ) + [XML name=<-> type=<->/> XML] ; PRIVATE> SINGLETON: label -M: label render* 2drop present escape-string write ; +M: label render* + 2drop present ; SINGLETON: hidden -M: hidden render* drop "hidden" render-input ; +M: hidden render* + drop "hidden" render-input ; -: render-field ( value name size type -- ) - ; +: render-field ( value name size type -- xml ) + [XML name=<-> size=<-> type=<->/> XML] ; TUPLE: field size ; : ( -- field ) field new ; -M: field render* size>> "text" render-field ; +M: field render* + size>> "text" render-field ; TUPLE: password size ; @@ -67,14 +65,12 @@ TUPLE: textarea rows cols ; : ; +M: textarea render* ( value name area -- xml ) + rot [ [ rows>> ] [ cols>> ] bi ] dip + [XML XML] ; ! Choice TUPLE: choice size multiple choices ; @@ -82,24 +78,23 @@ TUPLE: choice size multiple choices ; : ( -- choice ) choice new ; -: render-option ( text selected? -- ) - ; - -: render-options ( options selected -- ) - '[ dup _ member? render-option ] each ; - -M: choice render* - ; +: render-option ( text selected? -- xml ) + "selected" and swap + [XML XML] ; + +: render-options ( value choice -- xml ) + [ choices>> value ] [ multiple>> ] bi + [ swap ] [ swap 1array ] if + '[ dup _ member? render-option ] map ; + +M:: choice render* ( value name choice -- xml ) + choice size>> :> size + choice multiple>> "true" and :> multiple + value choice render-options :> contents + [XML XML] ; ! Checkboxes TUPLE: checkbox label ; @@ -108,13 +103,10 @@ TUPLE: checkbox label ; checkbox new ; M: checkbox render* - - label>> escape-string write - ; + [ "true" and ] [ ] [ label>> ] tri* + [XML name=<->><-> XML] ; ! Link components GENERIC: link-title ( obj -- string ) @@ -129,10 +121,9 @@ M: url link-href ; TUPLE: link target ; M: link render* - nip - > [ =target ] when* dup link-href =href a> - link-title present escape-string write - ; + nip swap + [ target>> ] [ [ link-href ] [ link-title ] bi ] bi* + [XML href=<->><-> XML] ; ! XMode code component TUPLE: code mode ; @@ -161,7 +152,7 @@ M: farkup render* nip [ no-follow>> [ string>boolean link-no-follow? set ] when* ] [ disable-images>> [ string>boolean disable-images? set ] when* ] - [ parsed>> string>boolean [ (write-farkup) ] [ write-farkup ] if ] + [ parsed>> string>boolean [ (write-farkup) ] [ farkup>xml ] if ] tri ] with-scope ; @@ -169,7 +160,8 @@ M: farkup render* SINGLETON: inspector M: inspector render* - 2drop [ describe ] with-html-writer ; + 2drop [ [ describe ] with-html-writer ] with-string-writer + string>xml-chunk ; ! Diff component SINGLETON: comparison @@ -180,4 +172,4 @@ M: comparison render* ! HTML component SINGLETON: html -M: html render* 2drop write ; +M: html render* 2drop string>xml-chunk ; diff --git a/basis/lcs/diff2html/diff2html.factor b/basis/lcs/diff2html/diff2html.factor dissimilarity index 77% index ebbb0f3786..ee9a168a12 100644 --- a/basis/lcs/diff2html/diff2html.factor +++ b/basis/lcs/diff2html/diff2html.factor @@ -1,44 +1,42 @@ -! Copyright (C) 2008 Slava Pestov -! See http://factorcode.org/license.txt for BSD license. -USING: lcs html.elements kernel ; -FROM: accessors => item>> ; -FROM: io => write ; -FROM: sequences => each if-empty ; -FROM: xml.entities => escape-string ; -IN: lcs.diff2html - -GENERIC: diff-line ( obj -- ) - -: write-item ( item -- ) - item>> [ " " ] [ escape-string ] if-empty write ; - -M: retain diff-line - - dup [ - - write-item - - ] bi@ - ; - -M: insert diff-line - - - - write-item - - ; - -M: delete diff-line - - - write-item - - - ; - -: htmlize-diff ( diff -- ) - - - [ diff-line ] each -
"Old" write "New" write
; +! Copyright (C) 2008 Slava Pestov +! See http://factorcode.org/license.txt for BSD license. +USING: lcs xml.interpolate xml.writer kernel strings ; +FROM: accessors => item>> ; +FROM: io => write ; +FROM: sequences => each if-empty when-empty map ; +IN: lcs.diff2html + +GENERIC: diff-line ( obj -- xml ) + +: item-string ( item -- string ) + item>> [ CHAR: no-break-space 1string ] when-empty ; + +M: retain diff-line + item-string + [XML <-> XML] + dup [XML <-><-> XML] ; + +M: insert diff-line + [XML + + + <-> + + XML] ; + +M: delete diff-line + [XML + + <-> + + + XML] ; + +: htmlize-diff ( diff -- xml ) + [ diff-line ] map + [XML + + + <-> +
OldNew
+ XML] ; diff --git a/basis/xml/data/data.factor b/basis/xml/data/data.factor index b014a96180..c44250035a 100644 --- a/basis/xml/data/data.factor +++ b/basis/xml/data/data.factor @@ -216,3 +216,6 @@ M: xml like PREDICATE: contained-tag < tag children>> not ; PREDICATE: open-tag < tag children>> ; + +UNION: xml-data + tag comment string directive instruction ; diff --git a/basis/xml/interpolate/interpolate.factor b/basis/xml/interpolate/interpolate.factor index f5e39da4ee..d8927ca728 100644 --- a/basis/xml/interpolate/interpolate.factor +++ b/basis/xml/interpolate/interpolate.factor @@ -30,7 +30,8 @@ DEFER: interpolate-sequence GENERIC: push-item ( item -- ) M: string push-item , ; -M: object push-item , ; +M: xml-data push-item , ; +M: object push-item present , ; M: sequence push-item [ dup array? [ % ] [ , ] if ] each ; -- 2.11.4.GIT