forked from svn2github/freearc
-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathFileManDialogAdd.hs
314 lines (288 loc) · 16.9 KB
/
FileManDialogAdd.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
{-# OPTIONS_GHC -cpp #-}
----------------------------------------------------------------------------------------------------
---- FreeArc archive manager: Add dialog ------
----------------------------------------------------------------------------------------------------
module FileManDialogAdd where
import Prelude hiding (catch)
import Control.Concurrent
import Control.Exception
import Control.Monad
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 System.Time
import Graphics.UI.Gtk
import Graphics.UI.Gtk.ModelView as New
import Utils
import Errors
import Files
import FileInfo
import Charsets (i18n)
import Compression
import Encryption
import Options
import UI
import ArhiveStructure
import ArhiveDirectory
import ArcExtract
import ArcCreate
import FileManPanel
import FileManUtils
import FileManDialogs
----------------------------------------------------------------------------------------------------
---- Äèàëîã óïàêîâêè ôàéëîâ è ìîäèôèêàöèè/ñëèÿíèÿ àðõèâîâ ------------------------------------------
----------------------------------------------------------------------------------------------------
addDialog fm' exec cmd files mode = do
--start_time <- getClockTime
fm <- val fm'
if isFM_Archive fm && cmd=="a" then fmErrorMsg fm' "0133 You can't compress files directly from archive!" else do
if isFM_Archive fm && cmd=="j" then fmErrorMsg fm' "0145 You can't join archives directly from archive!" else do
title <- i18n$ case (cmd,files) of
("a" , [] ) -> "0136 Add all files to archive"
("a" , [file]) -> "0134 Add %1 to archive"
("a" , _ ) -> "0135 Add %2 files to archive"
("ch", [] ) -> "0146 Modify all archives"
("ch", [file]) -> "0147 Modify %1"
("ch", _ ) -> "0148 Modify %2 archives"
("j" , [] ) -> "0149 Join all archives"
("j" , [file]) -> "0150 Join %1 with another archive"
("j" , _ ) -> "0151 Join %2 archives"
("cvt",[file]) -> "0428 Convert %1 to FreeArc format"
("cvt",_ ) -> "0429 Convert %2 archives to FreeArc format"
let wintitle = formatn title [head files, show3$ length files]
-- Ñîçäàäèì äèàëîã ñî ñòàíäàðòíûìè êíîïêàìè OK/Cancel
fmDialog fm' wintitle [AddDetachButton] $ \(dialog,okButton) -> do
fmCacheConfigFile fm' $ do
(nb,newPage) <- startNotebook dialog
------ Ãëàâíàÿ çàêëàäêà ----------------------------------------------------------------------
vbox <- newPage "0182 Main"; let pack x = boxPackStart vbox x PackNatural 1
------ Àðõèâ è êàòàëîã â í¸ì ----------------------------------------------------------------------
(hbox, _, arcname) <- fmOutputArchiveFileBox fm' dialog; pack hbox `on` (cmd `notElem` words "ch cvt")
(hbox, arcpath) <- fmLabeledEntryWithHistory fm' "arcpath" "0141 Base directory inside archive:"; pack hbox `on` cmd=="a"
ep <- fmExcludePaths; pack (widget ep) `on` cmd=="a"
updateMode <- fmUpdateMode; pack (widget updateMode) `on` cmd=="a"
------ Compression/Encryption/Protection ----------------------------------------------------------------------
(hbox, compression, compressionMethod) <- fmCheckedEntryWithHistory fm' "compression" "0183 Compression:"; pack hbox
(hbox, encryption, encryptionMethod) <- fmCheckedEntryWithHistory fm' "encryption" "0184 Encryption:" ; pack hbox
(hbox, protection, protectionMethod) <- fmCheckedEntryWithHistory fm' "protection" "0185 Protection:" ; pack hbox
(hbox, comment, commentFile) <- fmCheckedEntryWithHistory fm' "comment" "0186 Comment:" ; pack hbox
(hbox, makeSFX, sfxFile) <- fmCheckedEntryWithHistory fm' "sfx" "0227 Make EXE:" ; pack hbox
-- The rest
testAfter <- checkBox "0128 Test archive after operation"; pack (widget testAfter)
deleteFiles <- checkBox "0122 Delete files successfully archived"; pack (widget deleteFiles) `on` cmd=="a"
lock <- checkBox "0187 Finalize archive"; pack (widget lock)
(hbox, options, optionsStr) <- fmCheckedEntryWithHistory fm' "options" "0072 Additional options:"; pack hbox
------ Çàêëàäêà àðõèâíûõ îïöèé ----------------------------------------------------------------------
vbox <- newPage "0200 Archive"; let pack x = boxPackStart vbox x PackNatural 1
separate <- checkBox "0201 Compress each marked file/directory into separate archive"; pack (widget separate) `on` cmd=="a"
(hbox, ag, agTemplate) <- fmCheckedEntryWithHistory fm' "ag" "0202 Add to archive name:"; pack hbox `on` cmd/="ch"
archiveTimeMode <- comboBox "0203 Set archive time to:"
[ "0204 Current system time"
, "0205 Original archive time"
, "0206 Latest file time" ]; pack (widget archiveTimeMode)
create <- checkBox "0207 Delete previous archive contents"; pack (widget create) `on` cmd/="ch"
(hbox, sort, sortOrder) <- fmCheckedEntryWithHistory fm' "sort" "0208 Order of files in archive:"; pack hbox `on` (cmd `elem` words "a cvt")
recompressMode <- comboBox "0209 Recompression mode:"
[ "0210 Quickly append new files"
, "0211 Smart recompression of solid blocks (default)"
, "0212 Recompress all files"
, "0213 Store only fileinfo"
, "0214 Store only fileinfo & crcs"
, "0215 No archive headers" ]; pack (widget recompressMode)
backupMode <- comboBox "0216 Backup mode:"
[ "0217 No (default)"
, "0218 Full: clear \"Archive\" attribute of files succesfully archived"
, "0219 Differential: select only files with \"Archive\" attribute set"
, "0220 Incremental: select by \"Archive\" attribute & clear it after compression" ]; pack (widget backupMode) `on` (cmd `notElem` words "ch cvt")
------ Çàêëàäêà îòáîðà ôàéëîâ ----------------------------------------------------------------------
vbox <- newPage "0221 Files"; let pack x = boxPackStart vbox x PackNatural 1
(hbox, include, includeMasks) <- fmCheckedEntryWithHistory fm' "include" "0222 Include only files:"; pack hbox
(hbox, exclude, excludeMasks) <- fmCheckedEntryWithHistory fm' "exclude" "0223 Exclude files:"; pack hbox
(hbox, larger, largerSize) <- fmCheckedEntryWithHistory fm' "larger" "0224 Include only files larger than:"; pack hbox
(hbox, smaller, smallerSize) <- fmCheckedEntryWithHistory fm' "smaller" "0225 Include only files smaller than:"; pack hbox
--times: -tn/to/ta/tb
------ Çàêëàäêà ñæàòèÿ ------------------------------------------------------------------------
(onCompressionChanged, saveCompressionHistories) <- compressionPage fm' =<< newPage "0106 Compression"
onCompressionChanged (compressionMethod =:)
------ Çàêëàäêà øèôðîâàíèÿ ------------------------------------------------------------------------
(onEncryptionChanged, encryptionOnOk) <- encryptionPage fm' dialog okButton =<< newPage "0119 Encryption"
onEncryptionChanged (encryptionMethod =:)
------ Çàêëàäêà àðõèâíîãî êîììåíòàðèÿ --------------------------------------------------------------------------
vbox <- newPage "0199 Comment"; let pack x = boxPackStart vbox x PackGrow 1
commentText <- scrollableTextView "" []; pack (widget commentText)
------ Èíèöèàëèçàöèÿ ïîëåé --------------------------------------------------------------------------
compression =: mode==RecompressMode || (cmd `elem` words "a cvt")
encryption =: mode==EncryptionMode
protection =: mode==ProtectionMode
comment =: mode==CommentMode
makeSFX =: mode==MakeSFXMode
ep =: 2
updateMode =: 0
archiveTimeMode =: 0
recompressMode =: 1
backupMode =: 0
-- Èìÿ ñîçäàâàåìîãî ïî óìîë÷àíèþ àðõèâà çàâèñèò îò èì¸í àðõèâèðóåìûõ ôàéëîâ/ñëèâàåìûõ àðõèâîâ
arcnameBase <- case files of
[file] -> do let realname = dropTrailingPathSeparator file
isFile <- fileExist realname
return$ if isFile then dropExtension realname -- îäèí ôàéë - èçáàâèìñÿ îò ðàñøèðåíèÿ
else realname -- îäèí êàòàëîã - èçáàâèìñÿ îò ñëåøà â êîíöå
_ -> return$ takeFileName (fm_curdir fm) -- ìíîãî ôàéëîâ - èñïîëüçóåì èìÿ òåêóùåãî êàòàëîãà
arcname =: if isFM_Archive fm then fm_arcname fm
else (arcnameBase ||| "archive") ++ aDEFAULT_ARC_EXTENSION
arcpath =: ""
------ ×òåíèå çíà÷åíèé ïîëåé è ñîõðàíåíèå èõ äëÿ èñòîðèè ------------------------------------------
widgetShowAll dialog
--current_time <- getClockTime; debugMsg (show$ diffTimes current_time start_time)
choice <- fmDialogRun fm' dialog "AddDialog"
when (choice `elem` [ResponseOk, aResponseDetach]) $ do
-- Çàïóñòèòü êîìàíäó â îòäåëüíîé êîïèè FreeArc?
let detach = (choice == aResponseDetach)
-- Main settings
arcname' <- val arcname; saveHistory arcname `on` (cmd `notElem` words "ch cvt")
arcpath' <- val arcpath; saveHistory arcpath `on` cmd=="a"
-- Åñëè "èìÿ àðõèâà" íà ñàìîì äåëå óêàçûâàåò êàòàëîã âíóòðè àðõèâà, òî íå óäàðèì â ãðÿçü ëèöîì :)
x <- splitArcPath fm' arcname'
(arcname', arcpath') <- return$ case x of
ArcPath arc path -> (arc, path </> arcpath')
_ -> (arcname', arcpath')
ep' <- val ep
updateMode' <- val updateMode
testAfter' <- val testAfter
deleteFiles' <- val deleteFiles
optionsEnabled <- val options
; optionsStr' <- val optionsStr; saveHistory optionsStr `on` optionsEnabled
compressionEnabled <- val compression
; compressionMethod' <- val compressionMethod; saveHistory compressionMethod `on` compressionEnabled
encryptionEnabled <- val encryption
; encryptionMethod' <- val encryptionMethod; saveHistory encryptionMethod `on` encryptionEnabled
protectionEnabled <- val protection
; protectionMethod' <- val protectionMethod; saveHistory protectionMethod `on` protectionEnabled
commentEnabled <- val comment
; commentFile' <- val commentFile; saveHistory commentFile `on` commentEnabled
; commentText' <- val commentText
sfxEnabled <- val makeSFX
; sfxFile' <- val sfxFile; saveHistory sfxFile `on` sfxEnabled
-- Archive settings
separate' <- val separate
agEnabled <- val ag
; agTemplate' <- val agTemplate; saveHistory agTemplate `on` agEnabled
archiveTimeMode' <- val archiveTimeMode
lock' <- val lock
create' <- val create
sortEnabled <- val sort
; sortOrder' <- val sortOrder; saveHistory sortOrder `on` sortEnabled
recompressMode' <- val recompressMode
backupMode' <- val backupMode
-- File selection settings
includeEnabled <- val include
; includeMasks' <- val includeMasks; saveHistory includeMasks `on` includeEnabled
excludeEnabled <- val exclude
; excludeMasks' <- val excludeMasks; saveHistory excludeMasks `on` excludeEnabled
largerEnabled <- val larger
; largerSize' <- val largerSize; saveHistory largerSize `on` largerEnabled
smallerEnabled <- val smaller
; smallerSize' <- val smallerSize; saveHistory smallerSize `on` smallerEnabled
-- Compression/encryption/decryption settings
saveCompressionHistories
encryptionOptions <- encryptionOnOk (encryptionEnabled &&& encryptionMethod')
{-
-- Çàïîìíèì íàñòðîéêè â èñòîðèè
fmAddHistory fm' "acmd"$ joinWith "," [ "simpleMethod=" ++simpleMethod'
, "akeyfile=" ++keyfile'
, "xkeyfile=" ++xkeyfile'
, "encryptHeaders="++show encryptHeaders'
, "testAfter=" ++show testAfter']
-}
-- Îòîáðàçèì èçìåíåíèå èìåíè àðõèâà
when sfxEnabled $ do
when (isFM_Archive fm) $ do
let newname' = changeSfxExt True (clear sfxFile') arcname'
when (newname'/=arcname') $ do
fmChangeArcname fm' newname'
------ Ôîðìèðîâàíèå âûïîëíÿåìîé êîìàíäû/êîìàíä ----------------------------------------------------
let msgs = case cmd of
"ch"-> ["0237 Modifying %1",
"0238 SUCCESFULLY MODIFIED %1",
"0239 %2 WARNINGS WHILE MODIFYING %1"]
"j" -> ["0240 Joining archives to %1",
"0241 SUCCESFULLY JOINED ARCHIVES TO %1",
"0242 %2 WARNINGS WHILE JOINING ARCHIVES TO %1"]
_ -> ["0243 Adding to %1",
"0244 FILES SUCCESFULLY ADDED TO %1",
"0245 %2 WARNINGS WHILE ADDING TO %1"]
let options =
-- Main page settings
(compressionEnabled &&& cvt "-m" compressionMethod')++
(encryptionEnabled &&& cvt "-ae=" encryptionMethod')++encryptionOptions++
(protectionEnabled &&& cvt "-rr" protectionMethod')++
(commentEnabled &&& [((clear commentFile' !~ "-z*" &&& "--archive-comment=")++) (clear commentFile' ||| commentText')])++
(sfxEnabled &&& cvt "-sfx" sfxFile')++
(testAfter' &&& ["-t"])++
(deleteFiles' &&& ["-d"])++
(null files &&& ["-r"])++
(arcpath' &&& ["-ap"++clear arcpath'])++
(ep' `select` "-ep,-ep1,,-ep2,-ep3")++
(updateMode' `select` ",-u,-f,--sync")++
-- Archive settings
(lock' &&& ["-k"])++
(agEnabled &&& ["-ag"++clear agTemplate'])++
(sortEnabled &&& ["-ds"++clear sortOrder'])++
(archiveTimeMode' `select` ",-tk,-tl")++
(backupMode' `select` ",-ac,-ao,-ac -ao")++
(recompressMode' `select` "--append,,--recompress,--nodata,--crconly,--nodir")++
((cmd `notElem` words "a cvt") &&& (compressionEnabled || encryptionEnabled) &&& ["--recompress"])++
-- File selection settings
(includeEnabled &&& cvt1 "-n" includeMasks')++
(excludeEnabled &&& cvt1 "-x" excludeMasks')++
(largerEnabled &&& ["-sm"++clear largerSize'])++
(smallerEnabled &&& ["-sl"++clear smallerSize'])++
-- Other
(cmd/="cvt" &&& ["-dp"++fm_curdir fm])++
(cmd=="ch" &&& ["--noarcext"])++
(optionsEnabled &&& words (clear optionsStr'))
--
let command archive filelist =
[if create' then "create" else cmd] ++ options ++ ["--", clear archive] ++ filelist
--
if cmd=="cvt" then
do all2arc <- all2arc_path
Files.runCommand (unparseCommand$ [all2arc] ++ options ++ ["--"] ++ files) (fm_curdir fm) False
else do
exec detach$
if cmd=="ch" then (files ||| ["*"]) .$map (\archive -> command (fm_curdir fm </> archive) [])
else if separate' then files.$map (\file -> command (fm_curdir fm </> dropTrailingPathSeparator file++aDEFAULT_ARC_EXTENSION) [file])
else [command arcname' files]
----------------------------------------------------------------------------------------------------
---- Âñïîìîãàòåëüíûå îïðåäåëåíèÿ -------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- |Ïîëå âûáîðà èìåíè âûõîäíîãî àðõèâà
fmOutputArchiveFileBox fm' dialog =
fmFileBox fm' dialog
"arcname" FileChooserActionSave
(label "0131 Output archive:")
"0132 Select output archive"
aARCFILE_FILTER
(const$ return True)
(fmCanonicalizeDiskPath fm')
-- |Ïîëå âûáîðà îïöèè -ep
fmExcludePaths =
comboBox "0188 Store file paths:"
[ "0189 No"
, "0190 Relative to compressed dir"
, "0191 Relative to curdir (default)"
, "0192 Absolute (relative to root dir)"
, "0193 Full (including drive letter)" ]
-- |Ïîëå âûáîðà ðåæèìà îáíîâëåíèÿ.
fmUpdateMode =
comboBox "0194 Update mode:"
[ "0195 Add and replace files (default)"
, "0196 Add and update files"
, "0197 Fresh existing files"
, "0198 Synchronize archive with disk contents" ]