1 ! Copyright (C) 2008 Slava Pestov
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors kernel namespaces io math.parser assocs classes
4 classes.tuple words arrays sequences splitting mirrors
5 hashtables combinators continuations math strings inspector
6 fry locals calendar calendar.format xml.entities
7 validators urls present
8 xmode.code2html lcs.diff2html farkup
9 html.elements html.streams html.forms ;
12 GENERIC: render* ( value name renderer -- )
14 : render ( name renderer -- )
18 [ [ message>> ] [ value>> ] bi ]
23 [ render-error ] when* ;
27 : render-input ( value name type -- )
28 <input =type =name present =value input/> ;
34 M: label render* 2drop present escape-string write ;
38 M: hidden render* drop "hidden" render-input ;
40 : render-field ( value name size type -- )
43 [ present =size ] when*
50 : <field> ( -- field )
53 M: field render* size>> "text" render-field ;
55 TUPLE: password size ;
57 : <password> ( -- password )
61 #! Don't send passwords back to the user
62 [ drop "" ] 2dip size>> "password" render-field ;
65 TUPLE: textarea rows cols ;
67 : <textarea> ( -- renderer )
72 [ rows>> [ present =rows ] when* ]
73 [ cols>> [ present =cols ] when* ] bi
76 present escape-string write
80 TUPLE: choice size multiple choices ;
82 : <choice> ( -- choice )
85 : render-option ( text selected? -- )
86 <option [ "selected" =selected ] when option>
87 present escape-string write
90 : render-options ( options selected -- )
91 '[ dup _ member? render-option ] each ;
96 dup size>> [ present =size ] when*
97 dup multiple>> [ "true" =multiple ] when
99 [ choices>> value ] [ multiple>> ] bi
100 [ swap ] [ swap 1array ] if
105 TUPLE: checkbox label ;
107 : <checkbox> ( -- checkbox )
114 swap [ "true" =checked ] when
116 label>> escape-string write
120 GENERIC: link-title ( obj -- string )
121 GENERIC: link-href ( obj -- url )
123 M: string link-title ;
124 M: string link-href ;
133 <a target>> [ =target ] when* dup link-href =href a>
134 link-title present escape-string write
137 ! XMode code component
144 [ string-lines ] [ drop ] [ mode>> value ] tri* htmlize-lines ;
147 TUPLE: farkup no-follow disable-images parsed ;
149 : <farkup> ( -- farkup )
152 : string>boolean ( string -- boolean )
162 [ no-follow>> [ string>boolean link-no-follow? set ] when* ]
163 [ disable-images>> [ string>boolean disable-images? set ] when* ]
164 [ parsed>> string>boolean [ (write-farkup) ] [ write-farkup ] if ]
168 ! Inspector component
172 2drop [ describe ] with-html-writer ;
175 SINGLETON: comparison
177 M: comparison render*
183 M: html render* 2drop write ;