Fixing some things I broke

db4
Daniel Ehrenberg 2009-01-30 19:28:16 -06:00
parent a622d6113e
commit d4f865d5f0
18 changed files with 86 additions and 80 deletions

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays combinators html.elements io
USING: accessors arrays combinators io
io.streams.string kernel math namespaces peg peg.ebnf
sequences sequences.deep strings xml.entities xml.literals
vectors splitting xmode.code2html urls.encoding xml.data

View File

@ -10,7 +10,6 @@ furnace.utilities
furnace.redirection
furnace.conversations
html.forms
html.elements
html.components
html.components
html.templates.chloe

View File

@ -8,6 +8,7 @@ xml.data
xml.entities
xml.writer
xml.utilities
xml.literals
html.components
html.elements
html.forms
@ -20,7 +21,6 @@ http.server
http.server.redirection
http.server.responses
furnace.utilities ;
QUALIFIED-WITH: assocs a
IN: furnace.chloe-tags
! Chloe tags
@ -56,11 +56,11 @@ CHLOE: write-atom drop [ write-atom-feeds ] [code] ;
: compile-link-attrs ( tag -- )
#! Side-effects current namespace.
attrs>> '[ [ [ _ ] dip link-attr ] each-responder ] [code] ;
'[ [ [ _ ] dip link-attr ] each-responder ] [code] ;
: a-start-tag ( tag -- )
[ <a ] [code]
[ non-chloe-attrs-only compile-attrs ]
[ attrs>> non-chloe-attrs-only compile-attrs ]
[ compile-link-attrs ]
[ compile-a-url ]
tri
@ -116,17 +116,18 @@ CHLOE: form
} cleave
] compile-with-scope ;
STRING: button-tag-markup
<t:form class="inline" xmlns:t="http://factorcode.org/chloe/1.0">
<div style="display: inline;"><button type="submit"></button></div>
</t:form>
;
: button-tag-markup ( -- xml )
<XML
<t:form class="inline" xmlns:t="http://factorcode.org/chloe/1.0">
<div style="display: inline;"><button type="submit"></button></div>
</t:form>
XML> ;
: add-tag-attrs ( attrs tag -- )
attrs>> swap update ;
CHLOE: button
button-tag-markup string>xml body>>
button-tag-markup body>>
{
[ [ attrs>> chloe-attrs-only ] dip add-tag-attrs ]
[ [ attrs>> non-chloe-attrs-only ] dip "button" deep-tag-named add-tag-attrs ]

View File

@ -1,11 +1,11 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io.encodings.utf8 io.encodings.ascii io.encodings.binary
io.files io.files.temp io.directories html.streams html.elements help kernel
io.files io.files.temp io.directories html.streams help kernel
assocs sequences make words accessors arrays help.topics vocabs
tools.vocabs tools.vocabs.browser namespaces prettyprint io
vocabs.loader serialize fry memoize unicode.case math.order
sorting debugger ;
sorting debugger html.elements html ;
IN: help.html
: escape-char ( ch -- )

View File

@ -6,7 +6,7 @@ hashtables combinators continuations math strings inspector
fry locals calendar calendar.format xml.entities xml.data
validators urls present xml.writer xml.literals xml
xmode.code2html lcs.diff2html farkup io.streams.string
html.elements html.streams html.forms ;
html html.streams html.forms ;
IN: html.components
GENERIC: render* ( value name renderer -- xml )

View File

@ -1,5 +1,5 @@
USING: help.markup help.syntax io present html ;
IN: html.elements
USING: help.markup help.syntax io present ;
ARTICLE: "html.elements" "HTML elements"
"The " { $vocab-link "html.elements" } " vocabulary provides words for writing HTML tags to the " { $link output-stream } " with a familiar look and feel in the code."

View File

@ -3,18 +3,9 @@
USING: io io.styles kernel namespaces prettyprint quotations
sequences strings words xml.entities compiler.units effects
xml.data xml.literals urls math math.parser combinators
present fry io.streams.string xml.writer ;
present fry io.streams.string xml.writer html ;
IN: html.elements
SYMBOL: html
: write-html ( str -- )
H{ { html t } } format ;
: print-html ( str -- )
write-html "\n" write-html ;
<<
: elements-vocab ( -- vocab-name ) "html.elements" ;
@ -127,24 +118,3 @@ SYMBOL: html
] [ define-attribute-word ] each
>>
: xhtml-preamble ( -- )
"<?xml version=\"1.0\"?>" write-html
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">" write-html ;
: simple-page ( title head-quot body-quot -- )
[ with-string-writer <unescaped> ] bi@
<XML
<?xml version="1.0"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<title><-></title>
<->
</head>
<body><-></body>
</html>
XML> write-xml ; inline
: render-error ( message -- )
[XML <span class="error"><-></span> XML] write-xml ;

View File

@ -1,8 +1,8 @@
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors strings namespaces assocs hashtables io
mirrors math fry sequences words continuations html.elements
xml.entities ;
mirrors math fry sequences words continuations
xml.entities xml.writer xml.literals ;
IN: html.forms
TUPLE: form errors values validation-failed ;
@ -109,7 +109,6 @@ C: <validation-error> validation-error
: render-validation-errors ( -- )
form get errors>>
[
<ul "errors" =class ul>
[ <li> escape-string write </li> ] each
</ul>
[ [XML <li><-></li> XML] ] map
[XML <ul class="errors"><-></ul> XML] write-xml
] unless-empty ;

34
basis/html/html.factor Normal file
View File

@ -0,0 +1,34 @@
! Copyright (C) 2004, 2009 Chris Double, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: io kernel xml.data xml.writer io.streams.string
xml.literals io.styles ;
IN: html
SYMBOL: html
: write-html ( str -- )
H{ { html t } } format ;
: print-html ( str -- )
write-html "\n" write-html ;
: xhtml-preamble ( -- )
"<?xml version=\"1.0\"?>" write-html
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">" write-html ;
: simple-page ( title head-quot body-quot -- )
[ with-string-writer <unescaped> ] bi@
<XML
<?xml version="1.0"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<title><-></title>
<->
</head>
<body><-></body>
</html>
XML> write-xml ; inline
: render-error ( message -- )
[XML <span class="error"><-></span> XML] write-xml ;

View File

@ -4,7 +4,7 @@ USING: combinators generic assocs help http io io.styles
io.files continuations io.streams.string kernel math math.order
math.parser namespaces make quotations assocs sequences strings
words html.elements xml.entities sbufs continuations destructors
accessors arrays urls.encoding ;
accessors arrays urls.encoding html ;
IN: html.streams
GENERIC: browser-link-href ( presented -- href )

View File

@ -5,8 +5,9 @@ namespaces make classes.tuple assocs splitting words arrays io
io.files io.files.info io.encodings.utf8 io.streams.string
unicode.case mirrors math urls present multiline quotations xml
logging continuations
xml.data
xml.data xml.writer xml.literals strings
html.forms
html
html.elements
html.components
html.templates

View File

@ -6,7 +6,6 @@ classes.tuple assocs splitting words arrays memoize parser lexer
io io.files io.encodings.utf8 io.streams.string
unicode.case mirrors fry math urls
multiline xml xml.data xml.writer xml.utilities
html.elements
html.components
html.templates ;

View File

@ -5,7 +5,7 @@ USING: continuations sequences kernel namespaces debugger
combinators math quotations generic strings splitting
accessors assocs fry vocabs.parser
parser lexer io io.files io.streams.string io.encodings.utf8
html.elements
html
html.templates ;
IN: html.templates.fhtml

View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel fry io io.encodings.utf8 io.files
debugger prettyprint continuations namespaces boxes sequences
arrays strings html.elements io.streams.string
quotations xml.data xml.writer ;
arrays strings html io.streams.string
quotations xml.data xml.writer xml.literals ;
IN: html.templates
MIXIN: template
@ -53,9 +53,13 @@ SYMBOL: atom-feeds
: write-atom-feeds ( -- )
atom-feeds get [
<link "alternate" =rel "application/atom+xml" =type
first2 [ =title ] [ =href ] bi*
link/>
first2 [XML
<link
rel="alternate"
type="application/atom+xml"
title=<->
href=<->/>
XML] write-xml
] each ;
SYMBOL: nested-template?

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: html.elements math.parser http accessors kernel
USING: math.parser http accessors kernel xml.literals xml.writer
io io.streams.string io.encodings.utf8 ;
IN: http.server.responses
@ -13,11 +13,13 @@ IN: http.server.responses
swap >>body ;
: trivial-response-body ( code message -- )
<html>
<body>
<h1> [ number>string write bl ] [ write ] bi* </h1>
</body>
</html> ;
<XML
<html>
<body>
<h1><-> <-></h1>
</body>
</html>
XML> write-xml ;
: <trivial-response> ( code message -- response )
2dup [ trivial-response-body ] with-string-writer

View File

@ -24,7 +24,7 @@ http.parsers
http.server.responses
http.server.remapping
html.templates
html.elements
html
html.streams ;
IN: http.server
@ -174,8 +174,9 @@ main-responder global [ <404> <trivial-responder> or ] change-at
[ add-responder-nesting ] [ call-responder* ] 2bi ;
: http-error. ( error -- )
"Internal server error" [ ] [
[ print-error nl :c ] with-html-writer
! TODO: get rid of rot
"Internal server error" [ ] rot '[
[ _ print-error nl :c ] with-html-writer
] simple-page ;
: <500> ( error -- response )

View File

@ -4,9 +4,9 @@ USING: calendar kernel math math.order math.parser namespaces
parser sequences strings assocs hashtables debugger mime.types
sorting logging calendar.format accessors splitting io io.files
io.files.info io.directories io.pathnames io.encodings.binary
fry xml.entities destructors urls html.elements
fry xml.entities destructors urls html xml.literals
html.templates.fhtml http http.server http.server.responses
http.server.redirection ;
http.server.redirection xml.writer ;
IN: http.server.static
TUPLE: file-responder root hook special allow-listings ;
@ -56,18 +56,14 @@ TUPLE: file-responder root hook special allow-listings ;
\ serve-file NOTICE add-input-logging
: file. ( name -- )
: file. ( name -- xml )
dup link-info directory? [ "/" append ] when
dup <a =href a> escape-string write </a> ;
dup [XML <li><a href=<->><-></a></li> XML] ;
: directory. ( path -- )
dup file-name [ ] [
[ <h1> file-name escape-string write </h1> ]
[
<ul>
directory-files [ <li> file. </li> ] each
</ul>
] bi
[ file-name ] [ directory-files [ file. ] map ] bi
[XML <h1><-></h1> <ul><-></ul> XML] write-xml
] simple-page ;
: list-directory ( directory -- response )

View File

@ -1,5 +1,5 @@
USING: xmode.tokens xmode.marker xmode.catalog kernel locals
html.elements io io.files sequences words io.encodings.utf8
io io.files sequences words io.encodings.utf8
namespaces xml.entities accessors xml.literals locals xml.writer ;
IN: xmode.code2html