: ($title) ( topic -- )
[ [ article-title ] [ >link ] bi write-object ] ($block) ;
-
-CONSTANT: prev -1
-CONSTANT: next 1
-
-: add-navigation-arrow ( str direction -- str )
- prev = [ "<" prefix ] [ ">" suffix ] if ;
-
-: $navigation-row ( content element direction -- )
- [ prefix 1array ] dip add-navigation-arrow , ;
: ($navigation-table) ( element -- )
help-path-style get table-style [ $table ] with-variable ;
-:: ($navigation) ( topic direction -- )
- topic [ direction prev/next-article
- [ 1array \ $long-link direction $navigation-row ] when* ]
- { } make [ ($navigation-table) ] unless-empty ;
-
: ($navigation-path) ( topic -- )
- help-path-style get
- [ help-path [ reverse $breadcrumbs ] unless-empty ]
- with-style ;
+ help-path-style get [
+ help-path [ reverse $breadcrumbs ] unless-empty
+ ] with-style ;
+
+: ($navigation-link) ( content element label -- )
+ [ prefix 1array ] dip prefix , ;
+
+: ($navigation-links) ( topic -- )
+ [
+ [ prev-article [ 1array \ $long-link "Prev:" ($navigation-link) ] when* ]
+ [ next-article [ 1array \ $long-link "Next:" ($navigation-link) ] when* ]
+ bi
+ ] { } make [ ($navigation-table) ] unless-empty ;
: $title ( topic -- )
title-style get [
title-style get [
- [ ($title) ] [ ($navigation-path) ] bi
+ [ ($title) ]
+ [ ($navigation-path) ]
+ [ ($navigation-links) ] tri
] with-nesting
] with-style ;
-:: $navigation ( topic direction -- )
- topic title-style get
- [ help-path-style get [ direction ($navigation) ] with-style ]
- with-style ;
-
: print-topic ( topic -- )
>link
last-element off
- article-content print-content ;
+ [ $title ($blank-line) ]
+ [ article-content print-content nl ] bi ;
SYMBOL: help-hook
</div>
XML] ;
-: $navigation-row ( content element label -- )
- [ prefix 1array ] dip prefix , ;
-
-: ($navigation-links) ( topic -- )
- help-path-style get [
- [
- [ prev-article [ 1array \ $long-link "Prev:" $navigation-row ] when* ]
- [ next-article [ 1array \ $long-link "Next:" $navigation-row ] when* ]
- bi
- ] { } make [ ($navigation-table) ] unless-empty
- ] with-style ;
-
-: $title ( topic -- )
- title-style get
- { { page-color COLOR: FactorLightTan } } assoc-union dup
- [
- [
- [ ($title) ]
- [ ($navigation-path) ]
- [ ($navigation-links) ] tri
- ] with-nesting
- ] with-style ;
-
: help>html ( topic -- xml )
[ article-title " - Factor Documentation" append ]
[ drop help-stylesheet ]
[
[ help-navbar ]
- [ [ [ $title ($blank-line) ] [ print-topic ] bi ] with-html-writer ]
+ [ [ print-topic ] with-html-writer ]
bi* append
] tri
simple-page ;
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays classes colors colors.constants combinators
+USING: accessors arrays classes combinators
combinators.short-circuit compiler.units debugger fry help
-help.apropos help.crossref help.home help.stylesheet help.topics
-kernel locals models sequences sets ui ui.commands ui.gadgets
-ui.gadgets.borders ui.gadgets.buttons ui.gadgets.editors
-ui.gadgets.glass ui.gadgets.labels ui.gadgets.panes
-ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.toolbar
-ui.gadgets.packs ui.gadgets.theme ui.gadgets.viewports ui.gadgets.worlds ui.gestures
+help.apropos help.crossref help.home help.markup help.stylesheet
+help.topics io.styles kernel locals make models namespaces
+sequences sets ui ui.commands ui.gadgets ui.gadgets.borders
+ui.gadgets.editors ui.gadgets.glass ui.gadgets.labels
+ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.status-bar
+ui.gadgets.theme ui.gadgets.toolbar ui.gadgets.tracks
+ui.gadgets.viewports ui.gadgets.worlds ui.gestures ui.pens.solid
ui.tools.browser.history ui.tools.browser.popups ui.tools.common
-ui.pens.solid vocabs ;
+vocabs ;
IN: ui.tools.browser
TUPLE: browser-gadget < tool history scroller search-field popup ;
[ set-control-value ]
2bi ;
+CONSTANT: prev -1
+CONSTANT: next 1
+
+: add-navigation-arrow ( str direction -- str )
+ prev = [ "<" prefix ] [ ">" suffix ] if ;
+
+: $navigation-arrow ( content element direction -- )
+ [ prefix 1array ] dip add-navigation-arrow , ;
+
+:: ($navigation) ( topic direction -- )
+ topic [
+ direction prev/next-article
+ [ 1array \ $long-link direction $navigation-arrow ] when*
+ ] { } make [ ($navigation-table) ] unless-empty ;
+
+: $navigation ( topic direction -- )
+ title-style get [
+ help-path-style get [
+ ($navigation)
+ ] with-style
+ ] with-style ;
+
+: $title ( topic -- )
+ title-style get [
+ title-style get [
+ [ ($title) ]
+ [ ($navigation-path) ] bi
+ ] with-nesting
+ ] with-style ;
+
: <help-header> ( browser-gadget -- gadget )
model>> [ '[ _ $title ] try ] <pane-control> ;
dupd swap next <help-footer> 1 track-add
f track-add ;
+: print-topic ( topic -- )
+ >link
+ last-element off
+ article-content print-content ;
+
: <help-pane> ( browser-gadget -- gadget )
model>> [ '[ _ print-topic ] try ] <pane-control> ;