help: make the default print prev/next links but then modify ui.tools.browser to do what it used to do.
parent
92762cb56b
commit
81cbf71d27
|
@ -97,45 +97,39 @@ M: word set-article-parent swap "help-parent" set-word-prop ;
|
|||
|
||||
: ($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
|
||||
|
||||
|
|
|
@ -85,35 +85,12 @@ M: pathname url-of
|
|||
</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 ;
|
||||
|
|
|
@ -1,15 +1,16 @@
|
|||
! 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 ;
|
||||
|
@ -34,6 +35,36 @@ M: browser-gadget set-history-value
|
|||
[ 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> ;
|
||||
|
||||
|
@ -53,6 +84,11 @@ M: browser-gadget set-history-value
|
|||
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> ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue