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

Browser tool now saves scroll bar position in history

db4
Slava Pestov 2009-04-05 23:19:35 -05:00
parent 78013c2bdf
commit 88bbb47bfa
4 changed files with 95 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,23 +1,33 @@
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: debugger help help.topics help.crossref help.home kernel
models compiler.units assocs words vocabs accessors fry
combinators.short-circuit namespaces sequences models
models.history help.apropos combinators ui.commands ui.gadgets
ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks
ui.gestures ui.gadgets.buttons ui.gadgets.packs
ui.gadgets.editors ui.gadgets.labels ui.gadgets.status-bar
ui.gadgets.glass ui.gadgets.borders ui.tools.common
ui.tools.browser.popups ui ;
USING: debugger help help.topics help.crossref help.home kernel models
compiler.units assocs words vocabs accessors fry arrays
combinators.short-circuit namespaces sequences models help.apropos
combinators ui ui.commands ui.gadgets ui.gadgets.panes
ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.gadgets.buttons
ui.gadgets.packs ui.gadgets.editors ui.gadgets.labels
ui.gadgets.status-bar ui.gadgets.glass ui.gadgets.borders ui.gadgets.viewports
ui.tools.common ui.tools.browser.popups ui.tools.browser.history ;
IN: ui.tools.browser
TUPLE: browser-gadget < tool pane scroller search-field popup ;
TUPLE: browser-gadget < tool history pane scroller search-field popup ;
{ 650 400 } browser-gadget set-tool-dim
M: browser-gadget history-value
[ control-value ] [ scroller>> scroll-position ]
bi 2array ;
M: browser-gadget set-history-value
[ first2 ] dip
[ set-control-value ] [ scroller>> set-scroll-position ]
bi-curry bi* ;
: show-help ( link browser-gadget -- )
[ >link ] [ model>> ] bi*
[ [ add-recent ] [ add-history ] bi* ] [ set-model ] 2bi ;
[ >link ] dip
[ [ add-recent ] [ history>> add-history ] bi* ]
[ model>> set-model ]
2bi ;
: <help-pane> ( browser-gadget -- gadget )
model>> [ '[ _ print-topic ] try ] <pane-control> ;
@ -41,7 +51,8 @@ TUPLE: browser-gadget < tool pane scroller search-field popup ;
: <browser-gadget> ( link -- gadget )
vertical browser-gadget new-track
1 >>fill
swap >link <history> >>model
swap >link <model> >>model
dup <history> >>history
dup <search-field> >>search-field
dup <browser-toolbar> { 3 3 } <border> { 1 0 } >>fill f track-add
dup <help-pane> >>pane
@ -93,9 +104,9 @@ M: browser-gadget focusable-child* search-field>> ;
\ show-browser H{ { +nullary+ t } } define-command
: com-back ( browser -- ) model>> go-back ;
: com-back ( browser -- ) history>> go-back ;
: com-forward ( browser -- ) model>> go-forward ;
: com-forward ( browser -- ) history>> go-forward ;
: com-home ( browser -- ) "help.home" swap show-help ;

1
basis/ui/tools/browser/history/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

36
basis/ui/tools/browser/history/history-tests.factor Normal file
View File

@ -0,0 +1,36 @@
USING: namespaces ui.tools.browser.history sequences tools.test ;
IN: ui.tools.browser.history.tests
f <history> "history" set
"history" get add-history
[ t ] [ "history" get back>> empty? ] unit-test
[ t ] [ "history" get forward>> empty? ] unit-test
"history" get add-history
"history" get 3 >>value drop
[ t ] [ "history" get back>> empty? ] unit-test
[ t ] [ "history" get forward>> empty? ] unit-test
"history" get add-history
"history" get 4 >>value drop
[ f ] [ "history" get back>> empty? ] unit-test
[ t ] [ "history" get forward>> empty? ] unit-test
"history" get go-back
[ 3 ] [ "history" get value>> ] unit-test
[ t ] [ "history" get back>> empty? ] unit-test
[ f ] [ "history" get forward>> empty? ] unit-test
"history" get go-forward
[ 4 ] [ "history" get value>> ] unit-test
[ f ] [ "history" get back>> empty? ] unit-test
[ t ] [ "history" get forward>> empty? ] unit-test

32
basis/ui/tools/browser/history/history.factor Normal file
View File

@ -0,0 +1,32 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors sequences locals ;
IN: ui.tools.browser.history
TUPLE: history owner back forward ;
: <history> ( owner -- history )
V{ } clone V{ } clone history boa ;
GENERIC: history-value ( object -- value )
GENERIC: set-history-value ( value object -- )
: (add-history) ( history to -- )
swap owner>> history-value dup [ swap push ] [ 2drop ] if ;
:: go-back/forward ( history to from -- )
from empty? [
history to (add-history)
from pop history owner>> set-history-value
] unless ;
: go-back ( history -- )
dup [ forward>> ] [ back>> ] bi go-back/forward ;
: go-forward ( history -- )
dup [ back>> ] [ forward>> ] bi go-back/forward ;
: add-history ( history -- )
dup forward>> delete-all
dup back>> (add-history) ;