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

Refactored prev/next buttons code

db4
nicolas-p 2015-08-07 00:05:48 +02:00 committed by John Benediktsson
parent 706fe6eb4e
commit 1817a4b8cb
2 changed files with 18 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
basis/help/help.factor
View File

@ -98,21 +98,21 @@ M: word set-article-parent swap "help-parent" set-word-prop ;
: ($title) ( topic -- )
[ [ article-title ] [ >link ] bi write-object ] ($block) ;
: $navigation-row-prev ( content element -- )
prefix 1array "<" prefix , ;
CONSTANT: prev -1
CONSTANT: next 1
: $navigation-row-next ( content element -- )
prefix 1array ">" suffix , ;
: 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-prev) ( topic -- )
[ prev-article [ 1array \ $long-link $navigation-row-prev ] when* ]
{ } make [ ($navigation-table) ] unless-empty ;
: ($navigation-next) ( topic -- )
[ next-article [ 1array \ $long-link $navigation-row-next ] when* ]
:: ($navigation) ( topic direction -- )
topic [ direction prev/next-article
[ 1array \ $long-link direction $navigation-row ] when* ]
{ } make [ ($navigation-table) ] unless-empty ;
: ($navigation-path) ( topic -- )
@ -127,14 +127,9 @@ 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 ]
:: $navigation ( topic direction -- )
topic title-style get
[ help-path-style get [ direction ($navigation) ] with-style ]
with-style ;
: print-topic ( topic -- )

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

@ -3,7 +3,7 @@
USING: accessors arrays classes colors colors.constants combinators
combinators.short-circuit compiler.units debugger fry help
help.apropos help.crossref help.home help.stylesheet help.topics
kernel models sequences sets ui ui.commands ui.gadgets
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
@ -42,20 +42,15 @@ 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>
{ 0 0 } <border> { 1/2 1/2 } >>align
toolbar-background <solid> >>interior ;
: <help-footer-next> ( browser-gadget -- gadget )
model>> [ '[ _ $navigation-next ] try ] <pane-control>
: <help-footer> ( browser-gadget direction -- gadget )
[ model>> ] dip [ '[ _ _ $navigation ] try ] <pane-control>
{ 0 0 } <border> { 1/2 1/2 } >>align
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
dupd swap prev <help-footer> 1 track-add
dupd swap next <help-footer> 1 track-add
f track-add ;
: <help-pane> ( browser-gadget -- gadget )