steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'help' of git://github.com/klazuka/factor

db4
Slava Pestov 2009-10-09 04:03:16 -05:00
parent eb0a699d02 4743ffdc18
commit e51c24c417
3 changed files with 16 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/help/help.factor
View File

@ -120,12 +120,12 @@ M: word set-article-parent swap "help-parent" set-word-prop ;
title-style get [
[ ($title) ] [ ($navigation) ] bi
] with-nesting
] with-style nl ;
] with-style ;
: print-topic ( topic -- )
>link
last-element off
[ $title ] [ nl article-content print-content nl ] bi ;
[ $title ] [ ($blank-line) article-content print-content ] bi ;
SYMBOL: help-hook

6
basis/help/markup/markup.factor
View File

@ -26,6 +26,9 @@ SYMBOL: blank-line
last-blank-line? not
and [ nl ] when ;
: ($blank-line) ( -- )
nl nl blank-line last-element set ;
: ($span) ( quot -- )
last-block? [ nl ] when
span last-element set
@ -44,7 +47,6 @@ M: f print-element drop ;
: with-default-style ( quot -- )
default-span-style get [
last-element off
default-block-style get swap with-nesting
] with-style ; inline
@ -220,7 +222,7 @@ PRIVATE>
] ($subsection) ;
: $subsections ( children -- )
[ $subsection* ] each nl nl blank-line last-element set ;
[ $subsection* ] each ($blank-line) ;
: $subsection ( element -- )
first $subsection* ;

34
basis/html/streams/streams.factor
View File

@ -10,22 +10,10 @@ GENERIC: url-of ( object -- url )
M: object url-of drop f ;
TUPLE: html-writer data last-div ;
TUPLE: html-writer data ;
<PRIVATE
! stream-nl after with-nesting or tabular-output is
! ignored, so that HTML stream output looks like
! UI pane output
: last-div? ( stream -- ? )
[ f ] change-last-div drop ;
: not-a-div ( stream -- stream )
f >>last-div ; inline
: a-div ( stream -- stream )
t >>last-div ; inline
: new-html-writer ( class -- html-writer )
new V{ } clone >>data ; inline
@ -107,7 +95,7 @@ MACRO: make-css ( pairs -- str )
TUPLE: html-span-stream < html-sub-stream ;
M: html-span-stream dispose
end-sub-stream not-a-div format-html-span ;
end-sub-stream format-html-span ;
: border-css, ( border -- )
"border: 1px solid #" % hex-color, "; " % ;
@ -124,10 +112,8 @@ CONSTANT: pre-css "white-space: pre; font-family: monospace;"
{ border-color border-css, }
{ inset padding-css, }
} make-css
] [
wrap-margin swap at
[ pre-css append ] unless
] bi ;
] [ wrap-margin swap at [ pre-css append ] unless ] bi
"display: inline-block;" append ;
: div-tag ( xml style -- xml' )
div-css-style
@ -139,7 +125,7 @@ CONSTANT: pre-css "white-space: pre; font-family: monospace;"
TUPLE: html-block-stream < html-sub-stream ;
M: html-block-stream dispose ( quot style stream -- )
end-sub-stream a-div format-html-div ;
end-sub-stream format-html-div ;
: border-spacing-css, ( pair -- )
"padding: " % first2 max 2 /i # "px; " % ;
@ -157,16 +143,16 @@ PRIVATE>
M: html-writer stream-flush drop ;
M: html-writer stream-write1
not-a-div [ 1string ] emit-html ;
[ 1string ] emit-html ;
M: html-writer stream-write
not-a-div [ ] emit-html ;
[ ] emit-html ;
M: html-writer stream-format
format-html-span ;
M: html-writer stream-nl
dup last-div? [ drop ] [ [ [XML <br/> XML] ] emit-html ] if ;
[ [XML <br/> XML] ] emit-html ;
M: html-writer make-span-stream
html-span-stream new-html-sub-stream ;
@ -178,12 +164,12 @@ M: html-writer make-cell-stream
html-sub-stream new-html-sub-stream ;
M: html-writer stream-write-table
a-div [
[
table-style swap [
[ data>> [XML <td valign="top" style=<->><-></td> XML] ] with map
[XML <tr><-></tr> XML]
] with map
[XML <table><-></table> XML]
[XML <table style="display: inline-table;"><-></table> XML]
] emit-html ;
M: html-writer dispose drop ;