steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
basis/help/help.factor
View File

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

17
basis/ui/tools/browser/browser.factor
View File

@ -42,6 +42,20 @@ M: browser-gadget set-history-value
help-header-background <solid> >>interior
{ 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 )
model>> [ '[ _ print-topic ] try ] <pane-control> ;
@ -77,7 +91,8 @@ M: browser-gadget set-history-value
dup <search-field> >>search-field
add-browser-toolbar
add-help-header
add-help-pane ;
add-help-pane
add-help-footer ;
M: browser-gadget graft*
[ add-definition-observer ] [ call-next-method ] bi ;