Merge branch 'help' of git://github.com/klazuka/factor
commit
e51c24c417
|
@ -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
|
||||
|
||||
|
|
|
@ -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* ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue