Fix HTML doc generation bugs

db4
Slava Pestov 2008-09-29 19:43:59 -05:00
parent 2cf2dde83c
commit f9670ef366
2 changed files with 21 additions and 12 deletions

View File

@ -29,21 +29,28 @@ IN: help.html
GENERIC: topic>filename* ( topic -- name prefix ) GENERIC: topic>filename* ( topic -- name prefix )
M: word topic>filename* [ name>> ] [ vocabulary>> ] bi 2array "word" ; M: word topic>filename*
M: link topic>filename* name>> "article" ; dup vocabulary>> [
[ name>> ] [ vocabulary>> ] bi 2array "word"
] [ drop f f ] if ;
M: link topic>filename* name>> dup [ "article" ] [ topic>filename* ] if ;
M: word-link topic>filename* name>> topic>filename* ; M: word-link topic>filename* name>> topic>filename* ;
M: vocab-spec topic>filename* vocab-name "vocab" ; M: vocab-spec topic>filename* vocab-name "vocab" ;
M: vocab-tag topic>filename* name>> "tag" ; M: vocab-tag topic>filename* name>> "tag" ;
M: vocab-author topic>filename* name>> "author" ; M: vocab-author topic>filename* name>> "author" ;
M: f topic>filename* drop \ f topic>filename* ;
: topic>filename ( topic -- filename ) : topic>filename ( topic -- filename )
topic>filename* dup [
[ [
topic>filename* % "-" % % "-" %
dup array? dup array?
[ [ escape-filename ] map "," join ] [ [ escape-filename ] map "," join ]
[ escape-filename ] [ escape-filename ]
if % ".html" % if % ".html" %
] "" make ; ] "" make
] [ 2drop f ] if ;
M: topic browser-link-href topic>filename ; M: topic browser-link-href topic>filename ;

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 io.files continuations io.streams.string kernel math math.order
math.parser namespaces make quotations assocs sequences strings math.parser namespaces make quotations assocs sequences strings
words html.elements xml.entities sbufs continuations destructors words html.elements xml.entities sbufs continuations destructors
accessors arrays ; accessors arrays urls.encoding ;
IN: html.streams IN: html.streams
GENERIC: browser-link-href ( presented -- href ) GENERIC: browser-link-href ( presented -- href )
@ -44,12 +44,14 @@ TUPLE: html-sub-stream < html-stream style parent ;
: object-link-tag ( style quot -- ) : object-link-tag ( style quot -- )
presented pick at [ presented pick at [
browser-link-href [ browser-link-href [
<a =href a> call </a> <a url-encode =href a> call </a>
] [ call ] if* ] [ call ] if*
] [ call ] if* ; inline ] [ call ] if* ; inline
: href-link-tag ( style quot -- ) : href-link-tag ( style quot -- )
href pick at [ <a =href a> call </a> ] [ call ] if* ; inline href pick at [
<a url-encode =href a> call </a>
] [ call ] if* ; inline
: hex-color, ( color -- ) : hex-color, ( color -- )
[ red>> ] [ green>> ] [ blue>> ] tri [ red>> ] [ green>> ] [ blue>> ] tri