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

merger: no idea what this does, but make it cross-platform.

factor-shell
John Benediktsson 2017-10-25 13:58:13 -07:00
parent 5b4339e429
commit 059b6c7a1a
1 changed files with 25 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
extra/merger/merger.factor
View File

@ -1,8 +1,7 @@
USING: accessors arrays fry io.directories kernel USING: accessors arrays file-picker fry io.directories kernel
models sequences sets ui math.rectangles models sequences sets ui ui.gadgets
ui.gadgets ui.gadgets.buttons ui.gadgets.labeled ui.gadgets.buttons ui.gadgets.glass ui.gadgets.labeled
ui.gadgets.tracks ui.gadgets.labels ui.gadgets.glass ui.gadgets.labels ui.gadgets.tracks ;
math.rectangles cocoa.dialogs ;
IN: merger IN: merger
MAIN-WINDOW: merger-window { MAIN-WINDOW: merger-window {
@ -12,22 +11,27 @@ MAIN-WINDOW: merger-window {
vertical <track> vertical <track>
{ "From:" "To:" } f <model> f <model> 2array { "From:" "To:" } f <model> f <model> 2array
[ [
[ [
"…" [ "…" [
open-panel [ first open-file-dialog [
[ <label> 1array >>children drop ] first
[ swap set-control-value ] 2bi ] [ drop ] if* [ <label> 1array >>children drop ]
] <border-button> swap >>model swap <labeled-gadget> [ swap set-control-value ] 2bi
1 track-add ] [ drop ] if*
] 2each ] <border-button> swap >>model swap <labeled-gadget>
1 track-add
] 2each
] keep ] keep
dup first2 dup first2
'[ _ [ value>> ] all? [ parent>> "processing..." <label> [ '[
<zero-rect> show-glass _ [ value>> ] all? [
_ value>> [ parent>> "processing..." <label> [
"." _ value>> [ [ directory-files ] bi@ diff ] keep copy-files-into <zero-rect> show-glass
] with-directory _ value>> [
] keep hide-glass "." _ value>>
] [ drop ] if ] [ [ directory-files ] bi@ diff ] keep copy-files-into
"merge" swap <border-button> 0.4 track-add ] with-directory
] keep hide-glass
] [ drop ] if
] "merge" swap <border-button> 0.4 track-add
>>gadgets ; >>gadgets ;