This repository has been archived by the owner on Feb 10, 2021. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathFileManDialogs.hs
1003 lines (867 loc) · 52.5 KB
/
FileManDialogs.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{-# OPTIONS_GHC -cpp #-}
----------------------------------------------------------------------------------------------------
---- FreeArc archive manager: Extract/ArcInfo/Settings dialogs ------
----------------------------------------------------------------------------------------------------
module FileManDialogs where
import Prelude hiding (catch)
import Control.Concurrent
import Control.OldException
import Control.Monad
import Control.Monad.Fix
import Data.Char
import Data.IORef
import Data.List
import Data.Maybe
import System.IO.Unsafe
import System.Cmd
#if defined(FREEARC_WIN)
import System.Win32
#endif
import Graphics.UI.Gtk
import Graphics.UI.Gtk.ModelView as New
import Utils
import Errors
import Files
import FileInfo
import Charsets
import Compression
import Encryption
import Options
import UIBase
import UI
import ArhiveStructure
import Arhive7zLib
import ArcExtract
import FileManPanel
import FileManUtils
----------------------------------------------------------------------------------------------------
---- Äèàëîã ðàñïàêîâêè ôàéëîâ ----------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
extractDialog fm' exec winoptions cmd arcnames arcdir files = do
fm <- val fm'
title <- i18n$ case (cmd, files, arcnames) of
("t", [], []) -> "0157 Test all archives"
("t", [], [arcname]) -> "0152 Test %3"
("t", [file], [arcname]) -> "0153 Test %1 from %3"
("t", files, [arcname]) -> "0154 Test %2 files from %3"
("t", files, arcnames) -> "0155 Test %4 archives"
(_, [], []) -> "0158 Extract all archives"
(_, [], [arcname]) -> "0024 Extract files from %3"
(_, [file], [arcname]) -> "0025 Extract %1 from %3"
(_, files, [arcname]) -> "0026 Extract %2 files from %3"
(_, files, arcnames) -> "0027 Extract files from %4 archives"
let wintitle = formatn title [head files, show3$ length files, takeFileName$ head arcnames, show3$ length arcnames]
-- Ñîçäàäèì äèàëîã ñî ñòàíäàðòíûìè êíîïêàìè OK/Cancel
fmDialog fm' wintitle winoptions $ \(dialog,okButton) -> do
upbox <- dialogGetUpper dialog
; outFrame <- frameNew
; boxPackStart upbox outFrame PackNatural 5 `on_` cmd/="t"
; vbox <- vBoxNew False 0
; set outFrame [containerChild := vbox, containerBorderWidth := 5]
(hbox, _, dir) <- fmFileBox fm' dialog
"dir" FileChooserActionSelectFolder
(label "0004 Output directory:")
"0021 Select output directory"
aANYFILE_FILTER
(const$ return True)
(fmCanonicalizeDiskPath fm')
; boxPackStart vbox hbox PackNatural 0
addDirButton <- checkBox "0014 Append archive name to the output directory"
; boxPackStart vbox (widget addDirButton) PackNatural 0
openOutDirButton <- checkBox "0468 Open output directory in Explorer"
; boxPackStart vbox (widget openOutDirButton) PackNatural 0
overwrite <- radioFrame "0005 Overwrite mode"
[ "0001 Ask before overwrite",
"0002 Overwrite without prompt",
"0003 Update old files",
"0051 Skip existing files" ]
; boxPackStart upbox (widget overwrite) PackNatural 5 `on_` cmd/="t"
(decryption, decryptionOnOK) <- decryptionBox fm' dialog -- Íàñòðîéêè ðàñøèôðîâêè
; boxPackStart upbox decryption PackNatural 5
keepBrokenButton <- fmCheckButtonWithHistory fm' "KeepBroken" False "0425 Keep broken extracted files"
; boxPackStart upbox (widget keepBrokenButton) PackNatural 0 `on_` cmd/="t"
globalQueueing <- fmCheckButtonWithHistory fm' "GlobalQueueing" False global_queueing_msg
; boxPackStart upbox (widget globalQueueing) PackNatural 0
shutdown <- checkBox shutdown_msg
; boxPackStart upbox (widget shutdown) PackNatural 0
(hbox, options, optionsStr) <- fmCheckedEntryWithHistory fm' "xoptions" "0072 Additional options:"
; boxPackStart upbox hbox PackNatural 0
-- Óñòàíîâèì âûõîäíîé êàòàëîã â çíà÷åíèå ïî óìîë÷àíèþ
case arcnames of
[arcname] -> do dir =:: fmCanonicalizeDiskPath fm' (takeBaseName arcname)
_ -> do dir =:: fmCanonicalizeDiskPath fm' "."; addDirButton=:True
widgetShowAll upbox
showTestDialog <- fmGetHistoryBool fm' "ShowTestDialog" False
choice <- if cmd/="t" || showTestDialog
then fmDialogRun fm' dialog (if cmd/="t" then "ExtractDialog" else "TestDialog")
else return ResponseOk
when (choice `elem` [ResponseOk, aResponseDetach]) $ do
overwriteOption <- val overwrite
dir' <- val dir; saveHistory dir
isAddDir <- val addDirButton
isOpenOutDir <- val openOutDirButton
decryptionOptions <- decryptionOnOK
keepBroken <- val keepBrokenButton
globalQueueing' <- val globalQueueing -- don't save to history - this selection is for one command only
shutdown' <- val shutdown
optionsEnabled <- val options
; optionsStr' <- val optionsStr; saveHistory optionsStr `on_` optionsEnabled
let outdir = dir' .$ (isAddDir &&& length(arcnames)==1 &&& (</> takeBaseName(head arcnames)))
use_winrar = False
exec (choice == aResponseDetach) -- Çàïóñòèòü êîìàíäó â îòäåëüíîé êîïèè FreeArc?
use_winrar
(\ok -> when isOpenOutDir (runFile (outdir++[pathSeparator]) "" False)) -- post-operation action: open outdir in Explorer
((arcnames ||| ["*"]) .$map (\arcname ->
[cmd]++
(cmd/="t" &&& (
["-dp"++clear dir']++
(isAddDir &&& ["-ad"])++
(arcdir &&& files &&& ["-ap"++clear arcdir])++
(keepBroken &&& ["-kb"])++
(overwriteOption `select` ",-o+,-u -o+,-o-")))++
decryptionOptions++
["--fullnames"]++
["--noarcext"]++
(globalQueueing' &&& ["--queue"])++
(shutdown' &&& ["--shutdown"])++
(optionsEnabled &&& words (clear optionsStr'))++
["--", clear arcname]++files))
----------------------------------------------------------------------------------------------------
---- Äèàëîã èíôîðìàöèè îá àðõèâå -------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
arcinfoDialog fm' exec mode arcnames arcdir files = do
handle (\e -> fmErrorMsg fm' "0013 There are no archives selected!") $ do
fm <- val fm'
let arcname = head arcnames
fm_arc <- case () of _ | isFM_Archive fm -> return (subfm fm)
| otherwise -> with' (newFMArc fm' arcname "") (return) (\_ -> closeFMArc fm')
let archive = subfm_archive fm_arc
footer = arcFooter archive
dataBlocks = arcDataBlocks archive -- ñïèñîê ñîëèä-áëîêîâ
dirs_and_files = [("0173 Directories:", show3$ ftDirs$ subfm_filetree fm_arc)
,("0088 Files:", show3$ ftFiles$ subfm_filetree fm_arc)]
title <- i18n"0085 All about %1"
let wintitle = format title (takeFileName arcname)
-- Ñîçäàäèì äèàëîã ñî ñòàíäàðòíûìè êíîïêàìè OK/Cancel
fmDialog fm' wintitle [] $ \(dialog,okButton) -> do
(nb,newPage) <- startNotebook dialog
------ Ãëàâíàÿ çàêëàäêà ----------------------------------------------------------------------------
vbox <- newPage "0174 Main"; let pack n makeControl = do control <- makeControl
boxPackStart vbox control PackNatural n
tables <- arcGetTechinfo archive dirs_and_files
for (zip [10,0,10,0,10] tables) $ \(n,table) -> do
pack n (twoColumnTable table)
------ Çàêëàäêà ñ îïèñàíèÿìè ñîëèä-áëîêîâ ----------------------------------------------------------
#ifndef HAMSTER
vBox <- newPage "0449 Solid blocks"
let columnTitles = ["0450 Position", "0451 Size", "0452 Compressed", "0453 Files", "0454 Method"]
n = map i18no columnTitles
s <- i18ns columnTitles
let compressor = join_compressor.blCompressor
(listUI, listView, listModel, listSelection, columns, onColumnTitleClicked) <-
createListView compressor [(n!!0, s!!0, (show3.blPos), [New.cellTextEditable := True, cellXAlign := 1]),
(n!!1, s!!1, (show3.blOrigSize), [New.cellTextEditable := True, cellXAlign := 1]),
(n!!2, s!!2, (show3.blCompSize), [New.cellTextEditable := True, cellXAlign := 1]),
(n!!3, s!!3, (show3.blFiles), [New.cellTextEditable := True, cellXAlign := 1]),
(n!!4, s!!4, (compressor), [New.cellTextEditable := True])]
boxPackStart vBox listUI PackGrow 0
changeList listModel listSelection dataBlocks
-- Ïðè çàêðûòèè äèàëîãà ñîõðàíèì ïîðÿäîê è øèðèíó êîëîíîê, ïðè îòêðûòèè âîññòàíîâèì èõ
restoreColumnsOrderAndWidths fm' "SolidBlocks" listView columns
#endif
------ Çàêëàäêà êîììåíòàðèÿ àðõèâà -----------------------------------------------------------------
vbox <- newPage "0199 Comment"
comment <- scrollableTextView (ftComment footer) []
boxPackStart vbox (widget comment) PackGrow 0
widgetShowAll dialog
notebookSetCurrentPage nb 1 `on_` mode==CommentMode
choice <- fmDialogRun fm' dialog "ArcInfoDialog"
#ifndef HAMSTER
saveColumnsOrderAndWidths fm' "SolidBlocks" listView columns
#endif
when (choice==ResponseOk) $ do
newComment <- val comment
when (newComment /= ftComment footer) $ do
let use_winrar = False
exec False use_winrar doNothing [["ch"
,"--noarcext"
,newComment &&& ("--archive-comment="++newComment)
||| "-z-"
,"--"
,arcname]]
----------------------------------------------------------------------------------------------------
---- Äèàëîã íàñòðîåê ïðîãðàììû ---------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
settingsDialog fm' = do
fm <- val fm'
fmDialog fm' "0067 Settings" [] $ \(dialog,okButton) -> do
(nb,newPage) <- startNotebook dialog
------ Ãëàâíàÿ çàêëàäêà ----------------------------------------------------------------------
vbox <- newPage "0174 Main"; let pack x = boxPackStart vbox x PackNatural 1
aboutLabel <- labelNewWithMnemonic aARC_HEADER_WITH_DATE
langLabel <- label "0068 Language:"
langComboBox <- New.comboBoxNewText
editLangButton <- button "0069 Edit"
convertLangButton <- button "0070 Import"
-- Ëîãôàéë
(logfileBox, _, logfile) <- fmFileBox fm' dialog
"logfile" FileChooserActionSave
(label "0166 Logfile:")
"0167 Select logfile"
aANYFILE_FILTER
(const$ return True)
(fmCanonicalizeDiskPath fm')
; viewLogfileButton <- button "0292 View"
-- Êàòàëîã äëÿ âðåìåííûõ ôàéëîâ
(tempdirBox, _, tempdir) <- fmFileBox fm' dialog
"tempdir" FileChooserActionSelectFolder
(label "0447 Temporary directory:")
"0448 Select directory for temporary files"
aANYFILE_FILTER
(const$ return True)
(fmCanonicalizeDiskPath fm')
-- Ïðî÷åå
checkNewsButton <- fmCheckButtonWithHistory fm' "CheckNews" True "0370 Watch for new versions via Internet"
notes <- label . joinWith "\n" =<<
i18ns["0168 You should restart "++aFreeArc++" in order for a language settings to take effect.",
"0169 Passwords need to be entered again after restart."]
-----------------------------------------------------------------------------------------------
-- Èíôîðìàöèÿ î òåêóùåì ÿçûêå ëîêàëèçàöèè
langTable <- tableNew 2 2 False
let dataset = [("0170 Full name:", "0000 English"), ("0171 Copyright:", "0159 ")]
labels <- foreach [0..1] $ \y -> do
-- Ïåðâàÿ êîëîíêà
label1 <- labelNew Nothing; let x=0
tableAttach langTable label1 (x+0) (x+1) y (y+1) [Fill] [Fill] 5 5
miscSetAlignment label1 0 0
-- Âòîðàÿ êîëîíêà
label2 <- labelNew Nothing
tableAttach langTable label2 (x+1) (x+2) y (y+1) [Expand, Fill] [Expand, Fill] 5 5
set label2 [labelSelectable := True]
miscSetAlignment label2 0 0
return (label1, label2)
--
let showLang i18n = do
for (zip labels dataset) $ \((l1,l2),(s1,s2)) -> do
labelSetTextWithMnemonic l1 =<< i18n s1
labelSetMarkup l2.bold =<< i18n s2
--
showLang i18n
-- Ôàéë ÿçûêîâîé ëîêàëèçàöèè
langFile <- fmGetHistory1 fm' aINITAG_LANGUAGE ""
-- Çàïîëíèòü ñïèñîê ÿçûêîâ èìåíàìè ôàéëîâ â êàòàëîãå arc.languages è âûáðàòü àêòèâíûé ÿçûê
langDir <- findDir libraryFilePlaces aLANG_DIR
langFiles <- langDir &&& (dir_list langDir >>== map baseName >>== sort >>== filter (match "arc.*.txt"))
-- Îòîáðàçèì ÿçûêè â 5 ñòîëáöîâ, ñ ñîðòèðîâêîé ïî ñòîëáöàì
let cols = 5
rows = (length langFiles) `divRoundUp` cols; add = rows*cols - length langFiles
sortOnColumn x = r*cols+c where (c,r) = x `divMod` rows -- ïåðåñ÷èòàòü èç ïîêîëîíî÷íûõ ïîçèöèé â ïîñòðî÷íûå
; langFiles <- return$ map snd $ sort $ zip (map sortOnColumn [0..]) (langFiles ++ replicate add "")
--
for langFiles (New.comboBoxAppendText langComboBox . mapHead toUpper . replace '_' ' ' . dropEnd 4 . drop 4)
langComboBox `New.comboBoxSetWrapWidth` cols
whenJust_ (elemIndex (takeFileName langFile) langFiles)
(New.comboBoxSetActive langComboBox)
-- Îïðåäåëèòü ôàéë ëîêàëèçàöèè, ñîîòâåòñòâóþùèé âûáðàííîìó â êîìáîáîêñå ÿçûêó
let getCurrentLangFile = do
lang <- New.comboBoxGetActive langComboBox
case lang of
-1 -> return ""
lang -> myCanonicalizePath (langDir </> (langFiles !! lang))
-- Ïðè âûáîðå äðóãîãî ÿçûêà ëîêàëèçàöèè âûâåñòè èíôîðìàöèþ î í¸ì
on langComboBox changed $ do
choice <- New.comboBoxGetActive langComboBox
when (choice /= -1) $ do
langFile <- getCurrentLangFile
localeInfo <- parseLocaleFiles [langFile]
showLang (i18n_general (return localeInfo) .>>== fst)
-- Ðåäàêòèðîâàíèå òåêóùåãî ôàéëà ëîêàëèçàöèè/ëîãôàéëà
editLangButton `onClick` (runEditCommand =<< getCurrentLangFile)
viewLogfileButton `onClick` (runViewCommand =<< val logfile)
; langFrame <- frameNew
; vbox1 <- vBoxNew False 0
; set langFrame [containerChild := vbox1, containerBorderWidth := 5]
; langbox <- hBoxNew False 0
boxPackStart langbox (widget langLabel) PackNatural 0
boxPackStart langbox langComboBox PackGrow 5
boxPackStart langbox (widget editLangButton) PackNatural 5
--boxPackStart langbox (widget convertLangButton) PackNatural 5
boxPackStart vbox1 langbox PackNatural 5
boxPackStart vbox1 langTable PackNatural 5
boxPackStart logfileBox (widget viewLogfileButton) PackNatural 5
boxPackStart vbox aboutLabel PackNatural 5
boxPackStart vbox langFrame PackNatural 5
boxPackStart vbox logfileBox PackNatural 5
boxPackStart vbox tempdirBox PackNatural 5
boxPackStart vbox (widget checkNewsButton) PackNatural 5
boxPackStart vbox (widget notes) PackNatural 5
------ Çàêëàäêà íàñòðîåê èíòåðôåéñà -----------------------------------------------------------
vbox <- newPage "0466 Interface"; let pack x = boxPackStart vbox x PackNatural 1
toolbarTextButton <- fmCheckButtonWithHistory fm' "ToolbarCaptions" True "0361 Add captions to toolbar buttons"; pack (widget toolbarTextButton)
horizontalGridLinesButton <- fmCheckButtonWithHistory fm' "HorizontalGridLines" False "0507 Grid lines in filelist"; pack (widget horizontalGridLinesButton)
showHiddenFilesButton <- fmCheckButtonWithHistory fm' "ShowHiddenFiles" False "0499 Show hidden files, folders and disks"; pack (widget showHiddenFilesButton)
showTestDialogButton <- fmCheckButtonWithHistory fm' "ShowTestDialog" False "0469 Show \"Test archive\" dialog"; pack (widget showTestDialogButton)
targzButton <- fmCheckButtonWithHistory fm' "QuickOpenTarGz" True "0485 Open .tar.gz-like archives in single step"; pack (widget targzButton)
(hbox, extract_all_for) <- fmLabeledEntryWithHistory fm' "ExtractAllFor" "0467 Unpack whole archive when running:"; pack hbox
(hbox, run_for) <- fmLabeledEntryWithHistory fm' "RunFor" "0500 Run instead of open as archive:"; pack hbox
globalQueueingButton <- fmCheckButtonWithHistory fm' "GlobalQueueing" False global_queueing_msg; pack (widget globalQueueingButton)
------ Çàêëàäêà èíòåãðàöèè ñ Explorer ---------------------------------------------------------
#if defined(FREEARC_WIN)
vbox <- newPage "0421 Explorer integration"; let pack x = boxPackStart vbox x PackNatural 1
(associateFreeArcBox, associateFreeArc, associateFreeArcExtensions) <- fmCheckedEntryWithHistory2 fm' "Settings.Associate.FreeArc" False "0543 Associate with FreeArc archives:"
(associateOtherArcBox, associateOtherArc, associateOtherArcExtensions) <- fmCheckedEntryWithHistory2 fm' "Settings.Associate.OtherArc" False "0544 Associate with other archives:"
(associateContextMenuBox, associateContextMenu, associateContextMenuExtensions) <- fmCheckedEntryWithHistory2 fm' "Settings.Associate.ContextMenu" False "0545 Context menu for container files:"
(associateSmartMenuBox, associateSmartMenu, associateSmartMenuExtensions) <- fmCheckedEntryWithHistory2 fm' "Settings.Associate.SmartMenu" False "0546 Smart context menu for files:"
contextMenuButton <- fmCheckButtonWithHistory fm' "Settings.ContextMenu" False "0422 Enable context menu in Explorer"
cascadedButton <- fmCheckButtonWithHistory fm' "Settings.ContextMenu.Cascaded" True "0423 Make it cascaded"
empty <- label ""
#ifndef HAMSTER
pack `mapM_` [associateFreeArcBox]
#endif
pack `mapM_` [associateOtherArcBox, associateContextMenuBox, associateSmartMenuBox, widget empty]
frame <- frameNew; frameSetLabelWidget frame (widget contextMenuButton)
boxPackStart vbox frame PackGrow 1
hbox <- hBoxNew False 0; containerAdd frame hbox
let show_or_hide = widgetSetSensitivity hbox =<< val contextMenuButton
show_or_hide
show_or_hide .$ setOnUpdate contextMenuButton
oldContextMenu <- val contextMenuButton
vbox <- vBoxNew False 0; boxPackStart hbox vbox PackGrow 10
let pack x = boxPackStart vbox x PackNatural 1
empty <- label ""
notes <- label =<< i18n"0424 Enable individual commands:"
mapM_ (pack.widget) [cascadedButton, empty, notes]
-- Put all subsequent checkboxes into scrolled window
vbox <- createScroller vbox
let pack x = boxPackStart vbox x PackNatural 1
let makeButton ("",_,_) = do pack =<< hSeparatorNew; return []
makeButton (cmdname,itext,imsg) = do
button <- fmCheckButtonWithHistory fm' ("Settings.ContextMenu.Command."++cmdname) True imsg
pack (widget button)
return [button]
commands <- getExplorerCommands >>= concatMapM makeButton
#endif
------ Çàêëàäêà ñæàòèÿ ------------------------------------------------------------------------
(_, saveCompressionHistories) <- compressionPage fm' =<< newPage "0106 Compression"
------ Çàêëàäêà øèôðîâàíèÿ --------------------------------------------------------------------
(_, saveEncryptionHistories) <- encryptionPage fm' dialog okButton =<< newPage "0119 Encryption"
------ Çàêëàäêà èíôîðìàöèè î ñèñòåìå ----------------------------------------------------------
vbox <- newPage "0388 Info"; let pack n makeControl = do control <- makeControl
boxPackStart vbox control PackNatural n
maxBlock <- getMaxBlockToAlloc
pack 10 $twoColumnTable [("0461 Largest address space block:", showMem (maxBlock `roundDown` mb))]
-----------------------------------------------------------------------------------------------
widgetShowAll dialog
choice <- fmDialogRun fm' dialog "SettingsDialog"
when (choice==ResponseOk) $ do
-- Ñîõðàíÿåì íàñòðîéêè è keyfile â INI-ôàéë, ïàðîëè - â ãëîá. ïåðåìåííûõ
langFile <- getCurrentLangFile
fmReplaceHistory fm' aINITAG_LANGUAGE (takeFileName langFile)
loadTranslation
saveHistory `mapM_` [logfile, tempdir, extract_all_for, run_for]
saveHistory `mapM_` [checkNewsButton, toolbarTextButton, horizontalGridLinesButton, showHiddenFilesButton, showTestDialogButton, targzButton, globalQueueingButton]
saveCompressionHistories
saveEncryptionHistories
#if defined(FREEARC_WIN)
saveHistory `mapM_` ([associateFreeArc, associateOtherArc, associateContextMenu, associateSmartMenu, contextMenuButton, cascadedButton] ++ commands)
saveHistory `mapM_` ([associateFreeArcExtensions, associateOtherArcExtensions, associateContextMenuExtensions, associateSmartMenuExtensions])
registerShellExtensions' (fm_history fm) (Just oldContextMenu)
#endif
return ()
----------------------------------------------------------------------------------------------------
---- (Äå)ðåãèñòðàöèÿ shell extension è àññîöèàöèè FreeArc ñ àðõèâíûìè ôàéëàìè ----------------------
----------------------------------------------------------------------------------------------------
#if defined(FREEARC_WIN)
-- |Ðåãèñòðàöèÿ/Óäàëåíèå ðåãèñòðàöèè ÷åðåç êîìàíäíóþ ñòðîêó
changeRegisterShellExtensions action = do
hf' <- openHistoryFile
when (action==["--unregister"]) $ do
hfReplaceHistoryBool hf' "Settings.Associate.FreeArc.Enabled" False
hfReplaceHistoryBool hf' "Settings.Associate.OtherArc.Enabled" False
hfReplaceHistoryBool hf' "Settings.Associate.ContextMenu.Enabled" False
hfReplaceHistoryBool hf' "Settings.Associate.SmartMenu.Enabled" False
hfReplaceHistoryBool hf' "Settings.ContextMenu" False
--
registerShellExtensions' hf' Nothing
-- |Èçìåíåíèå íàñòðîåê èíòåãðàöèè ñ Explorer
registerShellExtensions' hf' oldContextMenu = do
hfCacheConfigFile hf' $ do
associateArc <- hfGetHistoryBool hf' "Settings.Associate.FreeArc.Enabled" False
associateZip <- hfGetHistoryBool hf' "Settings.Associate.OtherArc.Enabled" False
contextMenu <- hfGetHistoryBool hf' "Settings.ContextMenu" False
freearc_extensions_raw <- hfGetHistory1 hf' "Settings.Associate.FreeArc" ""
other_archive_extensions_raw <- hfGetHistory1 hf' "Settings.Associate.OtherArc" ""
let freearc_extensions = associateArc &&& words freearc_extensions_raw
other_archive_extensions = associateZip &&& words other_archive_extensions_raw
new_extensions = sort$ removeDups$ freearc_extensions++other_archive_extensions
exe <- getExeName -- Name of FreeArc.exe file
let ico = exe `replaceExtension` ".ico" -- Name of FreeArc.ico file
dir = exe.$takeDirectory -- FreeArc.exe directory
shext = dir </> "ArcShellExt" -- Shell extension directory
empty = dir </> "empty.arc" -- Name of empty archive file
version = aARC_VERSION_WITH_DATE
reg = registryGetStr hKEY_CLASSES_ROOT
--
old_shext <- hfGetHistory1 hf' "Settings.ContextMenu.Directory" ""
hfReplaceHistory hf' "Settings.ContextMenu.Directory" shext
old_version <- hfGetHistory1 hf' "Settings.ContextMenu.Version" ""
hfReplaceHistory hf' "Settings.ContextMenu.Version" version
old_extensions <- hfGetHistory1 hf' "Settings.Associate.Extensions" "" >>== words >>== removeDups >>== sort
hfReplaceHistory hf' "Settings.Associate.Extensions" (unwords new_extensions)
-- UAC-compatibility: instead of modifying registry directly, we are calling external executables that have admin privileges
reglist32 <- newList; reglist64 <- newList
let add_to_list x = for [reglist32, reglist64] (<<=x)
let register key name value = mapM_ add_to_list ["RegistryCreateKey", key, name, value]
regDeleteTree key = mapM_ add_to_list ["RegistryDeleteTree", key]
runDll32 dll func = mapM_ (reglist32 <<=) ["RunDll", dll, func]
runDll64 dll func = mapM_ (reglist64 <<=) ["RunDll", dll, func]
-- (Un)registering ArcShellExt dlls - performed only if any setting was changed
let arcShellExt action = when ((oldContextMenu,old_shext,old_version) /= (Just contextMenu,shext,version)) $ do
runDll32 (shext </> "ArcShellExt.dll") action
runDll64 (shext </> "ArcShellExt-64.dll") action
-- Unregister DLL
arcShellExt "DllUnregisterServer"
-- Reassociate archives with FreeArc - performed only if any setting was changed
when (new_extensions/=old_extensions || version/=old_version) $ do
-- Remove any old associations
regDeleteTree ("*\\shell\\"++aFreeArc) -- these registry entries were used
regDeleteTree ("Directory\\shell\\"++aFreeArc) -- for Explorer integration in FreeArc 0.50
add_ext_list <- newList; delete_ext_list <- newList; add_type_list <- newList; delete_type_list <- newList
-- Cycle through all extensions - associated before and associated now, and make decisions about things to delete and things to create
for (removeDups$ new_extensions++old_extensions) $ \ext -> do
-- Make decisions about the "HKCR\.ext" registry branch
eq <- (Just (aFreeArc++"."++ext) ==) `fmap` reg ("."++ext) "" -- Does extension already associated with FreeArc?
case () of
_ | ext `notElem` new_extensions -> delete_ext_list <<= ext -- remove association
| ext `elem` old_extensions && eq -> doNothing0 -- leave as is (because existing association is OK)
| otherwise -> for [delete_ext_list, add_ext_list] (<<=ext) -- remove and create again
-- Make decisions about the "HKCR\FreeArc.ext" registry branch
eq <- (Just exe ==) `fmap` reg (aFreeArc++"."++ext) "Owner" -- Does "FreeArc.ext" filetype already owned by the current FreeArc installation?
case () of
_ | ext `notElem` new_extensions -> delete_type_list <<= ext -- remove association
| ext `elem` old_extensions && eq -> doNothing0 -- leave as is (because existing association is OK)
| otherwise -> for [delete_type_list, add_type_list] (<<=ext) -- remove and create again
--
-- Perform all the arranged deletions and additions
forL delete_ext_list $ \ext -> regDeleteTree ("."++ext)
forL delete_type_list $ \ext -> regDeleteTree (aFreeArc++"."++ext)
forL add_type_list $ \ext -> do
register (aFreeArc++"."++ext) "" ((if ext `elem` freearc_extensions then aFreeArc else map toUpper ext)++" archive")
register (aFreeArc++"."++ext) "Owner" exe -- used to check that exension is already associated with this program installation
register (aFreeArc++"."++ext++"\\DefaultIcon") "" (ico++",0")
register (aFreeArc++"."++ext++"\\shell") "" ("open")
register (aFreeArc++"."++ext++"\\shell\\open\\command") "" ("\""++exe++"\" \"%1\"")
--
forL add_ext_list $ \ext -> do
register ("."++ext) "" (aFreeArc++"."++ext)
--register (".arc\\ShellNew") "FileName" (empty) -- disabled because we don't yet support Drag&Drop
-- Add items to Explorer's right-click menu and register DLL
when contextMenu $ do
writeShellExtScript hf'
arcShellExt "DllRegisterServer"
-- Run external executables with admin privileges that make actual changes to the registry
onList reglist32 $ \list32 -> list32 &&& runCommand (unparseCommand$ (shext</>("Manager of FreeArc integration settings.exe" )):"0.60":list32) "." True
onList reglist64 $ \list64 -> list64 &&& runCommand (unparseCommand$ (shext</>("Manager of FreeArc integration settings (64-bit).exe")):"0.60":list64) "." True
#else
changeRegisterShellExtensions = doNothing
#endif
----------------------------------------------------------------------------------------------------
---- Dialogs for choosing compression and encryption method called from the Add dialog -------------
----------------------------------------------------------------------------------------------------
compressionMethodDialog fm' = methodDialog fm' "0106 Compression" "CompressionMethodDialog" (\fm' _ _ vbox -> compressionPage fm' vbox)
encryptionMethodDialog fm' = methodDialog fm' "0119 Encryption" "EncryptionMethodDialog" encryptionPage
methodDialog fm' title dialogName methodPage getMethod setMethod = do
fm <- val fm'
fmDialog fm' title [] $ \(dialog,okButton) -> do
upbox <- dialogGetUpper dialog
vbox <- vBoxNew False 0
boxPackStart upbox vbox PackGrow 0
(method, saveSomeHistories) <- methodPage fm' dialog okButton vbox
method =:: getMethod
widgetShowAll dialog
choice <- fmDialogRun fm' dialog dialogName
when (choice==ResponseOk) $ do
saveSomeHistories
val method >>= setMethod
return ()
----------------------------------------------------------------------------------------------------
---- Çàêëàäêà ñæàòèÿ -------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
compressionPage fm' vbox = do
let pack x = boxPackStart vbox x PackNatural 1
-- Àëãîðèòì ñæàòèÿ.
(hbox, cmethod) <- fmLabeledEntryWithHistory fm' "compression" "0175 Compression profile:"; pack hbox
; save <- button "0178 Save"; boxPackStart hbox (widget save) PackNatural 5
-- Put all subsequent controls into scrolled window
vbox <- createScroller vbox
let pack x = boxPackStart vbox x PackNatural 1
-- Íàñòðîéêè àëãîðèòìà ñæàòèÿ.
hbox <- hBoxNew False 0; pack hbox
; method <- radioFrame "0107 Compression level" levels; boxPackStart hbox (widget method) PackNatural 0
; methodText <- labelNew Nothing; boxPackStart hbox methodText PackGrow 0
table <- tableNew 3 2 False; pack table; tableSetColSpacings table 20
; dMethod <- checkBox "0509 Fast decompression" ; packTable table (widget dMethod) 0 0
; xMethod <- checkBox "0510 Low-memory decompression" ; packTable table (widget xMethod) 0 1
; maxSolid <- checkBox "0512 Maximize solid blocks" ; packTable table (widget maxSolid) 1 0
; autodetect <- checkBox "0176 Filetype auto-detection" ; packTable table (widget autodetect) 1 1
; (hbox, numThreadsOn, numThreads) <- fmCheckedEntryWithHistory fm' "numthreads" "0531 Threads:"; packTable table hbox 0 2; widgetSetSizeRequest (widget numThreads) 50 (-1)
-- Íàñòðîéêè ðàçìåðà ñîëèä-áëîêà
table <- createFrame "0177 Limit solid blocks" pack (tableNew 1 3 False); tableSetColSpacings table 20
; (hbox, solidBytesOn, solidBytes) <- fmCheckedEntryWithHistory fm' "bytes" "0528 Bytes:" ; packTable table hbox 0 0; widgetSetSizeRequest (widget solidBytes) 70 (-1)
; (hbox, solidFilesOn, solidFiles) <- fmCheckedEntryWithHistory fm' "files" "0529 Files:" ; packTable table hbox 1 0; widgetSetSizeRequest (widget solidFiles) 70 (-1)
; solidByExtension <- checkBox "0530 Extension" ; packTable table (widget solidByExtension) 2 0
-- Îãðàíè÷åíèå èñïîëüçóåìîé ïàìÿòè
table <- createFrame "0513 Limit memory usage, mb" pack (tableNew 1 2 False); tableSetColSpacings table 30
; (hbox, limitCMemOn, limitCMem) <- fmCheckedEntryWithHistory fm' "cmem" "0514 Compression:" ; packTable table hbox 0 0; widgetSetSizeRequest (widget limitCMem) 60 (-1)
; (hbox, limitDMemOn, limitDMem) <- fmCheckedEntryWithHistory fm' "dmem" "0515 Decompression:" ; packTable table hbox 1 0; widgetSetSizeRequest (widget limitDMem) 60 (-1)
; maxBlock <- getMaxBlockToAlloc; s <- i18n"0461 Largest address space block:";
; l <- labelNew Nothing; labelSetMarkup l (s++" "++bold(showMem (maxBlock `roundDown` mb)))
; tableAttachDefaults table l 0 2 1 2
-- Ñëåäóþùèå äâå òàáëèöû íàäî ðàçìåñòèòü áîê-î-áîê
hbox <- hBoxNew False 0; pack hbox; let pack_horizontally x = boxPackStart hbox x PackGrow 1
-- Îòêëþ÷åíèå îòäåëüíûõ ôèëüòðîâ/ãðóïï ôàéëîâ
table <- createFrame "0516 Disable filter/group" pack_horizontally (tableNew 3 3 False)
let algos = words "rep exe delta dict lzp $text $wav $bmp $compressed"
disabledAlgos <- foreach (zip [0..] algos) $ \(i,algo) -> do
disabledAlgo <- checkBox$ (left_fill '0' 4 (show$ i+517))++" "++algo -- create checkbox with tooltip: "0517 rep"..."0525 $compressed"
packTable table (widget disabledAlgo) (i `div` 3) (i `mod` 3) -- position it inside 3x3 table
return disabledAlgo
-- Ïðîäâèíóòûå/ýêñïåðèìåíòàëüíûå ìåòîäû
table <- createFrame "0534 Experimental algorithms" pack_horizontally (tableNew 3 2 False)
; lzma1g <- checkBox "0535 lzma:1gb"; packTable table (widget lzma1g ) 0 0
; exe2 <- checkBox "0536 exe2" ; packTable table (widget exe2 ) 0 1
; srep <- checkBox "0537 srep" ; packTable table (widget srep ) 0 2
; precomp <- checkBox "0538 precomp" ; precomp_table <- tableNew 2 1 False
; intense <- checkBox "0539 intense" ; packTable precomp_table (widget intense) 0 0
; jpeg <- checkBox "0540 jpeg" ; packTable precomp_table (widget jpeg ) 0 1
; frame <- frameNew; tableAttachDefaults table frame 1 2 0 3
; set frame [containerChild := precomp_table, frameLabelWidget := widget precomp, containerBorderWidth := 5]
-- Èíèöèàëèçàöèÿ ïîëåé: -m4 -ma+
let m=4
method =: (6-m) .$ clipTo 0 5
autodetect =: True
-- Îïóáëèêîâàòü îïèñàíèå ïåðâîíà÷àëüíî âûáðàííîãî ìåòîäà ñæàòèÿ è îáíîâëÿòü åãî ïðè èçìåíåíèÿõ íàñòðîåê
let parsePhysMem = parseMemWithPercents (toInteger getPhysicalMemory `roundTo` (4*mb))
let describeMethod = do
-- Ñíà÷àëà ïîìåíÿåì âèäèìîñòü êîíòðîëîâ
widgetSetSensitivity precomp_table =<< val precomp
m <- val method
d <- val dMethod
x <- val xMethod
let simpleMethod = show(if m==0 then 9 else 6-m) ++ (x&&&"x" ||| (d&&&"d"))
let compressor = simpleMethod.$ decode_method 1 []
.$ limitCompressionMem (parsePhysMem "75%")
.$ limitDecompressionMem (1*gb)
cmem = compressor.$ getCompressionMem
dmem = compressor.$ getMinDecompressionMem
let level = " ccm uharc 7-zip rar bzip2 zip"
cspeed = " 5mb/s 7-20mb/s 30mb/s 50mb/s 100mb/s 400mb/s" --m9,m5..m1
dspeed = d.$bool " 7-50mb/s 40mb/s 50-200mb/s 50-200mb/s 100-500mb/s 600mb/s" --m9,m5..m1
" 50mb/s 50mb/s 200mb/s 200mb/s 500mb/s 600mb/s" --m9x,m5x..m1x
labelSetMarkup methodText . deleteIf (=='_') . unlines =<< mapM i18fmt
[ ["0114 Compression level: %1", bold((words level!!m).$replace '_' ' ')]
, ["0115 Compression speed: %1, memory: %2", bold(words cspeed!!m), bold(showMem cmem)]
, ["0116 Decompression speed: %1, memory: %2", bold(words dspeed!!m), bold(showMem dmem)]
, [""]
, ["0526 All speeds were measured on i7-2600"]]
w1 <- i18n (levels!!m)
w2 <- i18n "0226 (fast, low-memory decompression)"
w3 <- i18n "0511 (fast decompression)"
autodetect' <- val autodetect
numThreadsOn' <- val numThreadsOn
numThreads' <- val numThreads
maxSolid' <- val maxSolid
solidBytesOn' <- val solidBytesOn
solidBytes' <- val solidBytes
solidFilesOn' <- val solidFilesOn
solidFiles' <- val solidFiles
solidByExtension' <- val solidByExtension
limitCMemOn' <- val limitCMemOn
limitCMem' <- val limitCMem
limitDMemOn' <- val limitDMemOn
limitDMem' <- val limitDMem
disabledList <- foreach (zip algos disabledAlgos) $ \(algo,disabledAlgo) -> do
disabled <- val disabledAlgo
return (disabled &&& ("-mc-"++algo))
lzma1g' <- val lzma1g
exe2' <- val exe2
srep' <- val srep
precomp' <- val precomp
intense' <- val intense
jpeg' <- val jpeg
let s = (maxSolid' &&& ";")++
(solidBytesOn' &&& clear solidBytes')++
(solidFilesOn' &&& (clear solidFiles'++"f"))++
(solidByExtension' &&& "e")
cmethod =: w1++(x&&&" "++w2 ||| (d&&&" "++w3))++": "++unwords(["-m"++(simpleMethod.$changeTo [("9","x")])]
++(not autodetect' &&& ["-ma-"])
++(numThreadsOn' &&& ["-mt"++clear numThreads'])
++(s &&& ["-s" ++s])
++(limitCMemOn' &&& ["-lc"++clear limitCMem'])
++(limitDMemOn' &&& ["-ld"++clear limitDMem'])
++(filter (not.null) disabledList)
++(lzma1g' &&& ["-mc:lzma/lzma:max:512mb"])
++(exe2' &&& ["-mc:exe/exe2"])
++(srep' &&& ["-mc:rep/maxsrep"])
++(precomp' &&& ["-mc$default,$obj:+"++(intense' &&& "max")++"precomp"++(jpeg' &&& "j")]))
--
describeMethod
describeMethod .$ setOnUpdate method
describeMethod .$ setOnUpdate maxSolid
describeMethod .$ setOnUpdate autodetect
describeMethod .$ setOnUpdate numThreadsOn
describeMethod .$ setOnUpdate numThreads
describeMethod .$ setOnUpdate limitCMemOn
describeMethod .$ setOnUpdate limitCMem
describeMethod .$ setOnUpdate limitDMemOn
describeMethod .$ setOnUpdate limitDMem
describeMethod .$ setOnUpdate solidBytesOn
describeMethod .$ setOnUpdate solidBytes
describeMethod .$ setOnUpdate solidFilesOn
describeMethod .$ setOnUpdate solidFiles
describeMethod .$ setOnUpdate solidByExtension
for (lzma1g:exe2:srep:precomp:intense:jpeg:disabledAlgos) (`setOnUpdate` describeMethod)
setOnUpdate dMethod $ do unlessM (val dMethod) (xMethod =: False); describeMethod -- disable 'x' if 'd' was disabled
setOnUpdate xMethod $ do whenM (val xMethod) (dMethod =: True); describeMethod -- enable 'd' if 'x' was enabled
-- Ñîõðàíåíèå èñòîðèè ñòðîêîâûõ ïîëåé è îáðàáîòêà íàæàòèÿ íà Save
let saveHistories = do
whenM (val numThreadsOn) $ do saveHistory numThreads
whenM (val limitCMemOn) $ do saveHistory limitCMem
whenM (val limitDMemOn) $ do saveHistory limitDMem
whenM (val solidBytesOn) $ do saveHistory solidBytes
whenM (val solidFilesOn) $ do saveHistory solidFiles
save `onClick` (saveHistories >> saveHistory cmethod)
-- Âîçâðàòèì âèäæåò ñòðîêè ââîäà ìåòîäà ñæàòèÿ è ïðîöåäóðó, êîòîðóþ íóæíî âûïîëíèòü ïðè íàæàòèè íà OK â äèàëîãå
return (cmethod, saveHistories)
{-
let simpleMethod = initSetting "simpleMethod" `defaultVal` "4"
m = case (take 1 simpleMethod) of [d] | isDigit d -> digitToInt d
_ -> 4
x = drop 1 simpleMethod == "x"
; solidBytes' <- val solidBytes; solidBytes' !~ "*b" &&& solidBytes =: solidBytes'++"b"
simpleMethod' <- getSimpleMethod
-}
-- |Compression level names
levels = [ "0108 Maximum",
"0109 High",
"0110 Normal",
"0111 Fast",
"0127 HDD-speed",
"0527 Instant"]
----------------------------------------------------------------------------------------------------
---- Çàêëàäêà øèôðîâàíèÿ -------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
encryptionPage fm' dialog okButton vbox = do
let pack x = boxPackStart vbox x PackNatural 1
(hbox, pwds) <- pwdBox 2; pack hbox -- Ñîçäà¸ò òàáëèöó ñ ïîëÿìè äëÿ ââîäà äâóõ ïàðîëåé
-- Ôðåéì øèôðîâàíèÿ.
vbox1 <- vBoxNew False 0
frame <- frameNew; s <- i18n"0119 Encryption"
set frame [containerChild := vbox1, frameLabel := s, containerBorderWidth := 5]
let pack1 x = boxPackStart vbox1 x PackNatural 1
boxPackStart vbox frame PackNatural 10
-- Àëãîðèòì øèôðîâàíèÿ.
(hbox, method) <- fmLabeledEntryWithHistory fm' "encryption" "0179 Encryption profile:"; pack1 hbox
; save <- button "0180 Save"; boxPackStart hbox (widget save) PackNatural 0
-- Íàñòðîéêè øèôðîâàíèÿ.
encryptHeaders <- checkBox "0120 Encrypt archive directory"; pack1 (widget encryptHeaders)
usePwd <- checkBox "0181 Use password"; pack1 (widget usePwd)
(hbox, keyfileOn, keyfile) <- fmFileBox fm' dialog
"akeyfile" FileChooserActionOpen
(checkBox "0123 Keyfile:")
"0124 Select keyfile"
aANYFILE_FILTER
(const$ return True)
(fmCanonicalizeDiskPath fm')
; createKeyfile <- button "0125 Create"
; boxPackStart hbox (widget createKeyfile) PackNatural 0; pack1 hbox
(hbox, encAlg) <- fmLabeledEntryWithHistory fm' "encryptor" "0121 Encryption algorithm:"; pack1 hbox
-- Íàñòðîéêè ðàñøèôðîâêè
(decryption, decryptionOnOK) <- decryptionBox fm' dialog
; boxPackStart vbox decryption PackNatural 10
-- Ðàçðåøàåì íàæàòü OK òîëüêî åñëè îáà ââåä¸ííûõ ïàðîëÿ îäèíàêîâû
let [pwd1,pwd2] = pwds
for pwds $ flip afterKeyRelease $ \e -> do
[pwd1', pwd2'] <- mapM val pwds
okButton `widgetSetSensitivity` (pwd1'==pwd2')
return False
-- Ñîçäàòü íîâûé ôàéë-êëþ÷, çàïèñàâ êðèïòîãðàôè÷åñêè ñëó÷àéíûå äàííûå â óêàçàííûé ïîëüçîâàòåëåì ôàéë
createKeyfile `onClick` do
let default_keyfile = do fm <- val fm'; return$ fm_curdir fm </> "new.key"
chooseFile dialog FileChooserActionSave "0126 Create new keyfile" aANYFILE_FILTER default_keyfile $ \filename -> do
--to do: fileChooserSetDoOverwriteConfirmation chooserDialog True
filePutBinary filename =<< generateRandomBytes 1024
keyfile =: filename
keyfileOn =: True
-- Èíèöèàëèçàöèÿ: ïðî÷èòàåì ïàðîëè èç ãëîáàëüíûõ ïåðåìåííûõ
pwd1 =:: val encryptionPassword
pwd2 =:: val encryptionPassword
-- Ñîõðàíåíèå èñòîðèè ñòðîêîâûõ ïîëåé è îáðàáîòêà íàæàòèÿ íà Save
let saveHistories = do
whenM (val keyfileOn) $ do saveHistory keyfile
saveHistory encAlg
--
save `onClick` (saveHistories >> saveHistory method)
-- Äåéñòâèÿ, âûïîëíÿåìûå ïðè íàæàòèè êíîïêè OK
let onOK = do
saveHistories
encryptionPassword =:: val pwd1
decryptionOnOK
-- Ôîðìèðóåò ïðîôèëü øèôðîâàíèÿ è âûçûâàåòñÿ ïðè èçìåíåíèè ëþáûõ îïöèé â ýòîì ôðåéìå
let makeProfile = do
usePwd' <- val usePwd
keyfileOn' <- val keyfileOn
keyfile' <- val keyfile
encAlg' <- val encAlg
encryptHeaders' <- val encryptHeaders
method =: unwords( (encryptHeaders' &&& ["-hp"])++
(usePwd' &&& ["-p?"])++
["--encryption="++clear encAlg']++
(keyfileOn' &&& ["--keyfile=" ++clear keyfile']))
--
makeProfile
makeProfile .$ setOnUpdate usePwd
makeProfile .$ setOnUpdate keyfileOn
makeProfile .$ setOnUpdate keyfile
makeProfile .$ setOnUpdate encAlg
makeProfile .$ setOnUpdate encryptHeaders
-- Âîçâðàòèì ìåòîä íàçíà÷åíèÿ ðåàêöèè íà èçìåíåíèå íàñòðîåê øèôðîâàíèÿ è ïðîöåäóðó, âûïîëíÿåìóþ ïðè íàæàòèè íà OK
return (method, onOK)
----------------------------------------------------------------------------------------------------
---- Ôðåéì ðàñøèôðîâêè -----------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
decryptionBox fm' dialog = do
vbox <- vBoxNew False 0
decryptionFrame <- frameNew; s <- i18n"0144 Decryption"
set decryptionFrame [containerChild := vbox, frameLabel := s, containerBorderWidth := 5]
lbl <- label "0074 Enter password:"
pwd <- entryNew --newTextViewWithText
; set pwd [entryVisibility := False, entryActivatesDefault := True]
(keyfileBox, _, keyfile) <- fmFileBox fm' dialog
"keyfile" FileChooserActionOpen
(label "0123 Keyfile:")
"0124 Select keyfile"
aANYFILE_FILTER
(const$ return True)
(fmCanonicalizeDiskPath fm')
hbox <- hBoxNew False 0
; boxPackStart hbox (widget lbl) PackNatural 0
; boxPackStart hbox pwd PackGrow 5
boxPackStart vbox hbox PackNatural 0
boxPackStart vbox keyfileBox PackNatural 5
-- Ïðî÷èòàåì ïàðîëè èç ãëîáàëüíûõ ïåðåìåííûõ
pwd =:: val decryptionPassword
-- Äåéñòâèå, âûïîëíÿåìîå ïðè íàæàòèè íà OK. Âîçâðàùàåò îïöèè, êîòîðûå íóæíî äîáàâèòü ê êîìàíäíîé ñòðîêå
let onOK = do decryptionPassword =:: val pwd
saveHistory keyfile
fmGetDecryptionOptions fm'
--
return (decryptionFrame, onOK)
----------------------------------------------------------------------------------------------------
---- Âñïîìîãàòåëüíûå îïðåäåëåíèÿ -------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- |Ðåæèìû äèàëîãîâ
data DialogMode = EncryptionMode | ProtectionMode | RecompressMode | CommentMode | MakeSFXMode | NoMode deriving Eq
-- |Îïðåäåëÿåò òî, êàê èìåíà êàòàëîãîâ ïîäñòàâëÿþòñÿ â êîìàíäû
addCmdFiles dirname = [dirname++[pathSeparator]]
xCmdFiles dirname = [dirname++[pathSeparator]++"*"]
dCmdFiles dirname = [dirname, dirname++[pathSeparator]++"*"]
-- |Âûïîëíèòü îïåðàöèþ íàä òåêóùèì àðõèâîì/âñåìè îòìå÷åííûìè ôàéëàìè íà äèñêå
compressionOperation fm' action exec winoptions cmd mode = do
fm <- val fm'
files <- if isFM_Archive fm then return [fm_arcname fm]
else getSelection fm' addCmdFiles -- todo: j/ch êîãäà Selection âêëþ÷àåò êàòàëîãè
action fm' exec winoptions cmd files mode
-- |Âûïîëíèòü îïåðàöèþ íàä âûáðàííûìè ôàéëàìè â àðõèâå/âñåìè ôàéëàìè â âûáðàííûõ àðõèâàõ
archiveOperation fm' action = do
fm <- val fm'
files <- getSelection fm' (if isFM_Archive fm then xCmdFiles else const [])
if isFM_Archive fm
then action [fm_arcname fm] (fm_arcdir fm) files
else do fullnames <- mapM (fmCanonicalizePath fm') files
action fullnames "" []
-- |Âûïîëíÿåò îïåðàöèþ, êîòîðîé íóæíî ïåðåäàòü òîëüêî èìåíà àðõèâîâ
multiArchiveOperation fm' action = do
fm <- val fm'
if isFM_Archive fm
then action [fm_arcname fm]
else do files <- getSelection fm' (const [])
fullnames <- mapM (fmCanonicalizePath fm') files
action fullnames
-- |Îáíîâèòü ñîäåðæèìîå ïàíåëè ôàéë-ìåíåäæåðà àêòóàëüíûìè äàííûìè
refreshCommand fm' = do
fm <- val fm'
curfile <- fmGetCursor fm'
selected <- getSelection fm' (:[])
-- Îáíîâèì ñîäåðæèìîå êàòàëîãà/àðõèâà è âîññòàíîâèì òåêóùèé ôàéë è ñïèñîê îòìå÷åííûõ
closeFMArc fm'
fmChdir fm' (fm_current fm)
when (selected>[]) $ do
fmSetCursor fm' curfile
fmUnselectAll fm'
fmSelectFilenames fm' ((`elem` selected).fmname)
-- |Ïðîñìîòðåòü ôàéë
runViewCommand = runEditCommand
-- |Ðåäàêòèðîâàòü ôàéë
runEditCommand filename = run (iif isWindows "notepad" "gedit") [filename]
where run cmd params = forkIO (rawSystem cmd params >> return ()) >> return ()
-- edit filename | isWindows && takeExtension filename == "txt" = todo: direct shell open command
-- |Ïîìåñòèì âñå êîíòðîëû â ñèìïàòè÷íûé notebook è âîçâðàòèì ïðîöåäóðó ñîçäàíèÿ íîâûõ ñòðàíèö â í¸ì
startNotebook dialog = do
upbox <- dialogGetUpper dialog
nb <- notebookNew; boxPackStart upbox nb PackGrow 0
let newPage name = do hbox <- hBoxNew False 0; notebookAppendPage nb hbox =<< i18n name
vbox <- vBoxNew False 0; boxPackStart hbox vbox PackGrow 5
return vbox
return (nb,newPage)
-- |Áåð¸ò îáû÷íûé vbox è âîçâðàùàåò vbox âíóòðè ñêðîëëåðà
createScroller vbox = do
scrolledWindow <- scrolledWindowNew Nothing Nothing
boxPackStart vbox scrolledWindow PackGrow 1
vbox <- vBoxNew False 0
scrolledWindowAddWithViewport scrolledWindow vbox
scrolledWindowSetPolicy scrolledWindow PolicyAutomatic PolicyAutomatic
Just viewport <- binGetChild scrolledWindow
viewportSetShadowType (castToViewport viewport) ShadowNone
return vbox
-- |Ñîçäà¸ò ðàìêó ñ çàäàííûì êîíòðîëîì âíóòðè
createFrame label pack makeControl = do
frame <- frameNew; pack frame; s <- i18n label; control <- makeControl
set frame [containerChild := control, frameLabel := s, containerBorderWidth := 5]
return control
-- |Ïîìåùàåò êîíòðîë w â òàáëèöó t íà êëåòêó x,y
packTable t w x y = tableAttachDefaults t w x (x+1) y (y+1)
-- |Âûïîëíèòü îïåðàöèþ ñ èñïîëüçîâàíèåì âðåìåííîãî ôàéëà, êóäà çàïèñûâàþòñÿ äàííûå contents
withTempFile contents = withTemporary (`filePutBinary` contents) fileRemove
-- |Âûïîëíèòü îïåðàöèþ ñ èñïîëüçîâàíèåì âðåìåííîãî êàòàëîãà
withTempDir = withTemporary createDirectoryHierarchy (dirRemoveRecursive forcedFileRemove)
-- |Âûïîëíèòü îïåðàöèþ ñ èñïîëüçîâàíèåì âðåìåííîãî ôàéëà/êàòàëîãà
withTemporary preAction postAction action = do
tempDir <- getTempDir
createDirectoryHierarchy tempDir
fix $ \tryNext -> do n <- generateRandomBytes 4 >>== encode16
let tempname = tempDir </> ("freearc"++n++".tmp")
e <- fileOrDirExist tempname
if e then tryNext
else do preAction tempname
ensureCtrlBreak "remove temporary files" (ignoreErrors$ postAction tempname) $ do
action tempname
-- |Íàéòè âñå âðåìåííûå ôàéëû, ñîçäàííûå FreeArc
findTempFiles = do
tempDir <- getTempDir
files <- dir_list tempDir
return (files .$filter (isFreeArcTemporary.baseName) .$map diskName)
-- |Check that it's "temporary" FreeArc instance - either current directory or any argument is inside tempdir
isTemporaryInstance args = do
curdir <- getCurrentDirectory
tempDir <- getTempDir
return$ any (`isInsideDir` tempDir) (curdir:args)
-- |Check that `filename` is inside temporary directory
isTempFile filename = do
tempDir <- getTempDir
return (filename `isInsideDir` tempDir)
-- |Check that 'file' is inside `dir`
file `isInsideDir` dir =
splitDirectories dir `isPrefixOf` splitDirectories file