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 )
M: word topic>filename* [ name>> ] [ vocabulary>> ] bi 2array "word" ;
M: link topic>filename* name>> "article" ;
M: word topic>filename*
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: vocab-spec topic>filename* vocab-name "vocab" ;
M: vocab-tag topic>filename* name>> "tag" ;
M: vocab-author topic>filename* name>> "author" ;
M: f topic>filename* drop \ f topic>filename* ;
: topic>filename ( topic -- filename )
topic>filename* dup [
[
topic>filename* % "-" %
% "-" %
dup array?
[ [ escape-filename ] map "," join ]
[ escape-filename ]
if % ".html" %
] "" make ;
] "" make
] [ 2drop f ] if ;
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
math.parser namespaces make quotations assocs sequences strings
words html.elements xml.entities sbufs continuations destructors
accessors arrays ;
accessors arrays urls.encoding ;
IN: html.streams
GENERIC: browser-link-href ( presented -- href )
@ -44,12 +44,14 @@ TUPLE: html-sub-stream < html-stream style parent ;
: object-link-tag ( style quot -- )
presented pick at [
browser-link-href [
<a =href a> call </a>
<a url-encode =href a> call </a>
] [ call ] if*
] [ call ] if* ; inline
: 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 -- )
[ red>> ] [ green>> ] [ blue>> ] tri