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

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

@ -3,7 +3,7 @@
USING: accessors arrays classes colors colors.constants combinators USING: accessors arrays classes colors colors.constants combinators
combinators.short-circuit compiler.units debugger fry help combinators.short-circuit compiler.units debugger fry help
help.apropos help.crossref help.home help.stylesheet help.topics 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.borders ui.gadgets.buttons ui.gadgets.editors
ui.gadgets.glass ui.gadgets.labels ui.gadgets.panes ui.gadgets.glass ui.gadgets.labels ui.gadgets.panes
ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.toolbar 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 help-header-background <solid> >>interior
{ 1 0 } >>fill f track-add ; { 1 0 } >>fill f track-add ;
: <help-footer-prev> ( browser-gadget -- gadget ) : <help-footer> ( browser-gadget direction -- gadget )
model>> [ '[ _ $navigation-prev ] try ] <pane-control> [ model>> ] dip [ '[ _ _ $navigation ] 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>
{ 0 0 } <border> { 1/2 1/2 } >>align { 0 0 } <border> { 1/2 1/2 } >>align
toolbar-background <solid> >>interior ; toolbar-background <solid> >>interior ;
: add-help-footer ( track -- track ) : add-help-footer ( track -- track )
horizontal <track> with-lines horizontal <track> with-lines
dupd swap <help-footer-prev> 1 track-add dupd swap prev <help-footer> 1 track-add
dupd swap <help-footer-next> 1 track-add dupd swap next <help-footer> 1 track-add
f track-add ; f track-add ;
: <help-pane> ( browser-gadget -- gadget ) : <help-pane> ( browser-gadget -- gadget )