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

ui.tools.listener.history: cleanup and minor bugfix.

db4
John Benediktsson 2014-04-30 19:06:36 -07:00
parent a0a76469b6
commit 0f52c3e486
1 changed files with 26 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
basis/ui/tools/listener/history/history.factor
View File

@ -12,46 +12,48 @@ TUPLE: history document elements index ;
<PRIVATE <PRIVATE
: push-if-not-last ( elt seq -- ) : push-if-not-last ( elt seq -- )
dup empty? [ push ] [ 2dup ?last = [ 2drop ] [ push ] if ;
dup last pick = [ 2drop ] [ push ] if
] if ; : current-input ( history -- input ? )
document>> doc-string [ <input> ] [ empty? ] bi ;
PRIVATE> PRIVATE>
: history-add ( history -- input ) : history-add ( history -- input )
dup elements>> length 1 + >>index dup current-input [ nip ] [
[ document>> doc-string [ <input> ] [ empty? ] bi ] keep [
'[ [ _ elements>> push-if-not-last ] keep ] unless ; over elements>>
[ push-if-not-last ]
[ length >>index drop ] bi
] keep
] if ;
<PRIVATE <PRIVATE
: (save-history) ( input index elements -- ) : set-element ( elt history -- )
2dup length > [ [ index>> ] [ elements>> ] bi set-nth ;
[ [ T{ input f "" } ] dip push ] keep
(save-history) : get-element ( history -- elt )
] [ set-nth ] if ; [ index>> ] [ elements>> ] bi nth ;
: save-history ( history -- ) : save-history ( history -- )
[ document>> doc-string ] keep dup current-input [ 2drop ] [ swap set-element ] if ;
'[ <input> _ [ index>> ] [ elements>> ] bi (save-history) ]
unless-empty ;
: update-document ( history -- ) : update-document ( history -- )
[ [ index>> ] [ elements>> ] bi nth string>> ] [ document>> ] bi [ get-element string>> ] [ document>> ] bi
[ set-doc-string ] [ clear-undo drop ] 2bi ; [ set-doc-string ] [ clear-undo ] bi ;
: change-history-index ( history i -- ) : change-history-index ( history i -- )
over elements>> length 1 - over elements>> length 1 -
'[ _ + _ min 0 max ] change-index drop ; '[ _ + 0 _ clamp ] change-index drop ;
: history-recall ( history i -- ) : history-recall ( history i -- )
[ [ elements>> empty? ] keep ] dip '[ over elements>> empty? [ 2drop ] [
_ [ drop save-history ]
[ save-history ] [ change-history-index ]
[ _ change-history-index ] [ drop update-document ]
[ update-document ] 2tri
tri ] if ;
] unless ;
PRIVATE> PRIVATE>