forked from svn2github/freearc
-
Notifications
You must be signed in to change notification settings - Fork 1
/
FileManPanel.hs
583 lines (512 loc) · 24.4 KB
/
FileManPanel.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
----------------------------------------------------------------------------------------------------
---- FreeArc archive manager: file manager panel ------
----------------------------------------------------------------------------------------------------
module FileManPanel 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.Time
import Graphics.UI.Gtk
import Graphics.UI.Gtk.ModelView as New
import Utils
import Errors
import Files
import FileInfo
import Charsets
import Options
import Cmdline
import UIBase
import UI
import ArhiveDirectory
import FileManUtils
-- |Ïàðîëè øèôðîâàíèÿ è ðàñøèôðîâêè
encryptionPassword = unsafePerformIO$ newIORef$ ""
decryptionPassword = unsafePerformIO$ newIORef$ ""
----------------------------------------------------------------------------------------------------
---- Îïåðàöèè ôàéë-ìåíåäæåðà -----------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- |Ñîçäàòü ôèêòèâíóþ ïàíåëü ôàéë-ìåíåäæåðà (äëÿ ïðÿìîãî âûçîâà äèàëîãîâ èç êîì. ñòðîêè)
newEmptyFM = do
history <- openHistoryFile
curdir <- getCurrentDirectory
fm' <- mvar FM_State { fm_window_ = Nothing
, fm_view = error "undefined FM_State::fm_view"
, fm_model = error "undefined FM_State::fm_model"
, fm_selection = error "undefined FM_State::fm_selection"
, fm_statusLabel = error "undefined FM_State::fm_statusLabel"
, fm_messageCombo = error "undefined FM_State::fm_messageCombo"
, fm_filelist = error "undefined FM_State::fm_filelist"
, fm_history = history
, fm_onChdir = []
, fm_sort_order = ""
, subfm = FM_Directory {subfm_dir=curdir}}
return fm'
-- |Ñîçäàòü ïåðåìåííóþ äëÿ õðàíåíèÿ ñîñòîÿíèÿ ôàéë-ìåíåäæåðà
newFM window view model selection statusLabel messageCombo = do
fm' <- newEmptyFM
messageCounter <- ref 0 -- number of last message + 1 in combobox
fm' .= (\fm -> fm { fm_window_ = Just window
, fm_view = view
, fm_model = model
, fm_selection = selection
, fm_statusLabel = statusLabel
, fm_messageCombo = (messageCombo, messageCounter)})
selection `New.onSelectionChanged` fmStatusBarTotals fm'
return fm'
-- |Îòêðûòü àðõèâ è âîçâðàòèòü åãî êàê îáúåêò ñîñòîÿíèÿ ôàéë-ìåíåäæåðà
newFMArc fm' arcname arcdir = do
xpwd' <- val decryptionPassword
xkeyfile' <- fmGetHistory1 fm' "keyfile" ""
[command] <- parseCmdline$ ["l", arcname]++(xpwd' &&& ["-op"++xpwd'])
++(xkeyfile' &&& ["--OldKeyfile="++xkeyfile'])
command <- (command.$ opt_cook_passwords) command ask_passwords -- ïîäãîòîâèòü ïàðîëè â êîìàíäå ê èñïîëüçîâàíèþ
archive <- archiveReadInfo command "" "" (const True) doNothing2 arcname
let filetree = buildTree$ map (fiToFileData.cfFileInfo)$ arcDirectory archive
arcClose archive
return$ FM_Archive archive arcname arcdir filetree
-- |Çàêðûòü ôàéë àðõèâà ÷òîáû 1) äðóãèå îïåðàöèè ñìîãëè ìîäèôèöèðîâàòü åãî,
-- 2) åãî ñîäåðæèìîå áûëî ïåðå÷èòàíî çàíîâî ïðè ñëåäóþùåì èñïîëüçîâàíèè
closeFMArc fm' = do
fm <- val fm'
--arcClose (fm_archive fm)
when (isFM_Archive fm) $ do
fm' .= \fm -> fm {subfm = (subfm fm) {subfm_archive = phantomArc}}
-- Ïåðåéòè â àðõèâ/êàòàëîã filename
chdir fm' filename' = do
fm <- val fm'
filename <- fmCanonicalizePath fm' filename'
res <- splitArcPath fm' filename
msg <- i18n"0071 %1: no such file or directory!"
if res==Not_Exists then fmErrorMsg fm' (format msg filename) else do
(files, sub) <- case res of
-- Ñïèñîê ôàéëîâ â êàòàëîãå íà äèñêå
DiskPath dir -> do filelist <- dir_list dir
return (map fiToFileData filelist, FM_Directory dir)
-- Ñïèñîê ôàéëîâ â àðõèâå
ArcPath arcname arcdir -> do
arc <- if isFM_Archive fm && arcname==fm_arcname fm && not (arcPhantom (fm_archive fm))
then return ((fm.$subfm) {subfm_arcdir=arcdir})
else newFMArc fm' arcname arcdir
return (arc.$subfm_filetree.$ftFilesIn arcdir fdArtificialDir, arc)
-- Çàïèøåì òåêóùèé êàòàëîã/àðõèâ â fm è âûâåäåì íà ýêðàí íîâûé ñïèñîê ôàéëîâ
fm' =: fm {subfm = sub}
fmSetFilelist fm' (files.$ sortOnColumn (fm_sort_order fm))
-- Îáíîâèì ñòàòóñáàð è âûïîëíèì âñå îñòàëüíûå çàïðîãðàììèðîâàííûå äåéñòâèÿ.
sequence_ (fm_onChdir fm)
widgetGrabFocus (fm_view fm)
-- Îòîáðàçèòü èçìåíåíèå èìåíè àðõèâà
fmChangeArcname fm' newname = do
fm' .= fm_changeArcname newname
fm <- val fm'
sequence_ (fm_onChdir fm)
-- |Äîáàâèòü action â ñïèñîê îïåðàöèé, âûïîëíÿåìûõ ïðè ïåðåõîäå â äðóãîé êàòàëîã/àðõèâ
fmOnChdir fm' action = do
fm' .= \fm -> fm {fm_onChdir = action : fm_onChdir fm}
-- |Âûâåñòè â ñòðîêó ñîîáùåíèé èíôîðìàöèþ îá îáùåì îáú¸ìå ôàéëîâ è ñêîëüêî èç íèõ âûáðàíî
fmStatusBarTotals fm' = do
fm <- val fm'
selected <- getSelectionFileInfo fm'
[sel,total] <- i18ns ["0022 Selected %1 bytes in %2 file(s)", "0023 Total %1 bytes in %2 file(s)"]
let format msg files = formatn msg [show3$ sum$ map fdSize files, show3$ length files]
fmStatusBarMsg fm' $ (selected &&& (format sel selected++" "))
++ format total (fm_filelist fm)
-- |Âûâåñòè èíôîðìàöèþ â ñòàòóñ-ñòðîêó
fmStatusBarMsg fm' msg = do
fm <- val fm'
labelSetText (fm_statusLabel fm) msg
return ()
-- |Äîáàâèòü ñîîáùåíèå â pop-up ñïèñîê ñîîáùåíèé
fmStackMsg fm' emsg = do
fm <- val fm'
let (box,n') = fm_messageCombo fm
n <- val n'; n' += 1
current_time <- getClockTime
let timestr = showtime "%H:%M:%S " current_time
imsg <- i18n emsg
New.comboBoxAppendText box (imsg &&& (timestr++imsg))
New.comboBoxSetActive box n
return ()
-- |Èìÿ ôàéëà, íàõîäÿùåãîñÿ ïî çàäàííîìó ïóòè
fmFilenameAt fm' path = fmname `fmap` fmFileAt fm' path
-- |Ôàéë, íàõîäÿùèéñÿ ïî çàäàííîìó ïóòè
fmFileAt fm' path = do
fm <- val fm'
let fullList = fm_filelist fm
return$ fullList!!head path
-- |Âîçâðàòèòü ôàéë ïîä êóðñîðîì
fmGetCursor fm' = do
fm <- val fm'
let fullList = fm_filelist fm
(cursor,_) <- New.treeViewGetCursor (fm_view fm)
case cursor of
[i] -> return (fdBasename$ fullList!!i)
_ -> return ""
-- |Óñòàíîâèòü êóðñîð íà çàäàííûé ôàéë
fmSetCursor fm' filename = do
fm <- val fm'
whenJustM_ (fmFindCursor fm' filename)
(\cursor -> New.treeViewSetCursor (fm_view fm) cursor Nothing)
-- |Âîçâðàòèòü êóðñîð äëÿ ôàéëà ñ çàäàííûì èìåíåì
fmFindCursor fm' filename = do
fm <- val fm'
let fullList = fm_filelist fm
return (fmap (:[])$ findIndex ((filename==).fmname) fullList)
-- |Âûâåñòè íà ýêðàí íîâûé ñïèñîê ôàéëîâ
fmSetFilelist fm' files = do
fm <- val fm'
fm' =: fm {fm_filelist = files}
changeList (fm_model fm) (fm_selection fm) files
-- |Âûâåñòè ñîîáùåíèå îá îøèáêå
fmErrorMsg fm' msg = do
fm <- val fm'
msgBox (fm_window fm) MessageError msg
-- |Âûâåñòè èíôîðìàöèîííîå ñîîáùåíèå
fmInfoMsg fm' msg = do
fm <- val fm'
msgBox (fm_window fm) MessageInfo msg
----------------------------------------------------------------------------------------------------
---- Âûäåëåíèå ôàéëîâ ------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- |Îòìåòèòü/ðàçîòìåòèòü ôàéëû, óäîâëåòâîðÿþùèå çàäàííîìó ïðåäèêàòó
fmSelectFilenames = fmSelUnselFilenames New.treeSelectionSelectRange
fmUnselectFilenames = fmSelUnselFilenames New.treeSelectionUnselectRange
fmSelUnselFilenames selectOrUnselect fm' filter_p = do
fm <- val fm'
let fullList = fm_filelist fm
let selection = fm_selection fm
for (makeRanges$ findIndices filter_p fullList)
(\(x,y) -> selectOrUnselect selection [x] [y])
-- |Îòìåòèòü/ðàçîòìåòèòü âñå ôàéëû
fmSelectAll fm' = New.treeSelectionSelectAll . fm_selection =<< val fm'
fmUnselectAll fm' = New.treeSelectionUnselectAll . fm_selection =<< val fm'
-- |Èíâåðòèðîâàòü âûäåëåíèå
fmInvertSelection fm' = do
fm <- val fm'
let files = length$ fm_filelist fm
let selection = fm_selection fm
for [0..files-1] $ \i -> do
selected <- New.treeSelectionPathIsSelected selection [i]
(if selected then New.treeSelectionUnselectPath else New.treeSelectionSelectPath) selection [i]
-- |Ñïèñîê èì¸í èçáðàííûõ ôàéëîâ + èì¸í êàòàëîãîâ â îòîáðàæåíèè mapDirName
getSelection fm' mapDirName = do
let mapFilenames fd | fdIsDir fd = mapDirName$ fmname fd
| otherwise = [fmname fd]
getSelectionFileInfo fm' >>== concatMap mapFilenames
-- |Ñïèñîê FileInfo èçáðàííûõ ôàéëîâ
getSelectionFileInfo fm' = do
fm <- val fm'
let fullList = fm_filelist fm
getSelectionRows fm' >>== map (fullList!!)
-- |Ñïèñîê íîìåðîâ èçáðàííûõ ôàéëîâ
getSelectionRows fm' = do
fm <- val fm'
let selection = fm_selection fm
New.treeSelectionGetSelectedRows selection >>== map head
-- |Óäàëèòü èç ìîäåëè âûáðàííûå ôàéëû
fmDeleteSelected fm' = do
rows <- getSelectionRows fm'
fm <- val fm'
fmSetFilelist fm' (fm_filelist fm `deleteElems` rows) -- O(n^2)!
----------------------------------------------------------------------------------------------------
---- Ñîðòèðîâêà ñïèñêà ôàéëîâ ----------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- |Âîçâðàòèòü òåêóùèé ïîðÿäîê ñîðòèðîâêè
fmGetSortOrder fm' = fm_sort_order `fmap` val fm'
-- |Óñòàíîâèòü ïîðÿäîê ñîðòèðîâêè
fmSetSortOrder fm' showSortOrder = fmModifySortOrder fm' showSortOrder . const
-- |Ìîäèôèöèðîâàòü ïîðÿäîê ñîðòèðîâêè â fm' è ïîêàçàòü èíäèêàòîð ñîðòèðîâêè íàä ñîîòâåòñòâóþùèì ñòîëáöîì
fmModifySortOrder fm' showSortOrder f_order = do
fm <- val fm'
let sort_order = f_order (fm_sort_order fm)
fm' =: fm {fm_sort_order = sort_order}
-- Ìîäèôèöèðóåì èíäèêàòîð ñîðòèðîâêè
let (column, order) = break1 isUpper sort_order
showSortOrder column (if order == "Asc" then SortAscending else SortDescending)
-- |Ñîõðàíèòü ïîðÿäîê ñîðòèðîâêè â èñòîðèþ
fmSaveSortOrder fm' = fmReplaceHistory fm' "SortOrder"
-- |Âîññòàíîâèòü ïîðÿäîê ñîðòèðîâêè èç èñòîðèè
fmRestoreSortOrder fm' = fmGetHistory1 fm' "SortOrder" "NameAsc"
-- | (ClickedColumnName, OldSortOrder) -> NewSortOrder
calcNewSortOrder "Name" "NameAsc" = "NameDesc"
calcNewSortOrder "Name" _ = "NameAsc"
calcNewSortOrder "Size" "SizeDesc" = "SizeAsc"
calcNewSortOrder "Size" _ = "SizeDesc"
calcNewSortOrder "Modified" "ModifiedDesc" = "ModifiedAsc"
calcNewSortOrder "Modified" _ = "ModifiedDesc"
-- |Âûáîð ôóíêöèè ñîðòèðîâêè ïî èìåíè êîëîíêè
sortOnColumn "NameAsc" = sortOn (\fd -> (not$ fdIsDir fd, strLower$ fmname fd))
sortOnColumn "NameDesc" = sortOn (\fd -> ( fdIsDir fd, strLower$ fmname fd)) >>> reverse
--
sortOnColumn "SizeAsc" = sortOn (\fd -> if fdIsDir fd then -1 else fdSize fd)
sortOnColumn "SizeDesc" = sortOn (\fd -> if fdIsDir fd then aFILESIZE_MIN else -fdSize fd)
--
sortOnColumn "ModifiedAsc" = sortOn (\fd -> (not$ fdIsDir fd, fdTime fd))
sortOnColumn "ModifiedDesc" = sortOn (\fd -> (not$ fdIsDir fd, -fdTime fd))
--
sortOnColumn _ = id
----------------------------------------------------------------------------------------------------
---- Îïåðàöèè ñ ôàéëîì èñòîðèè ---------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
fmAddHistory fm' tags text = do fm <- val fm'; hfAddHistory (fm_history fm) tags text
fmReplaceHistory fm' tags text = do fm <- val fm'; hfReplaceHistory (fm_history fm) tags text
fmModifyHistory fm' tags text deleteCond = do fm <- val fm'; hfModifyHistory (fm_history fm) tags text deleteCond
fmGetHistory1 fm' tags deflt = do fm <- val fm'; hfGetHistory1 (fm_history fm) tags deflt
fmGetHistory fm' tags = do fm <- val fm'; hfGetHistory (fm_history fm) tags
fmGetHistoryBool fm' tag deflt = do fm <- val fm'; hfGetHistoryBool (fm_history fm) tag deflt
fmReplaceHistoryBool fm' tag x = do fm <- val fm'; hfReplaceHistoryBool (fm_history fm) tag x
fmSaveSizePos fm' dialog name = do fm <- val fm'; hfSaveSizePos (fm_history fm) dialog name
fmSaveMaximized fm' dialog name = do fm <- val fm'; hfSaveMaximized (fm_history fm) dialog name
fmRestoreSizePos fm' window name deflt = do fm <- val fm'; hfRestoreSizePos (fm_history fm) window name deflt
fmCacheConfigFile fm' action = do fm <- val fm'; hfCacheConfigFile (fm_history fm) action
fmUpdateConfigFiles fm' = do fm <- val fm'; hfUpdateConfigFiles (fm_history fm)
----------------------------------------------------------------------------------------------------
---- GUI controls, âçàèìîäåéñòâóþùèå ñ FM ----------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- |Êîìáèíèðîâàííûé âèäæåò, ïðåäñòàâëÿþùèé ñòðîêó ââîäà ñ ñîõðàíÿåìîé èñòîðèåé
data EntryWithHistory = EntryWithHistory
{ ehGtkWidget :: GtkWidget ComboBoxEntry String
, entry :: Entry
}
instance GtkWidgetClass EntryWithHistory ComboBoxEntry String where
widget = widget . ehGtkWidget
getTitle = getTitle . ehGtkWidget
setTitle = setTitle . ehGtkWidget
getValue = getValue . ehGtkWidget
setValue = setValue . ehGtkWidget
setOnUpdate = setOnUpdate . ehGtkWidget
onClick = onClick . ehGtkWidget
saveHistory = saveHistory . ehGtkWidget
rereadHistory = rereadHistory . ehGtkWidget
{-# NOINLINE fmEntryWithHistory #-}
-- |Ñîçäàòü êîìáî-áîêñ ñ èñòîðèåé ïîä òåãîì tag;
-- ïåðåä çàïîìèíàíèåì â èñòîðèè ïðîïóñêàòü ââåä¸ííûé òåêñò ÷åðåç îïåðàöèþ process
fmEntryWithHistory fm' tag filter_p process = do
-- Create GUI controls
comboBox <- New.comboBoxEntryNewText
Just entry <- binGetChild comboBox >>== fmap castToEntry
set entry [entryActivatesDefault := True]
-- Define callbacks
last <- fmGetHistory fm' (tag++"Last")
let fixedOrder = (last>[]) -- True - keep order of dropdown "menu" elements fixed
history' <- mvar []
let readHistory = do
history' .<- \oldHistory -> do
replicateM_ (1+length oldHistory) (New.comboBoxRemoveText comboBox 0)
history <- fmGetHistory fm' tag >>= Utils.filterM filter_p
for history (New.comboBoxAppendText comboBox)
return history
let getText = do
val entry >>= process
let setText text = do
entry =: text
let saveHistory = do
text <- getText
history <- val history'
when fixedOrder $ do
fmReplaceHistory fm' (tag++"Last") text
unless (fixedOrder && (text `elem` history)) $ do
New.comboBoxPrependText comboBox text
fmAddHistory fm' tag text
readHistory
-- Óñòàíîâèòü òåêñò â ïîëå ââîäà
case last of
last:_ -> entry =: last
[] -> do history <- val history'
when (history > []) $ do
New.comboBoxSetActive comboBox 0
--
return EntryWithHistory
{ entry = entry
, ehGtkWidget = gtkWidget { gwWidget = comboBox
, gwGetValue = getText
, gwSetValue = setText
, gwSetOnUpdate = \action -> New.onChanged comboBox action >> return ()
, gwSaveHistory = saveHistory
, gwRereadHistory = readHistory
}
}
{-# NOINLINE fmLabeledEntryWithHistory #-}
-- |Ââîä ñòðîêè ñ èñòîðèåé ïîä òýãîì tag è ìåòêîé ñëåâà
fmLabeledEntryWithHistory fm' tag title = do
hbox <- hBoxNew False 0
title <- label title
inputStr <- fmEntryWithHistory fm' tag (const$ return True) (return)
boxPackStart hbox (widget title) PackNatural 0
boxPackStart hbox (widget inputStr) PackGrow 5
return (hbox, inputStr)
{-# NOINLINE fmCheckedEntryWithHistory #-}
-- |Ââîä ñòðîêè ñ èñòîðèåé ïîä òýãîì tag è ÷åêáîêñîì ñëåâà
fmCheckedEntryWithHistory fm' tag title = do
hbox <- hBoxNew False 0
checkBox <- checkBox title
inputStr <- fmEntryWithHistory fm' tag (const$ return True) (return)
boxPackStart hbox (widget checkBox) PackNatural 0
boxPackStart hbox (widget inputStr) PackGrow 5
--checkBox `onToggled` do
-- on <- val checkBox
-- (if on then widgetShow else widgetHide) (widget inputStr)
return (hbox, checkBox, inputStr)
{-# NOINLINE fmFileBox #-}
-- |Ââîä èìåíè ôàéëà/êàòàëîãà ñ èñòîðèåé ïîä òýãîì tag è ïîèñêîì ïî äèñêó ÷åðåç âûçûâàåìûé äèàëîã
fmFileBox fm' dialog tag dialogType makeControl dialogTitle filters filter_p process = do
hbox <- hBoxNew False 0
control <- makeControl
filename <- fmEntryWithHistory fm' tag filter_p process
chooserButton <- button "9999 ..."
chooserButton `onClick` do
chooseFile dialog dialogType dialogTitle filters (val filename) (filename =:)
boxPackStart hbox (widget control) PackNatural 0
boxPackStart hbox (widget filename) PackGrow 5
boxPackStart hbox (widget chooserButton) PackNatural 0
return (hbox, control, filename)
{-# NOINLINE fmInputString #-}
-- |Çàïðîñèòü ó ïîëüçîâàòåëÿ ñòðîêó (ñ èñòîðèåé ââîäà)
fmInputString fm' tag title filter_p process = do
fm <- val fm'
-- Ñîçäàäèì äèàëîã ñî ñòàíäàðòíûìè êíîïêàìè OK/Cancel
fmDialog fm' title [] $ \(dialog,okButton) -> do
x <- fmEntryWithHistory fm' tag filter_p process
upbox <- dialogGetUpper dialog
--boxPackStart upbox label PackGrow 0
boxPackStart upbox (widget x) PackGrow 0
widgetShowAll upbox
choice <- dialogRun dialog
case choice of
ResponseOk -> do saveHistory x; val x >>== Just
_ -> return Nothing
{-# NOINLINE fmCheckButtonWithHistory #-}
-- |Ñîçäàòü ÷åêáîêñ ñ èñòîðèåé ïîä òåãîì tag
fmCheckButtonWithHistory fm' tag deflt title = do
control <- checkBox title
let rereadHistory = do
control =:: fmGetHistoryBool fm' tag deflt
let saveHistory = do
fmReplaceHistoryBool fm' tag =<< val control
rereadHistory
return$ control
{ gwSaveHistory = saveHistory
, gwRereadHistory = rereadHistory
}
{-# NOINLINE fmExpanderWithHistory #-}
-- |Ñîçäàòü ýêñïàíäåð ñ èñòîðèåé ïîä òåãîì tag
fmExpanderWithHistory fm' tag deflt title = do
control <- expander title
let rereadHistory = do
control =:: fmGetHistoryBool fm' tag deflt
let saveHistory = do
fmReplaceHistoryBool fm' tag =<< val control
rereadHistory
return$ control
{ gwSaveHistory = saveHistory
, gwRereadHistory = rereadHistory
}
{-# NOINLINE fmDialog #-}
-- |Äèàëîã ñî ñòàíäàðòíûìè êíîïêàìè OK/Cancel
fmDialog fm' title flags action = do
fm <- val fm'
title <- i18n title
bracketCtrlBreak "fmDialog" dialogNew widgetDestroy $ \dialog -> do
set dialog [windowTitle := title,
containerBorderWidth := 0]
when (isJust$ fm_window_ fm) $ do
set dialog [windowTransientFor := fm_window fm]
-- Ñîçäàòü 2 èëè 3 êíîïêè
addStdButton dialog ResponseOk >>= \okButton -> do
addStdButton dialog aResponseDetach `on` (AddDetachButton `elem` flags)
addStdButton dialog ResponseCancel
--
dialogSetDefaultResponse dialog ResponseOk
tooltips =:: tooltipsNew
action (dialog,okButton)
-- |Äîï. ôëàãè äëÿ íàñòðîéêè fmDialog
data FMDialogFlags = AddDetachButton -- ^Äîáàâëÿòü Detach button â äèàëîã?
deriving Eq
{-# NOINLINE fmDialogRun #-}
-- |Îòðàáîòàòü äèàëîã ñ ñîõðàíåíèåì åãî ïîëîæåíèÿ è ðàçìåðà â èñòîðèè
fmDialogRun fm' dialog name = do
fmRestoreSizePos fm' dialog name ""
res <- dialogRun dialog
fmSaveSizePos fm' dialog name
fm <- val fm'
when (isJust$ fm_window_ fm) $ do
windowPresent (fm_window fm)
return res
----------------------------------------------------------------------------------------------------
---- Ñïèñîê ôàéëîâ â àðõèâå ------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
createFilePanel = do
let columnTitles = ["0015 Name", "0016 Size", "0017 Modified", "0018 DIRECTORY"]
n = map (drop 5) columnTitles
s <- i18ns columnTitles
createListView fmname [(n!!0, s!!0, fmname, []),
(n!!1, s!!1, (\fd -> if (fdIsDir fd) then (s!!3) else (show3$ fdSize fd)), [cellXAlign := 1]),
(n!!2, s!!2, (guiFormatDateTime.fdTime), [])]
createListView searchField columns = do
-- Scrolled window where this list will be put
scrwin <- scrolledWindowNew Nothing Nothing
scrolledWindowSetPolicy scrwin PolicyAutomatic PolicyAutomatic
-- Create a new ListView
view <- New.treeViewNew
set view [ {-New.treeViewSearchColumn := 0, -} New.treeViewRulesHint := True]
New.treeViewSetHeadersVisible view True
-- Ñîçäà¸ì è óñòàíàâëèâàåì ìîäåëü
model <- New.listStoreNew []
set view [New.treeViewModel := model]
-- Ñîçäà¸ì êîëîíêè äëÿ å¸ îòîáðàæåíèÿ.
onColumnTitleClicked <- ref doNothing
let addColumnActions = columns.$map (\(a,b,c,d) -> addColumn view model onColumnTitleClicked a b c d)
columns <- sequence addColumnActions
addColumn view model onColumnTitleClicked "" "" (const "") []
-- Âêëþ÷àåì ïîèñê ïî ïåðâîé êîëîíêå
New.treeViewSetEnableSearch view True
New.treeViewSetSearchColumn view 0
New.treeViewSetSearchEqualFunc view $ \col str iter -> do
(i:_) <- New.treeModelGetPath model iter
row <- New.listStoreGetValue model i
return (strLower(searchField row) ~= strLower(str)++"*")
-- Enable multiple selection
selection <- New.treeViewGetSelection view
set selection [New.treeSelectionMode := SelectionMultiple]
-- Pack list into scrolled window and return window
containerAdd scrwin view
return (scrwin, view, model, selection, columns, onColumnTitleClicked)
-- |Çàäàòü íîâûé ñïèñîê îòîáðàæàåìûõ ôàéëîâ
changeList model selection filelist = do
New.treeSelectionUnselectAll selection
-- Óäàëèòü ñòàðûå äàííûå èç ìîäåëè è çàïîëíèòü å¸ íîâûìè
New.listStoreClear model
for filelist (New.listStoreAppend model)
-- |Äîáàâèòü âî view êîëîíêó, îòîáðàæàþùóþ field, ñ çàãîëîâêîì title
addColumn view model onColumnTitleClicked colname title field attrs = do
col1 <- New.treeViewColumnNew
New.treeViewColumnSetTitle col1 title
renderer1 <- New.cellRendererTextNew
New.cellLayoutPackStart col1 renderer1 False
-- Ïîïûòêè ñäåëàòü ïîëå èìåíè àâòîìàòè÷åñêè óâåëè÷èâàþùèìñÿ ïðè óâåëè÷åíèè îêíà ïðîãðàììû
-- (bool New.cellLayoutPackStart New.cellLayoutPackEnd expand) col1 renderer1 expand
-- set col1 [New.treeViewColumnSizing := TreeViewColumnAutosize] `on` expand
-- set col1 [New.treeViewColumnSizing := TreeViewColumnFixed] `on` not expand
-- cellLayoutSetAttributes [New.cellEditable := True, New.cellEllipsize := EllipsizeEnd]
when (colname/="") $ do
set col1 [ New.treeViewColumnResizable := True
, New.treeViewColumnSizing := TreeViewColumnFixed
, New.treeViewColumnClickable := True
, New.treeViewColumnReorderable := True ]
-- Ïðè íàæàòèè íà çàãîëîâîê ñòîëáöà âûçâàòü êîëáýê
col1 `New.onColClicked` do
val onColumnTitleClicked >>= ($colname)
New.cellLayoutSetAttributes col1 renderer1 model $ \row -> [New.cellText := field row] ++ attrs
New.treeViewAppendColumn view col1
return (colname,col1)
-- |Ïîêàçàòü èíäèêàòîð ñîðòèðîâêè íàä ñòîëáöîì colname â íàïðàâëåíèè order
showSortOrder columns colname order = do
for (map snd columns) (`New.treeViewColumnSetSortIndicator` False)
let Just col1 = colname `lookup` columns
New.treeViewColumnSetSortIndicator col1 True
New.treeViewColumnSetSortOrder col1 order