+
with-html-stream
] curry ;
@@ -175,7 +176,7 @@ M: html-stream with-stream-table ( grid quot style stream -- )
[
rot [
[
- |
+ |
pick pick stdio get with-nested-stream |
] each
] each 2drop
@@ -188,7 +189,7 @@ M: html-stream stream-terpri [
] with-stream* ;
"A:link { text-decoration: none; color: black; }" print
"A:visited { text-decoration: none; color: black; }" print
"A:active { text-decoration: none; color: black; }" print
- "A:hover, A:hover { text-decoration: none; color: black; }" print
+ "A:hover, A:hover { text-decoration: underline; color: black; }" print
;
: xhtml-preamble
diff --git a/library/collections/growable.facts b/library/collections/growable.facts
index e82482f4d1..0694628c70 100644
--- a/library/collections/growable.facts
+++ b/library/collections/growable.facts
@@ -4,7 +4,7 @@ USING: help kernel sequences ;
HELP: set-fill "( n seq -- )"
{ $values { "n" "a new fill pointer" } { "seq" "a growable sequence" } }
{ $contract "Sets the fill pointer (number of occupied elements in the underlying storage) of a growable sequence." }
-{ $side-effects "Modifies " { $snippet "seq" } "." }
+{ $side-effects "seq" }
{ $warning "This word is in the " { $snippet "sequences-internals" } " vocabulary because it is not safe. Changing the fill pointer to a negative value, or a value higher than the underlying sequence length can lead to memory corruption. User code should use " { $link set-length } " instead." } ;
HELP: underlying "( seq -- underlying )"
diff --git a/library/help/crossref.factor b/library/help/crossref.factor
index 3077107868..4ced901759 100644
--- a/library/help/crossref.factor
+++ b/library/help/crossref.factor
@@ -61,9 +61,11 @@ DEFER: $subsection
where dup empty? [
drop
] [
- where-style [
- [ "Parent topics: " write $links ] ($block)
- ] with-style
+ [
+ where-style [
+ "Parent topics: " write $links
+ ] with-style
+ ] ($block)
] if ;
: xref-article ( article -- )
diff --git a/library/help/help.factor b/library/help/help.factor
index 67658b2065..af3a58f09a 100644
--- a/library/help/help.factor
+++ b/library/help/help.factor
@@ -18,24 +18,19 @@ M: word article-content
] ?if
] { } make ;
-: with-default-style ( quot -- )
- default-style [
- H{ } [ last-block on call ] with-nesting
- ] with-style ; inline
+: $title ( article -- )
+ title-style [
+ title-style [
+ dup [ article-title write ] ($block) $where
+ ] with-nesting
+ ] with-style terpri ;
-: print-title ( article -- )
- [ dup article-title $title $where ] with-default-style
- terpri ;
+: (help) ( topic -- ) article-content print-content ;
-: print-content ( element -- )
- [ print-element ] with-default-style ;
-
-: (help) ( topic -- ) article-content print-content terpri ;
-
-: help ( topic -- ) dup print-title (help) ;
+: help ( topic -- ) dup $title (help) terpri ;
: see-help ( word -- )
- dup help [ $definition terpri ] with-default-style ;
+ dup help [ terpri $definition terpri ] with-default-style ;
: handbook ( -- ) "handbook" help ;
diff --git a/library/help/markup.factor b/library/help/markup.factor
index 7f6d0ce4d9..6fbbd3819b 100644
--- a/library/help/markup.factor
+++ b/library/help/markup.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-IN: help
USING: arrays generic hashtables inspector io kernel namespaces
parser prettyprint sequences strings styles vectors words ;
+IN: help
! Simple markup language.
@@ -12,45 +12,69 @@ parser prettyprint sequences strings styles vectors words ;
! Element types are words whose name begins with $.
+SYMBOL: last-element
+SYMBOL: span
+SYMBOL: block
+SYMBOL: table
+
+: last-span? last-element get span eq? ;
+: last-block? last-element get block eq? ;
+
+: ($span) ( quot -- )
+ last-block? [ terpri ] when
+ span last-element set
+ call ; inline
+
PREDICATE: array simple-element
dup empty? [ drop t ] [ first word? not ] if ;
M: simple-element print-element [ print-element ] each ;
-M: string print-element last-block off write ;
+M: string print-element [ write ] ($span) ;
M: array print-element unclip execute ;
M: word print-element { } swap execute ;
-: ($span) ( content style -- )
- last-block off [ print-element ] with-style ;
+: print-element* ( element style -- )
+ [ print-element ] with-style ;
-: ?terpri ( -- )
- last-block [ [ terpri ] unless t ] change ;
+: with-default-style ( quot -- )
+ default-style [
+ last-element off
+ H{ } swap with-nesting
+ ] with-style ; inline
+
+: print-content ( element -- )
+ last-element off
+ [ print-element ] with-default-style ;
: ($block) ( quot -- )
- ?terpri
+ last-element get { f table } member? [ terpri ] unless
+ span last-element set
call
- terpri
- last-block on ; inline
+ block last-element set ; inline
! Some spans
-: $snippet snippet-style ($span) ;
+: $snippet [ snippet-style print-element* ] ($span) ;
-: $emphasis emphasis-style ($span) ;
+: $emphasis [ emphasis-style print-element* ] ($span) ;
-: $url url-style ($span) ;
+: $url [ url-style print-element* ] ($span) ;
-: $terpri last-block off terpri terpri drop ;
+: $terpri terpri terpri drop ;
! Some blocks
-: $title [ title-style ($span) ] ($block) ;
+: ($heading)
+ last-element get [ terpri ] when ($block) ; inline
-: $heading [ heading-style ($span) ] ($block) ;
+: $heading
+ [ heading-style print-element* ] ($heading) ;
: ($code) ( presentation quot -- )
[
code-style [
- >r presented associate r> with-nesting
+ last-element off
+ >r presented associate code-style hash-union r>
+ with-nesting
] with-style
] ($block) ; inline
@@ -82,9 +106,10 @@ M: word print-element { } swap execute ;
: $warning ( content -- )
[
warning-style [
+ last-element off
"Warning" $heading print-element
] with-nesting
- ] ($block) ;
+ ] ($heading) ;
! Some links
TUPLE: link name ;
@@ -102,23 +127,26 @@ M: link summary "Link: " swap link-name append ;
] with-style ;
: $link ( article -- )
- last-block off first link-style
- [ dup article-title swap >link write-object ] with-style ;
+ first link-style [
+ dup article-title swap >link write-object
+ ] with-style ;
: textual-list ( seq quot -- )
[ ", " print-element ] interleave ; inline
: $links ( content -- )
- [ 1array $link ] textual-list ;
+ [ [ 1array $link ] textual-list ] ($span) ;
: $see-also ( content -- )
"See also" $heading $links ;
: $table ( content -- )
- ?terpri table-style [
- H{ { table-padding 5 } { table-gap { 5 5 0 } } }
- [ print-element ] tabular-output
- ] with-style ;
+ [
+ table-style [
+ H{ { table-gap { 5 5 0 } } }
+ [ print-element ] tabular-output
+ ] with-style
+ ] ($block) table last-element set ;
: $values ( content -- )
"Arguments and values" $heading
@@ -144,11 +172,13 @@ M: link summary "Link: " swap link-name append ;
: $notes ( content -- )
"Notes" $heading print-element ;
-: $see ( content -- )
- code-style [ H{ } [ first see ] with-nesting ] with-style ;
+: ($see) ( word -- )
+ code-style [ code-style [ see ] with-nesting ] with-style ;
+
+: $see ( content -- ) first ($see) ;
: $definition ( content -- )
- "Definition" $heading $see ;
+ "Definition" $heading ($see) ;
: $curious ( content -- )
"For the curious..." $heading print-element ;
diff --git a/library/help/stylesheet.factor b/library/help/stylesheet.factor
index f3bc8f5653..5daedf2a7b 100644
--- a/library/help/stylesheet.factor
+++ b/library/help/stylesheet.factor
@@ -5,7 +5,7 @@ USING: styles ;
: default-style
H{
- { font "serif" }
+ { font "sans-serif" }
{ font-size 12 }
{ wrap-margin 500 }
} ;
@@ -18,20 +18,19 @@ USING: styles ;
: title-style
H{
- { font "serif" }
+ { font "sans-serif" }
{ font-size 16 }
{ font-style bold }
+ { wrap-margin 500 }
+ { page-color { 0.8 0.8 1 1 } }
+ { border-width 5 }
} ;
: where-style
- H{
- { font "serif" }
- { font-size 10 }
- } ;
+ H{ { font-size 10 } } ;
: heading-style
H{
- { font "serif" }
{ font-size 14 }
{ font-style bold }
{ foreground { 0.2 0.2 0.4 1 } }
@@ -39,7 +38,6 @@ USING: styles ;
: subsection-style
H{
- { font "serif" }
{ font-size 14 }
{ font-style bold }
} ;
@@ -56,7 +54,7 @@ USING: styles ;
: code-style
H{
{ font "monospace" }
- { page-color { 0.9 0.9 1 0.5 } }
+ { page-color { 0.8 0.8 0.8 0.5 } }
{ border-width 5 }
{ wrap-margin f }
} ;
diff --git a/library/help/topics.factor b/library/help/topics.factor
index a1c07aa1e7..5f35c0e422 100644
--- a/library/help/topics.factor
+++ b/library/help/topics.factor
@@ -25,5 +25,3 @@ M: string article-content article article-content ;
! Special case: f help
M: f article-title drop \ f article-title ;
M: f article-content drop \ f article-content ;
-
-SYMBOL: last-block
diff --git a/library/io/duplex-stream.factor b/library/io/duplex-stream.factor
index 382a5a112c..b7a55d3b12 100644
--- a/library/io/duplex-stream.factor
+++ b/library/io/duplex-stream.factor
@@ -46,6 +46,9 @@ M: duplex-stream stream-terpri
M: duplex-stream stream-format
duplex-stream-out+ stream-format ;
+M: duplex-stream with-stream-style
+ duplex-stream-out+ with-stream-style ;
+
M: duplex-stream with-nested-stream
duplex-stream-out+ with-nested-stream ;
diff --git a/library/io/nested-style.factor b/library/io/nested-style.factor
index 4fcb47bf3e..9bb0416715 100644
--- a/library/io/nested-style.factor
+++ b/library/io/nested-style.factor
@@ -5,18 +5,14 @@ USING: arrays generic hashtables kernel namespaces strings ;
TUPLE: nested-style-stream style ;
-: with-style ( style quot -- )
- >r stdio get
r> with-stream* ; inline
+: (with-stream-style) ( quot style stream -- )
+ swap with-stream* ; inline
: do-nested-style ( style stream -- style delegate )
[ nested-style-stream-style swap hash-union ] keep
delegate ;
-: collapse-nested-style ( style delegate -- style delegate )
- dup nested-style-stream? [ do-nested-style ] when ;
-
C: nested-style-stream ( style delegate -- stream )
- >r collapse-nested-style r>
[ set-delegate ] keep
[ set-nested-style-stream-style ] keep ;
@@ -35,6 +31,9 @@ M: nested-style-stream stream-write1
3array >quotation
r> r> do-nested-style ;
+M: nested-style-stream with-stream-style ( quot style stream -- )
+ do-nested-style with-stream-style ;
+
M: nested-style-stream with-nested-stream
do-nested-quot with-nested-stream ;
diff --git a/library/io/plain-stream.factor b/library/io/plain-stream.factor
index bde7f0ba5d..19f100b021 100644
--- a/library/io/plain-stream.factor
+++ b/library/io/plain-stream.factor
@@ -16,3 +16,6 @@ M: plain-writer stream-format ( string style stream -- )
M: plain-writer with-nested-stream ( quot style stream -- )
nip swap with-stream* ;
+
+M: plain-writer with-stream-style ( quot style stream -- )
+ (with-stream-style) ;
diff --git a/library/io/stdio.factor b/library/io/stdio.factor
index d1dd528917..18091b975a 100644
--- a/library/io/stdio.factor
+++ b/library/io/stdio.factor
@@ -26,6 +26,9 @@ SYMBOL: stdio
: tabular-output ( grid style quot -- )
swap stdio get with-stream-table ;
+: with-style ( style quot -- )
+ swap stdio get with-stream-style ;
+
: print ( string -- ) stdio get stream-print ;
: with-stream* ( stream quot -- )
diff --git a/library/io/stream.factor b/library/io/stream.factor
index b45b29cb99..d209176278 100644
--- a/library/io/stream.factor
+++ b/library/io/stream.factor
@@ -16,6 +16,7 @@ GENERIC: stream-terpri ( stream -- )
GENERIC: stream-format ( string style stream -- )
GENERIC: with-nested-stream ( quot style stream -- )
GENERIC: with-stream-table ( grid quot style stream -- )
+GENERIC: with-stream-style ( quot style stream -- )
: stream-print ( string stream -- )
[ stream-write ] keep stream-terpri ;
diff --git a/library/io/styles.factor b/library/io/styles.factor
index fab9c33e5f..d5c2fb561a 100644
--- a/library/io/styles.factor
+++ b/library/io/styles.factor
@@ -27,7 +27,6 @@ SYMBOL: outline
! Table styles
SYMBOL: table-gap
-SYMBOL: table-padding
! Input history
TUPLE: input string ;
diff --git a/library/ui/gadgets/panes.factor b/library/ui/gadgets/panes.factor
index fef52c6124..47973d12b8 100644
--- a/library/ui/gadgets/panes.factor
+++ b/library/ui/gadgets/panes.factor
@@ -130,6 +130,9 @@ M: pane stream-format ( string style pane -- )
M: pane stream-close ( pane -- ) drop ;
+M: pane with-stream-style ( quot style pane -- )
+ (with-stream-style) ;
+
: ?terpri
dup pane-current gadget-children empty?
[ dup stream-terpri ] unless drop ;
diff --git a/library/ui/gadgets/presentations.factor b/library/ui/gadgets/presentations.factor
index 0f6b03d47c..799397cdc3 100644
--- a/library/ui/gadgets/presentations.factor
+++ b/library/ui/gadgets/presentations.factor
@@ -91,8 +91,7 @@ M: object-button gadget-help ( button -- string )
: styled-grid ( style grid -- )
- table-gap pick hash [ { 0 0 0 } ] unless* over set-grid-gap
- table-padding rot hash [ 0 ] unless* ;
+ table-gap rot hash [ { 0 0 0 } ] unless* over set-grid-gap ;
: ( quot style grid -- gadget )
[