simplify html tag code

cvs
Slava Pestov 2006-01-31 07:32:28 +00:00
parent c072fa7089
commit dc9657d8f5
2 changed files with 16 additions and 31 deletions

View File

@ -1,8 +1,8 @@
- examples/canvas: free display lists
- fix remaining HTML stream issues
- help cross-referencing
- UI browser pane needs 'back' button
- runtime primitives like fopen: check for null input
- amd64 alien calls
- port ffi to win64
- intrinsic char-slot set-char-slot for x86
- fix up the min thumb size hack

View File

@ -73,21 +73,9 @@ USE: sequences
! <input "text" =type "name" =name "20" =size input/>
SYMBOL: html
SYMBOL: attrs
: write-html H{ { html t } } format ;
: attrs>string ( alist -- string )
#! Convert the attrs alist to a string
#! suitable for embedding in an html tag.
[ [ " " % dup car % "='" % cdr % "'" % ] each ] "" make ;
: write-attributes ( n: namespace -- )
#! With the attribute namespace on the stack, get the attributes
#! and write them to standard output. If no attributes exist, write
#! nothing.
attrs get attrs>string write-html ;
: html-word ( name def -- )
#! Define 'word creating' word to allow
#! dynamically creating words.
@ -95,32 +83,25 @@ SYMBOL: attrs
: <foo> "<" swap ">" append3 ;
: do-<foo> <foo> write-html ;
: def-for-html-word-<foo> ( name -- )
#! Return the name and code for the <foo> patterned
#! word.
dup <foo> swap [ do-<foo> ] cons html-word define-open ;
dup <foo> swap [ <foo> write-html ] cons html-word
define-open ;
: <foo "<" swap append ;
: do-<foo write-html H{ } clone >n V{ } clone attrs set ;
: def-for-html-word-<foo ( name -- )
#! Return the name and code for the <foo patterned
#! word.
<foo dup [ do-<foo ] cons html-word drop ;
<foo dup [ write-html ] cons html-word drop ;
: foo> ">" append ;
: do-foo> write-attributes n> drop ">" write-html ;
: do-foo/> write-attributes n> drop "/>" write-html ;
: def-for-html-word-foo> ( name -- )
#! Return the name and code for the foo> patterned
#! word.
foo> [ do-foo> ] html-word define-open ;
foo> [ ">" write-html ] html-word define-open ;
: </foo> [ "</" % % ">" % ] "" make ;
@ -131,19 +112,17 @@ SYMBOL: attrs
: <foo/> [ "<" % % "/>" % ] "" make ;
: do-<foo/> <foo/> write-html ;
: def-for-html-word-<foo/> ( name -- )
#! Return the name and code for the <foo/> patterned
#! word.
dup <foo/> swap [ do-<foo/> ] cons html-word drop ;
dup <foo/> swap [ <foo/> write-html ] cons html-word drop ;
: foo/> "/>" append ;
: def-for-html-word-foo/> ( name -- )
#! Return the name and code for the foo/> patterned
#! word.
foo/> [ do-foo/> ] html-word define-close ;
foo/> [ "/>" write-html ] html-word define-close ;
: define-closed-html-word ( name -- )
#! Given an HTML tag name, define the words for
@ -160,10 +139,16 @@ SYMBOL: attrs
dup def-for-html-word-<foo
def-for-html-word-foo/> ;
: write-attr ( value name -- )
" " write-html
write-html
"='" write-html
write
"'" write-html ;
: define-attribute-word ( name -- )
dup "=" swap append swap [
, [ swons attrs get push ] %
] [ ] make html-word drop ;
dup "=" swap append swap
[ , [ write-attr ] % ] [ ] make html-word drop ;
! Define some closed HTML tags
[