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

26
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 {
@ -14,20 +13,25 @@ MAIN-WINDOW: merger-window {
[ [
[ [
"…" [ "…" [
open-panel [ first open-file-dialog [
first
[ <label> 1array >>children drop ] [ <label> 1array >>children drop ]
[ swap set-control-value ] 2bi ] [ drop ] if* [ swap set-control-value ] 2bi
] [ drop ] if*
] <border-button> swap >>model swap <labeled-gadget> ] <border-button> swap >>model swap <labeled-gadget>
1 track-add 1 track-add
] 2each ] 2each
] keep ] keep
dup first2 dup first2
'[ _ [ value>> ] all? [ parent>> "processing..." <label> [ '[
_ [ value>> ] all? [
parent>> "processing..." <label> [
<zero-rect> show-glass <zero-rect> show-glass
_ value>> [ _ value>> [
"." _ value>> [ [ directory-files ] bi@ diff ] keep copy-files-into "." _ value>>
[ [ directory-files ] bi@ diff ] keep copy-files-into
] with-directory ] with-directory
] keep hide-glass ] keep hide-glass
] [ drop ] if ] ] [ drop ] if
"merge" swap <border-button> 0.4 track-add ] "merge" swap <border-button> 0.4 track-add
>>gadgets ; >>gadgets ;