help: make the default print prev/next links but then modify ui.tools.browser to do what it used to do.

db4
John Benediktsson 2015-08-16 11:32:54 -07:00
parent 92762cb56b
commit 81cbf71d27
3 changed files with 63 additions and 56 deletions

View File

@ -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

View File

@ -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 ;

View File

@ -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> ;