swap >>responder ;\r
\r
: have-capabilities? ( capabilities -- ? )\r
- logged-in-user get {\r
- { [ dup not ] [ 2drop f ] }\r
- { [ dup deleted>> 1 = ] [ 2drop f ] }\r
- [ capabilities>> subset? ]\r
- } cond ;\r
+ realm get secure>> secure-connection? not and [ drop f ] [\r
+ logged-in-user get {\r
+ { [ dup not ] [ 2drop f ] }\r
+ { [ dup deleted>> 1 = ] [ 2drop f ] }\r
+ [ capabilities>> subset? ]\r
+ } cond\r
+ ] if ;\r
\r
M: protected call-responder* ( path responder -- response )\r
- '[\r
- , ,\r
- dup protected set\r
- dup capabilities>> have-capabilities?\r
- [ call-next-method ] [\r
- [ drop ] [ [ description>> ] [ capabilities>> ] bi ] bi*\r
- realm get login-required*\r
- ] if\r
- ] if-secure-realm ;\r
+ dup protected set\r
+ dup capabilities>> have-capabilities?\r
+ [ call-next-method ] [\r
+ [ drop ] [ [ description>> ] [ capabilities>> ] bi ] bi*\r
+ realm get login-required*\r
+ ] if ;\r
\r
: <auth-boilerplate> ( responder -- responder' )\r
<boilerplate> { realm "boilerplate" } >>template ;\r
URL" $realm" <redirect>
] >>submit
- <auth-boilerplate> ;
+ <auth-boilerplate>
+ <secure-realm-only> ;
: allow-registration ( login -- login )
<register-action> "register" add-responder ;
--- /dev/null
+USING: html.forms furnace.chloe-tags tools.test ;
+IN: furnace.chloe-tags.tests
+
+[ f ] [ f parse-query-attr ] unit-test
+
+[ f ] [ "" parse-query-attr ] unit-test
+
+[ H{ { "a" "b" } } ] [
+ begin-form
+ "b" "a" set-value
+ "a" parse-query-attr
+] unit-test
+
+[ H{ { "a" "b" } { "c" "d" } } ] [
+ begin-form
+ "b" "a" set-value
+ "d" "c" set-value
+ "a,c" parse-query-attr
+] unit-test
--- /dev/null
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays kernel combinators assocs
+namespaces sequences splitting words
+fry urls multiline present qualified
+xml
+xml.data
+xml.entities
+xml.writer
+xml.utilities
+html.components
+html.elements
+html.forms
+html.templates
+html.templates.chloe
+html.templates.chloe.compiler
+html.templates.chloe.syntax
+http
+http.server
+http.server.redirection
+http.server.responses
+furnace ;
+QUALIFIED-WITH: assocs a
+IN: furnace.chloe-tags
+
+! Chloe tags
+: parse-query-attr ( string -- assoc )
+ [ f ] [ "," split [ dup value ] H{ } map>assoc ] if-empty ;
+
+: a-url-path ( href rest -- string )
+ dup [ value ] when
+ [ [ "/" ?tail drop "/" ] dip present 3append ] when* ;
+
+: a-url ( href rest query value-name -- url )
+ dup [ >r 3drop r> value ] [
+ drop
+ <url>
+ swap parse-query-attr >>query
+ -rot a-url-path >>path
+ adjust-url relative-to-request
+ ] if ;
+
+: compile-a-url ( tag -- )
+ {
+ [ "href" required-attr compile-attr ]
+ [ "rest" optional-attr compile-attr ]
+ [ "query" optional-attr compile-attr ]
+ [ "value" optional-attr compile-attr ]
+ } cleave [ a-url ] [code] ;
+
+CHLOE: atom
+ [ compile-children>string ] [ compile-a-url ] bi
+ [ add-atom-feed ] [code] ;
+
+CHLOE: write-atom drop [ write-atom-feeds ] [code] ;
+
+: compile-link-attrs ( tag -- )
+ #! Side-effects current namespace.
+ attrs>> '[ [ , _ link-attr ] each-responder ] [code] ;
+
+: a-start-tag ( tag -- )
+ [ compile-link-attrs ] [ compile-a-url ] bi
+ [ <a =href a> ] [code] ;
+
+: a-end-tag ( tag -- )
+ drop [ </a> ] [code] ;
+
+CHLOE: a [ a-start-tag ] [ compile-children ] [ a-end-tag ] tri ;
+
+: compile-hidden-form-fields ( for -- )
+ '[
+ , [ "," split [ hidden render ] each ] when*
+ nested-forms get " " join f like nested-forms-key hidden-form-field
+ [ modify-form ] each-responder
+ ] [code] ;
+
+: compile-form-attrs ( method action attrs -- )
+ [ <form ] [code]
+ [ compile-attr [ =method ] [code] ]
+ [ compile-attr [ resolve-base-path =action ] [code] ]
+ [ compile-attrs ]
+ tri*
+ [ form> ] [code] ;
+
+: form-start-tag ( tag -- )
+ [
+ [ "method" optional-attr "post" or ]
+ [ "action" required-attr ]
+ [ attrs>> non-chloe-attrs-only ] tri
+ compile-form-attrs
+ ]
+ [ "for" optional-attr compile-hidden-form-fields ] bi ;
+
+: form-end-tag ( tag -- )
+ drop [ </form> ] [code] ;
+
+CHLOE: form
+ {
+ [ compile-link-attrs ]
+ [ form-start-tag ]
+ [ compile-children ]
+ [ form-end-tag ]
+ } cleave ;
+
+STRING: button-tag-markup
+<t:form class="inline" xmlns:t="http://factorcode.org/chloe/1.0">
+ <button type="submit"></button>
+</t:form>
+;
+
+: add-tag-attrs ( attrs tag -- )
+ attrs>> swap update ;
+
+CHLOE: button
+ button-tag-markup string>xml body>>
+ {
+ [ [ attrs>> chloe-attrs-only ] dip add-tag-attrs ]
+ [ [ attrs>> non-chloe-attrs-only ] dip "button" tag-named add-tag-attrs ]
+ [ [ children>> ] dip "button" tag-named (>>children) ]
+ [ nip ]
+ } 2cleave compile-chloe-tag ;
over post-data>> >>post-data
over url>> >>url
] change
- url>> path>> split-path
+ [ url>> url set ]
+ [ url>> path>> split-path ] bi
conversations get responder>> call-responder ;
\ end-aside-post DEBUG add-input-logging
-! Copyright (C) 2003, 2008 Slava Pestov.
+! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel combinators assocs
-continuations namespaces sequences splitting words
-vocabs.loader classes strings
-fry urls multiline present
-xml
-xml.data
-xml.entities
-xml.writer
-html.components
-html.elements
-html.forms
-html.templates
-html.templates.chloe
-html.templates.chloe.syntax
-http
-http.server
-http.server.redirection
-http.server.responses
-qualified ;
-QUALIFIED-WITH: assocs a
-EXCLUDE: xml.utilities => children>string ;
+USING: namespaces assocs sequences kernel classes splitting
+vocabs.loader accessors strings combinators arrays
+continuations present fry
+urls html.elements
+http http.server http.server.redirection ;
IN: furnace
: nested-responders ( -- seq )
- responder-nesting get a:values ;
+ responder-nesting get values ;
: each-responder ( quot -- )
nested-responders swap each ; inline
M: string adjust-url ;
+GENERIC: link-attr ( tag responder -- )
+
+M: object link-attr 2drop ;
+
GENERIC: modify-form ( responder -- )
M: object modify-form drop ;
+: hidden-form-field ( value name -- )
+ over [
+ <input
+ "hidden" =type
+ =name
+ present =value
+ input/>
+ ] [ 2drop ] if ;
+
+: nested-forms-key "__n" ;
+
: request-params ( request -- assoc )
dup method>> {
{ "GET" [ url>> query>> ] }
: with-exit-continuation ( quot -- )
'[ exit-continuation set @ ] callcc1 exit-continuation off ;
-! Chloe tags
-: parse-query-attr ( string -- assoc )
- [ f ] [ "," split [ dup value ] H{ } map>assoc ] if-empty ;
-
-: a-url-path ( tag -- string )
- [ "href" required-attr ]
- [ "rest" optional-attr dup [ value ] when ] bi
- [ [ "/" ?tail drop "/" ] dip present 3append ] when* ;
-
-: a-url ( tag -- url )
- dup "value" optional-attr
- [ value ] [
- <url>
- swap
- [ a-url-path >>path ]
- [ "query" optional-attr parse-query-attr >>query ]
- bi
- adjust-url relative-to-request
- ] ?if ;
-
-CHLOE: atom [ children>string ] [ a-url ] bi add-atom-feed ;
-
-CHLOE: write-atom drop write-atom-feeds ;
-
-GENERIC: link-attr ( tag responder -- )
-
-M: object link-attr 2drop ;
-
-: link-attrs ( tag -- )
- #! Side-effects current namespace.
- '[ , _ link-attr ] each-responder ;
-
-: a-start-tag ( tag -- )
- [ <a [ link-attrs ] [ a-url =href ] bi a> ] with-scope ;
-
-CHLOE: a
- [ a-start-tag ]
- [ process-tag-children ]
- [ drop </a> ]
- tri ;
-
-: hidden-form-field ( value name -- )
- over [
- <input
- "hidden" =type
- =name
- present =value
- input/>
- ] [ 2drop ] if ;
-
-: nested-forms-key "__n" ;
-
-: form-magic ( tag -- )
- [ modify-form ] each-responder
- nested-forms get " " join f like nested-forms-key hidden-form-field
- "for" optional-attr [ "," split [ hidden render ] each ] when* ;
-
-: form-start-tag ( tag -- )
- [
- [
- <form
- {
- [ link-attrs ]
- [ "method" optional-attr "post" or =method ]
- [ "action" required-attr resolve-base-path =action ]
- [ attrs>> non-chloe-attrs-only print-attrs ]
- } cleave
- form>
- ]
- [ form-magic ] bi
- ] with-scope ;
-
-CHLOE: form
- [ form-start-tag ]
- [ process-tag-children ]
- [ drop </form> ]
- tri ;
-
-STRING: button-tag-markup
-<t:form class="inline" xmlns:t="http://factorcode.org/chloe/1.0">
- <button type="submit"></button>
-</t:form>
-;
-
-: add-tag-attrs ( attrs tag -- )
- attrs>> swap update ;
-
-CHLOE: button
- button-tag-markup string>xml body>>
- {
- [ [ attrs>> chloe-attrs-only ] dip add-tag-attrs ]
- [ [ attrs>> non-chloe-attrs-only ] dip "button" tag-named add-tag-attrs ]
- [ [ children>string 1array ] dip "button" tag-named (>>children) ]
- [ nip ]
- } 2cleave process-chloe-tag ;
+"furnace.chloe-tags" require
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors combinators namespaces fry
-io.servers.connection urls
-http http.server http.server.redirection http.server.filters
-furnace ;
+io.servers.connection urls http http.server
+http.server.redirection http.server.responses
+http.server.filters furnace ;
IN: furnace.redirection
: <redirect> ( url -- response )
C: <secure-only> secure-only
-: if-secure ( quot -- )
- >r url get protocol>> "http" =
- [ url get <secure-redirect> ]
- r> if ; inline
+: secure-connection? ( -- ? ) url get protocol>> "https" = ;
+
+: if-secure ( quot -- response )
+ {
+ { [ secure-connection? ] [ call ] }
+ { [ request get method>> "POST" = ] [ drop <400> ] }
+ [ drop url get <secure-redirect> ]
+ } cond ; inline
M: secure-only call-responder*
'[ , , call-next-method ] if-secure ;
splitting unicode.categories furnace accessors ;
IN: html.templates.chloe.tests
-[ f ] [ f parse-query-attr ] unit-test
-
-[ f ] [ "" parse-query-attr ] unit-test
-
-[ H{ { "a" "b" } } ] [
- begin-form
- "b" "a" set-value
- "a" parse-query-attr
-] unit-test
-
-[ H{ { "a" "b" } { "c" "d" } } ] [
- begin-form
- "b" "a" set-value
- "d" "c" set-value
- "a,c" parse-query-attr
-] unit-test
+reset-templates
: run-template
with-string-writer [ "\r\n\t" member? not ] filter
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel sequences combinators kernel namespaces
-classes.tuple assocs splitting words arrays memoize
-io io.files io.encodings.utf8 io.streams.string
-unicode.case mirrors fry math urls present
-multiline xml xml.data xml.writer xml.utilities
+USING: accessors kernel sequences combinators kernel fry
+namespaces classes.tuple assocs splitting words arrays memoize
+io io.files io.encodings.utf8 io.streams.string unicode.case
+mirrors math urls present multiline quotations xml xml.data
html.forms
html.elements
html.components
html.templates
+html.templates.chloe.compiler
+html.templates.chloe.components
html.templates.chloe.syntax ;
IN: html.templates.chloe
! Chloe is Ed's favorite web designer
-SYMBOL: tag-stack
-
TUPLE: chloe path ;
C: <chloe> chloe
-DEFER: process-template
-
-: chloe-attrs-only ( assoc -- assoc' )
- [ drop url>> chloe-ns = ] assoc-filter ;
-
-: non-chloe-attrs-only ( assoc -- assoc' )
- [ drop url>> chloe-ns = not ] assoc-filter ;
-
-: chloe-tag? ( tag -- ? )
- dup xml? [ body>> ] when
- {
- { [ dup tag? not ] [ f ] }
- { [ dup url>> chloe-ns = not ] [ f ] }
- [ t ]
- } cond nip ;
-
-: process-tag-children ( tag -- )
- [ process-template ] each ;
-
-CHLOE: chloe process-tag-children ;
+CHLOE: chloe compile-children ;
-: children>string ( tag -- string )
- [ process-tag-children ] with-string-writer ;
-
-CHLOE: title children>string set-title ;
+CHLOE: title compile-children>string [ set-title ] [code] ;
CHLOE: write-title
drop
"head" tag-stack get member?
"title" tag-stack get member? not and
- [ <title> write-title </title> ] [ write-title ] if ;
+ [ <title> write-title </title> ] [ write-title ] ? [code] ;
CHLOE: style
- dup "include" optional-attr dup [
- swap children>string empty? [
- "style tag cannot have both an include attribute and a body" throw
- ] unless
- utf8 file-contents
+ dup "include" optional-attr [
+ utf8 file-contents [ add-style ] [code-with]
] [
- drop children>string
- ] if add-style ;
+ compile-children>string [ add-style ] [code]
+ ] ?if ;
CHLOE: write-style
- drop <style> write-style </style> ;
+ drop [ <style> write-style </style> ] [code] ;
-CHLOE: even "index" value even? [ process-tag-children ] [ drop ] if ;
+CHLOE: even
+ [ "index" value even? swap when ] process-children ;
-CHLOE: odd "index" value odd? [ process-tag-children ] [ drop ] if ;
+CHLOE: odd
+ [ "index" value odd? swap when ] process-children ;
: (bind-tag) ( tag quot -- )
[
- [ "name" required-attr ] keep
- '[ , process-tag-children ]
- ] dip call ; inline
+ [ "name" required-attr compile-attr ] keep
+ ] dip process-children ; inline
CHLOE: each [ with-each-value ] (bind-tag) ;
CHLOE: bind [ with-form ] (bind-tag) ;
-: error-message-tag ( tag -- )
- children>string render-error ;
-
CHLOE: comment drop ;
-CHLOE: call-next-template drop call-next-template ;
+CHLOE: call-next-template
+ drop reset-buffer \ call-next-template , ;
: attr>word ( value -- word/f )
":" split1 swap lookup ;
-: if-satisfied? ( tag -- ? )
- [ "code" optional-attr [ attr>word dup [ execute ] when ] [ t ] if* ]
- [ "value" optional-attr [ value ] [ t ] if* ]
- bi and ;
+: if>quot ( tag -- quot )
+ [
+ [ "code" optional-attr [ attr>word [ , ] [ f , ] if* ] [ t , ] if* ]
+ [ "value" optional-attr [ , \ value , ] [ t , ] if* ]
+ bi
+ \ and ,
+ ] [ ] make ;
-CHLOE: if dup if-satisfied? [ process-tag-children ] [ drop ] if ;
+CHLOE: if dup if>quot [ swap when ] append process-children ;
CHLOE-SINGLETON: label
CHLOE-SINGLETON: link
CHLOE-TUPLE: checkbox
CHLOE-TUPLE: code
-: process-chloe-tag ( tag -- )
- dup main>> dup tags get at
- [ call ] [ "Unknown chloe tag: " prepend throw ] ?if ;
-
-: process-tag ( tag -- )
- {
- [ main>> >lower tag-stack get push ]
- [ write-start-tag ]
- [ process-tag-children ]
- [ write-end-tag ]
- [ drop tag-stack get pop* ]
- } cleave ;
-
-: expand-attrs ( tag -- tag )
- dup [ tag? ] [ xml? ] bi or [
- clone [
- [ "@" ?head [ value present ] when ] assoc-map
- ] change-attrs
- ] when ;
-
-: process-template ( xml -- )
- expand-attrs
- {
- { [ dup chloe-tag? ] [ process-chloe-tag ] }
- { [ dup [ tag? ] [ xml? ] bi or ] [ process-tag ] }
- { [ t ] [ write-item ] }
- } cond ;
-
-: process-chloe ( xml -- )
- [
- V{ } clone tag-stack set
-
- nested-template? get [
- process-template
- ] [
- {
- [ prolog>> write-prolog ]
- [ before>> write-chunk ]
- [ process-template ]
- [ after>> write-chunk ]
- } cleave
- ] if
- ] with-scope ;
+MEMO: template-quot ( chloe -- quot )
+ path>> ".xml" append utf8 <file-reader> read-xml
+ compile-template ;
+
+: reset-templates ( -- ) \ template-quot reset-memoized ;
M: chloe call-template*
- path>> ".xml" append utf8 <file-reader> read-xml process-chloe ;
+ template-quot call ;
INSTANCE: chloe template
--- /dev/null
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs namespaces kernel sequences accessors combinators
+strings splitting io io.streams.string xml.writer xml.data
+xml.entities html.forms html.templates.chloe.syntax ;
+IN: html.templates.chloe.compiler
+
+: chloe-attrs-only ( assoc -- assoc' )
+ [ drop url>> chloe-ns = ] assoc-filter ;
+
+: non-chloe-attrs-only ( assoc -- assoc' )
+ [ drop url>> chloe-ns = not ] assoc-filter ;
+
+: chloe-tag? ( tag -- ? )
+ dup xml? [ body>> ] when
+ {
+ { [ dup tag? not ] [ f ] }
+ { [ dup url>> chloe-ns = not ] [ f ] }
+ [ t ]
+ } cond nip ;
+
+SYMBOL: string-buffer
+
+SYMBOL: tag-stack
+
+DEFER: compile-element
+
+: compile-children ( tag -- )
+ [ compile-element ] each ;
+
+: [write] ( string -- ) string-buffer get push-all ;
+
+: reset-buffer ( -- )
+ string-buffer get [
+ [ >string , \ write , ] [ delete-all ] bi
+ ] unless-empty ;
+
+: [code] ( quot -- )
+ reset-buffer % ;
+
+: [code-with] ( obj quot -- )
+ reset-buffer [ , ] [ % ] bi* ;
+
+: expand-attr ( value -- )
+ [ value write ] [code-with] ;
+
+: compile-attr ( value -- )
+ reset-buffer "@" ?head [ , \ value ] when , ;
+
+: compile-attrs ( assoc -- )
+ [
+ " " [write]
+ swap name>string [write]
+ "=\"" [write]
+ "@" ?head [ expand-attr ] [ escape-quoted-string [write] ] if
+ "\"" [write]
+ ] assoc-each ;
+
+: compile-start-tag ( tag -- )
+ "<" [write]
+ [ name>string [write] ] [ compile-attrs ] bi
+ ">" [write] ;
+
+: compile-end-tag ( tag -- )
+ "</" [write]
+ name>string [write]
+ ">" [write] ;
+
+: compile-tag ( tag -- )
+ {
+ [ main>> tag-stack get push ]
+ [ compile-start-tag ]
+ [ compile-children ]
+ [ compile-end-tag ]
+ [ drop tag-stack get pop* ]
+ } cleave ;
+
+: compile-chloe-tag ( tag -- )
+ ! "Unknown chloe tag: " prepend throw
+ dup main>> dup tags get at
+ [ curry assert-depth ] [ 2drop ] ?if ;
+
+: compile-element ( element -- )
+ {
+ { [ dup chloe-tag? ] [ compile-chloe-tag ] }
+ { [ dup [ tag? ] [ xml? ] bi or ] [ compile-tag ] }
+ { [ dup string? ] [ escape-string [write] ] }
+ { [ dup comment? ] [ drop ] }
+ [ [ write-item ] [code-with] ]
+ } cond ;
+
+: with-compiler ( quot -- quot' )
+ [
+ SBUF" " string-buffer set
+ V{ } clone tag-stack set
+ call
+ reset-buffer
+ ] [ ] make ; inline
+
+: compile-nested-template ( xml -- quot )
+ [ compile-element ] with-compiler ;
+
+: compile-chunk ( seq -- )
+ [ compile-element ] each ;
+
+: process-children ( tag quot -- )
+ reset-buffer
+ [
+ [
+ SBUF" " string-buffer set
+ compile-children
+ reset-buffer
+ ] [ ] make ,
+ ] [ % ] bi* ;
+
+: compile-children>string ( tag -- )
+ [ with-string-writer ] process-children ;
+
+: compile-template ( xml -- quot )
+ [
+ {
+ [ prolog>> [ write-prolog ] [code-with] ]
+ [ before>> compile-chunk ]
+ [ compile-element ]
+ [ after>> compile-chunk ]
+ } cleave
+ ] with-compiler ;
--- /dev/null
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs sequences kernel parser fry quotations
+classes.tuple
+html.components
+html.templates.chloe.compiler
+html.templates.chloe.syntax ;
+IN: html.templates.chloe.components
+
+: singleton-component-tag ( tag class -- )
+ [ "name" required-attr compile-attr ]
+ [ literalize [ render ] [code-with] ]
+ bi* ;
+
+: CHLOE-SINGLETON:
+ scan-word
+ [ name>> ] [ '[ , singleton-component-tag ] ] bi
+ define-chloe-tag ;
+ parsing
+
+: compile-component-attrs ( tag class -- )
+ [ attrs>> [ drop main>> "name" = not ] assoc-filter ] dip
+ [ all-slots swap '[ name>> , at compile-attr ] each ]
+ [ [ boa ] [code-with] ]
+ bi ;
+
+: tuple-component-tag ( tag class -- )
+ [ drop "name" required-attr compile-attr ] [ compile-component-attrs ] 2bi
+ [ render ] [code] ;
+
+: CHLOE-TUPLE:
+ scan-word
+ [ name>> ] [ '[ , tuple-component-tag ] ] bi
+ define-chloe-tag ;
+ parsing
: chloe-ns "http://factorcode.org/chloe/1.0" ; inline
-MEMO: chloe-name ( string -- name )
+: chloe-name ( string -- name )
name new
swap >>main
chloe-ns >>url ;
: optional-attr ( tag name -- value )
chloe-name swap at ;
-
-: singleton-component-tag ( tag class -- )
- [ "name" required-attr ] dip render ;
-
-: CHLOE-SINGLETON:
- scan-word
- [ name>> ] [ '[ , singleton-component-tag ] ] bi
- define-chloe-tag ;
- parsing
-
-: attrs>slots ( tag tuple -- )
- [ attrs>> ] [ <mirror> ] bi*
- '[
- swap main>> dup "name" =
- [ 2drop ] [ , set-at ] if
- ] assoc-each ;
-
-: tuple-component-tag ( tag class -- )
- [ drop "name" required-attr ]
- [ new [ attrs>slots ] keep ]
- 2bi render ;
-
-: CHLOE-TUPLE:
- scan-word
- [ name>> ] [ '[ , tuple-component-tag ] ] bi
- define-chloe-tag ;
- parsing
[ [ empty? ] [ string? ] bi and not ] filter\r
] when ;\r
\r
+: name>string ( name -- string )\r
+ [ main>> ] [ space>> ] bi [ ":" swap 3append ] unless-empty ;\r
+\r
: print-name ( name -- )\r
- dup space>> f like\r
- [ write CHAR: : write1 ] when*\r
- main>> write ;\r
+ name>string write ;\r
\r
: print-attrs ( assoc -- )\r
[\r
projects / factor.git / commitdiff