Prev/next buttons in Browser

db4
nicolas-p 2015-07-24 17:54:30 +02:00 committed by John Benediktsson
parent c8b63fa4b0
commit 0bdeb0c60f
2 changed files with 34 additions and 15 deletions

View File

@ -104,23 +104,19 @@ M: word set-article-parent swap "help-parent" set-word-prop ;
: ($navigation-table) ( element -- ) : ($navigation-table) ( element -- )
help-path-style get table-style [ $table ] with-variable ; help-path-style get table-style [ $table ] with-variable ;
: $navigation-table ( topic -- ) : ($navigation-prev) ( topic -- )
[ [ prev-article [ 1array \ $long-link "" $navigation-row ] when* ]
[ prev-article [ 1array \ $long-link "Prev:" $navigation-row ] when* ] { } make [ ($navigation-table) ] unless-empty ;
[ next-article [ 1array \ $long-link "Next:" $navigation-row ] when* ]
bi : ($navigation-next) ( topic -- )
] { } make [ ($navigation-table) ] unless-empty ; [ next-article [ 1array \ $long-link "" $navigation-row ] when* ]
{ } make [ ($navigation-table) ] unless-empty ;
: ($navigation-path) ( topic -- ) : ($navigation-path) ( topic -- )
help-path-style get help-path-style get
[ help-path [ reverse $breadcrumbs ] unless-empty ] [ help-path [ reverse $breadcrumbs ] unless-empty ]
with-style ; with-style ;
: ($navigation-prev-next) ( topic -- )
help-path-style get
[ $navigation-table ]
with-style ;
: $title ( topic -- ) : $title ( topic -- )
title-style get [ title-style get [
title-style get [ title-style get [
@ -128,12 +124,20 @@ M: word set-article-parent swap "help-parent" set-word-prop ;
] with-nesting ] with-nesting
] with-style ; ] with-style ;
: $navigation-prev ( topic -- )
title-style get
[ help-path-style get [ ($navigation-prev) ] with-style ]
with-style ;
: $navigation-next ( topic -- )
title-style get
[ help-path-style get [ ($navigation-next) ] with-style ]
with-style ;
: print-topic ( topic -- ) : print-topic ( topic -- )
>link >link
last-element off last-element off
[ article-content print-content nl ] article-content print-content ;
[ ($blank-line) ($navigation-prev-next) ]
bi ;
SYMBOL: help-hook SYMBOL: help-hook

View File

@ -42,6 +42,20 @@ M: browser-gadget set-history-value
help-header-background <solid> >>interior help-header-background <solid> >>interior
{ 1 0 } >>fill f track-add ; { 1 0 } >>fill f track-add ;
: <help-footer-prev> ( browser-gadget -- gadget )
model>> [ '[ _ $navigation-prev ] try ] <pane-control>
toolbar-background <solid> >>interior ;
: <help-footer-next> ( browser-gadget -- gadget )
model>> [ '[ _ $navigation-next ] try ] <pane-control>
toolbar-background <solid> >>interior ;
: add-help-footer ( track -- track )
horizontal <track> with-lines
dupd swap <help-footer-prev> 1 track-add
dupd swap <help-footer-next> 1 track-add
f track-add ;
: <help-pane> ( browser-gadget -- gadget ) : <help-pane> ( browser-gadget -- gadget )
model>> [ '[ _ print-topic ] try ] <pane-control> ; model>> [ '[ _ print-topic ] try ] <pane-control> ;
@ -77,7 +91,8 @@ M: browser-gadget set-history-value
dup <search-field> >>search-field dup <search-field> >>search-field
add-browser-toolbar add-browser-toolbar
add-help-header add-help-header
add-help-pane ; add-help-pane
add-help-footer ;
M: browser-gadget graft* M: browser-gadget graft*
[ add-definition-observer ] [ call-next-method ] bi ; [ add-definition-observer ] [ call-next-method ] bi ;