Hi
I wanted to add a file chooser to 4DNav (http://github.com/Bigot/
factor-bgt) in order to choose the 4D object to visualize but I
didn't find one in ui.gadget.
So I wrote a very simple one to do easy part of the job but I also
tried to do a more complete one that you can find here-after.
I have question about lists and gestures:
- when I choose a file in the list, factor sends an unwanted
"inspect", how can I avoid this.
- I didn't achieve to use mouse selection. when I click on an item,
that triggers the action linked to the keyboard highlighted line.
thanks
Jeff
-------------------------------------
USING: kernel io.files io.backend sequences models strings ui
ui.operations ui.commands ui.gestures ui.gadgets ui.gadgets.buttons
ui.gadgets.lists ui.gadgets.labels ui.gadgets.tracks ui.gadgets.packs
ui.gadgets.panes ui.gadgets.scrollers prettyprint combinators rewrite-
closures accessors namespaces.lib values fry ;
IN: 4DNav.file-chooser
TUPLE: file-chooser < track
path
extension
selected-file
presenter
hook
list
;
: find-file-list ( gadget -- list )
[ file-chooser? ] find-parent list>> ;
file-chooser H{
{ T{ key-down f f "UP" } [ find-file-list select-previous ] }
{ T{ key-down f f "DOWN" } [ find-file-list select-next ] }
{ T{ key-down f f "PAGE_UP" } [ find-file-list list-page-up ] }
{ T{ key-down f f "PAGE_DOWN" } [ find-file-list list-page-down ] }
{ T{ key-down f f "RET" } [ find-file-list invoke-value-action ] }
{ T{ button-down } request-focus }
{ T{ button-down f 1 } [ find-file-list invoke-value-action ] }
} set-gestures
: list-of-files ( file-chooser -- seq )
[ path>> value>> directory-entries ] [ extension>> ] bi
'[ [ name>> _ [ tail? ] with contains? ] [ directory? ] bi
or ] filter
;
: update-filelist-model ( file-chooser -- file-chooser )
[ list-of-files ] [ model>> ] bi set-model ;
: init-filelist-model ( file-chooser -- file-chooser )
dup list-of-files <model> >>model ;
: (fc-go) ( file-chooser quot -- )
[ [ file-chooser? ] find-parent dup path>> ] dip
call
normalize-path swap set-model
update-filelist-model
drop ;
: fc-go-parent ( file-chooser -- )
[ dup value>> parent-directory ] (fc-go) ;
: fc-go-home ( file-chooser -- )
[ home ] (fc-go) ;
: fc-change-directory ( file-chooser file -- file-chooser )
dupd [ path>> value>> normalize-path ] [ name>> ] bi*
append-path over path>> set-model
update-filelist-model
;
: fc-load-file ( file-chooser file -- )
dupd [ selected-file>> ] [ name>> ] bi* swap set-model
[ path>> value>> ]
[ selected-file>> value>> append ]
[ hook>> ] tri
call
; inline
! : fc-ok-action ( file-chooser -- quot )
! dup selected-file>> value>> "" =
! [ drop [ drop ] ] [
! [ path>> value>> ]
! [ selected-file>> value>> append ]
! [ hook>> prefix ] tri
! [ drop ] prepend
! ] if ;
: line-selected-action ( file-chooser -- )
dup list>> list-value
dup directory?
[ fc-change-directory ] [ fc-load-file ] if ;
: present-dir-element ( element -- string )
[ name>> ] [ directory? ] bi [ "-> " prepend ] when ;
: <file-list> ( file-chooser -- list )
dup [ nip line-selected-action ] curry
[ present-dir-element ] rot model>> <list> ;
: <file-chooser> ( hook path extension -- gadget )
{ 0 1 } file-chooser new-track
swap >>extension
swap <model> >>path
"" <model> >>selected-file
swap >>hook
init-filelist-model
dup <file-list> >>list
"choose a file in directory " <label> f track-add
dup path>> <label-control> f track-add
dup extension>> ", " join "limited to : " prepend <label> f
track-add
<shelf>
"selected file : " <label> add-gadget
over selected-file>> <label-control> add-gadget
f track-add
<shelf>
over [ swap fc-go-parent ] curry "go up" swap <bevel-
button> add-gadget
over [ swap fc-go-home ] curry "go home" swap <bevel-
button> add-gadget
! over [ swap fc-ok-action ] curry "OK" swap <bevel-button> add-
gadget
! [ drop ] "Cancel" swap <bevel-button> add-gadget
f track-add
dup list>> <scroller> 1 track-add
;
M: file-chooser pref-dim* drop { 400 200 } ;
: file-chooser-window ( -- )
[ . ] home { "xml" "txt" } <file-chooser> "Choose a file" open-
window ;
------------------------------------------------------------------------------
SF.Net email is Sponsored by MIX09, March 18-20, 2009 in Las Vegas, Nevada.
The future of the web can't happen without you. Join us at MIX09 to help
pave the way to the Next Web now. Learn more and register at
http://ad.doubleclick.net/clk;208669438;13503038;i?http://2009.visitmix.com/
_______________________________________________
Factor-talk mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/factor-talk
