GUI.hs

{-# OPTIONS_GHC -cpp #-}
----------------------------------------------------------------------------------------------------
---- Èíôîðìèðîâàíèå ïîëüçîâàòåëÿ î õîäå âûïîëíåíèÿ ïðîãðàììû.                                 ------
----------------------------------------------------------------------------------------------------
module GUI where

import Prelude    hiding (catch)
import Control.Monad
import Control.Monad.Fix
import Control.Concurrent
import Control.Exception
import Data.Char  hiding (Control)
import Data.IORef
import Data.List
import Data.Maybe
import Foreign
import Foreign.C
import Numeric           (showFFloat)
import System.CPUTime    (getCPUTime)
import System.IO
import System.Time

import Graphics.UI.Gtk
import Graphics.UI.Gtk.ModelView as New

import Utils
import Errors
import Files
import Charsets
import FileInfo
import Options
import UIBase

-- |Ôàéë íàñòðîåê ïðîãðàììû
aINI_FILE = "freearc.ini"

-- |Ôàéë ñ îïèñàíèåì ìåíþ è òóëáàðà
aMENU_FILE = "freearc.menu"

-- Òåãè â INI-ôàéëå
aINITAG_LANGUAGE = "language"

-- |Êàòàëîã ëîêàëèçàöèé
aLANG_DIR = "arc.languages"

-- |Èìÿ ôàéëà ñ èêîíêîé ïðîãðàììû
aICON_FILE = "FreeArc.ico"

-- |Ôèëüòðû äëÿ âûáîðà àðõèâà
aARCFILE_FILTER = ["0307 FreeArc archives (*.arc)", "0308 Archives and SFXes (*.arc;*.exe)"]

-- |Ôèëüòð äëÿ âûáîðà ëþáîãî ôàéëà
aANYFILE_FILTER = []

-- |Ïóòü ê all2arc
all2arc_path = do
  exe <- getExeName                              -- Name of FreeArc.exe file
  let dir  = exe.$takeDirectory                  -- FreeArc.exe directory
  return$ windosifyPath(dir </> "all2arc.exe")

-- |Ëîêàëèçàöèÿ
loadTranslation = do
  langDir  <- findDir libraryFilePlaces aLANG_DIR
  settings <- readIniFile
  setLocale$ langDir </> (settings.$lookup aINITAG_LANGUAGE `defaultVal` aLANG_FILE)

-- |Ïðî÷èòàòü íàñòðîéêè ïðîãðàììû èç ini-ôàéëà
readIniFile = do
  inifile  <- findFile configFilePlaces aINI_FILE
  inifile  &&&  readConfigFile inifile >>== map (split2 '=')


----------------------------------------------------------------------------------------------------
---- Îòîáðàæåíèå èíäèêàòîðà ïðîãðåññà --------------------------------------------------------------
----------------------------------------------------------------------------------------------------

-- |Ïåðåìåííàÿ, õðàíÿùàÿ íîìåð GUI-òðåäà
guiThread  =  unsafePerformIO$ newIORef$ error "undefined GUI::guiThread"

-- |Èíèöèàëèçàöèÿ Gtk äëÿ èíòåðàêòèâíîé ðàáîòû (ðåæèì FileManager)
runGUI action = do
  unsafeInitGUIForThreadedRTS
  guiThread =:: getOsThreadId
  action
  mainGUI

-- |Èíèöèàëèçàöèÿ Gtk äëÿ âûïîëíåíèÿ cmdline
startGUI = do
  x <- newEmptyMVar
  forkIO$ runInBoundThread $ do
    runGUI$ putMVar x ()
  takeMVar x

-- |Èíèöèàëèçàöèÿ GUI-÷àñòè ïðîãðàììû (èíäèêàòîðà ïðîãðåññà) äëÿ âûïîëíåíèÿ cmdline
guiStartProgram = gui $ do
  (windowProgress, msgbActions) <- runIndicators
  widgetShowAll windowProgress

-- |Çàäåðæàòü çàâåðøåíèå ïðîãðàììû
guiPauseAtEnd = do
  uiMessage =: ""
  updateAllIndicators
  foreverM $ do
    sleepSeconds 1

-- |Çàâåðøèòü âûïîëíåíèå ïðîãðàììû
guiDoneProgram = do
  return ()


{-# NOINLINE runIndicators #-}
-- |Ñîçäà¸ò îêíî èíäèêàòîðà ïðîãðåññà è çàïóñêàåò òðåä äëÿ åãî ïåðèîäè÷åñêîãî îáíîâëåíèÿ.
runIndicators = do
  hf' <- openHistoryFile

  -- Ñîáñòâåííî îêíî èíäèêàòîðà ïðîãðåññà
  window <- windowNew
  vbox   <- vBoxNew False 0
  set window [windowWindowPosition := WinPosCenter,
              containerBorderWidth := 10, containerChild := vbox]
  hfRestoreSizePos hf' window "ProgressWindow" "-10000 -10000 350 200"

  -- Ðàçäåëèì îêíî ïî âåðòèêàëè
  (statsBox, updateStats, clearStats) <- createStats
  curFileLabel <- labelNew Nothing
  curFileBox   <- hBoxNew True 0
  boxPackStart curFileBox curFileLabel PackGrow 2
  widgetSetSizeRequest curFileLabel 30 (-1)
  progressBar  <- progressBarNew
  expanderBox  <- expanderNew ""
  buttonBox    <- hBoxNew True 10
  (messageBox, msgbActions) <- makeBoxForMessages
  boxPackStart vbox statsBox     PackNatural 0
  boxPackStart vbox curFileBox   PackNatural 10
  boxPackStart vbox progressBar  PackNatural 0
  boxPackStart vbox expanderBox  PackNatural 0
  boxPackStart vbox messageBox   PackGrow    0
  boxPackStart vbox buttonBox    PackNatural 0
  miscSetAlignment curFileLabel 0 0    -- âûðîâíÿåì âëåâî èìÿ òåêóùåãî ôàéëà
  progressBarSetText progressBar " "   -- íóæåí íåïóñòîé òåêñò ÷òîáû óñòàíîâèòü ïðàâèëüíóþ âûñîòó progressBar

  hbox <- hBoxNew False 0;                            containerAdd expanderBox hbox
  onTop <- checkBox "0446 Keep window on top";        boxPackStart hbox (widget onTop) PackNatural 1
--  let onTopSetting = settings.$lookup "OnTop" `defaultVal` "350 200"
  setOnUpdate onTop $   do windowSetKeepAbove window =<< val onTop

  -- Çàïîëíèì êíîïêàìè íèæíþþ ÷àñòü îêíà
  --buttonNew window stockClose ResponseClose
  backgroundButton <- buttonNewWithMnemonic       =<< i18n"0052   _Background  "
  pauseButton      <- toggleButtonNewWithMnemonic =<< i18n"0053   _Pause  "
  cancelButton     <- buttonNewWithMnemonic       =<< i18n"0081   _Cancel  "
  boxPackStart buttonBox backgroundButton PackNatural 0
  boxPackStart buttonBox pauseButton      PackNatural 0
  boxPackEnd   buttonBox cancelButton     PackNatural 0

  -- Îáðàáîò÷èêè ñîáûòèé (çàêðûòèå îêíà/íàæàòèå êíîïîê)
  let askProgramClose = do
        active <- val pauseButton
        terminationRequested <- do
          -- Allow to close window immediately if program already finished
          finished <- val programFinished
          if finished  then return True  else do
          -- Otherwise - ask user's permission
          (if active then id else syncUI) $ do
             pauseTiming $ do
               inside (windowSetKeepAbove window False)
                      (windowSetKeepAbove window =<< val onTop)
                      (askYesNo window "0251 Abort operation?")
        when terminationRequested $ do
          pauseButton =: False
          ignoreErrors$ terminateOperation

  -- Îáðàáîòêà íàæàòèÿ êëàâèø
  window `onKeyPress` \event -> do
    case (eventKey event) of
      "Escape" -> do askProgramClose; return True
      _        -> return False

  window `onDelete` \e -> do
    askProgramClose
    return True

  cancelButton `onClicked` do
    askProgramClose

  pauseButton `onToggled` do
    active <- val pauseButton
    if active then do takeMVar mvarSyncUI
                      pause_real_secs
                      buttonSetLabel pauseButton =<< i18n"0054   _Continue  "
              else do putMVar mvarSyncUI "mvarSyncUI"
                      resume_real_secs
                      buttonSetLabel pauseButton =<< i18n"0053   _Pause  "

  backgroundButton `onClicked` do
    windowIconify window

  -- Îáíîâëÿåì çàãîëîâîê îêíà, ñòàòèñòèêó è íàäïèñü èíäèêàòîðà ïðîãðåññà ðàç â 0.5 ñåêóíäû
  i' <- ref 0   -- à ñàì èíäèêàòîð ïðîãðåññà ðàç â 0.1 ñåêóíäû
  indicatorThread 0.1 $ \updateMode indicator indType title b bytes total processed p -> postGUIAsync$ do
    i <- val i'; i' += 1; let once_a_halfsecond  =  (updateMode==ForceUpdate)  ||  (i `mod` 5 == 0)
    -- Çàãîëîâîê îêíà
    set window [windowTitle := title]                              `on` once_a_halfsecond
    -- Ñòàòèñòèêà
    updateStats indType b total processed                          `on` once_a_halfsecond
    -- Ïðîãðåññ-áàð è íàäïèñü íà í¸ì
    progressBarSetFraction progressBar processed                   `on` True
    progressBarSetText     progressBar p                           `on` once_a_halfsecond
    widgetGrabFocus cancelButton                                   `on` (updateMode==ForceUpdate)  -- make Cancel button default after operation was finished

  backgroundThread 0.5 $ \updateMode -> postGUIAsync$ do
    -- Èìÿ òåêóùåãî ôàéëà èëè ñòàäèÿ âûïîëíåíèÿ êîìàíäû
    labelSetText curFileLabel =<< val uiMessage

  -- Î÷èùàåò âñå ïîëÿ ñ èíôîðìàöèåé î òåêóùåì àðõèâå
  clearProgressWindow =: do
    set window [windowTitle := " "]
    clearStats
    labelSetText curFileLabel ""
    progressBarSetFraction progressBar 0
    progressBarSetText     progressBar " "

  -- Ïîåõàëè!
  widgetGrabFocus pauseButton
  return (window, msgbActions)


-- |Ñîçäàíèå ïîëåé äëÿ âûâîäà ñòàòèñòèêè
createStats = do
  textBox <- tableNew 4 6 False
  labels' <- ref []

  -- Ñîçäàäèì ïîëÿ äëÿ âûâîäà òåêóùåé ñòàòèñòèêè è íàðèñóåì ìåòêè ê íèì
  let newLabel2 x y s = do label1 <- labelNewWithMnemonic =<< i18n s
                           tableAttach textBox label1 (x+0) (x+1) y (y+1) [Expand, Fill] [Expand, Fill] 0 0
                           --set label1 [labelWidthChars := 25]
                           miscSetAlignment label1 0 0

                           label2 <- labelNew Nothing
                           tableAttach textBox label2 (x+1) (x+2) y (y+1) [Expand, Fill] [Expand, Fill] 10 0
                           set label2 [labelSelectable := True]
                           miscSetAlignment label2 1 0
                           labels' ++= [label2]
                           return [label1,label2]
      -- Âîçâðàùàåò òîëüêî ïîëå çíà÷åíèÿ
      newLabel x y s  =    newLabel2 x y s >>== (!!1)

  newLabel 2 0 "     "        -- make space between left and right columns
  filesLabel      <- newLabel 0 0 "0056 Files"
  totalFilesLabel <- newLabel 3 0 "0057 Total files"
  bytesLabel      <- newLabel 0 1 "0058 Bytes"
  totalBytesLabel <- newLabel 3 1 "0059 Total bytes"
  ratioLabel      <- newLabel 0 3 "0060 Ratio"
  speedLabel      <- newLabel 3 3 "0061 Speed"
  timesLabel      <- newLabel 0 4 "0062 Time"
  totalTimesLabel <- newLabel 3 4 "0063 Total time"

  compressed      @ [_,      compressedLabel] <- newLabel2 0 2 "0252 Compressed"
  totalCompressed @ [_, totalCompressedLabel] <- newLabel2 3 2 "0253 Total compressed"
  last_cmd' <- ref ""

  -- Ïðîöåäóðà, âûâîäÿùàÿ òåêóùóþ ñòàòèñòèêó (indType==INDICATOR_FULL - ïîëíîöåííûé èíäèêàòîð, èíà÷å - òîëüêî ïðîöåíòû, íàïðèìåð îïåðàöèè ñ RR)
  let updateStats indType b total_b (processed :: Double) = do
        ~UI_State { total_files = total_files
                  , total_bytes = total_bytes
                  , files       = files
                  , cbytes      = cbytes
                  , archive_total_bytes      = archive_total_bytes
                  , archive_total_compressed = archive_total_compressed
                  }  <-  val ref_ui_state
        total_bytes <- return (if indType==INDICATOR_FULL  then total_bytes  else total_b)
        -- Îáùåå âðåìÿ ñ íà÷àëà îïåðàöèè è ìîìåíò êîãäà íà÷àëñÿ ïîêàç òåêóùåãî èíäèêàòîðà ïðîãðåññà
        secs <- return_real_secs
        sec0 <- val indicator_start_real_secs

        -- Åñëè îïåðàöèÿ çàâåðøåíà - ïîêàçûâàåì òî÷íûå ðåçóëüòàòû
        if b==total_bytes
          then do (labelSetMarkup filesLabel$           ""                           )
                  (labelSetMarkup bytesLabel$           ""                           )
                  (labelSetMarkup compressedLabel$      ""                           )
                  (labelSetMarkup timesLabel$           ""                           )
                  (labelSetMarkup totalFilesLabel$      bold$ show3 total_files      )                      `on` indType==INDICATOR_FULL
                  (labelSetMarkup totalBytesLabel$      bold$ show3 total_bytes      )
                  (labelSetMarkup totalCompressedLabel$ bold$ show3 (cbytes)         )                      `on` indType==INDICATOR_FULL
                  (labelSetMarkup totalTimesLabel$      bold$ showHMS (secs)         )
                  when (b>0) $ do                      -- Ïîëÿ ñêîðîñòè/êîýô. ñæàòèÿ áåññìûñëåííî ïîêàçûâàòü ïîêà íå íàêîïëåíà õîòü êàêàÿ-òî ñòàòèñòèêà
                    (labelSetMarkup ratioLabel$         bold$ ratio2 cbytes b++"%"   )                      `on` indType==INDICATOR_FULL
                  when (secs-sec0>0.001) $ do
                    (labelSetMarkup speedLabel$         bold$ showSpeed b (secs-sec0))

          else do

        -- Îïðåäåëåíèå Total compressed (òî÷íîå òîëüêî ïðè ðàñïàêîâêå àðõèâà öåëèêîì, èíà÷å - îöåíêà)
        cmd <- val ref_command >>== cmd_name
        let total_compressed
              | cmdType cmd == ADD_CMD              =  if b==total_bytes then show3 (cbytes)
                                                                         else "~"++show3 (total_bytes*cbytes `div` b)
              | archive_total_bytes == total_bytes  =       show3 (archive_total_compressed)
              | archive_total_bytes == 0            =       show3 (0)
              | otherwise                           =  "~"++show3 (archive_total_compressed*total_bytes `div` archive_total_bytes)

        (labelSetMarkup filesLabel$           bold$ show3 files                                )  `on` indType==INDICATOR_FULL
        (labelSetMarkup bytesLabel$           bold$ show3 b                                    )
        (labelSetMarkup compressedLabel$      bold$ show3 cbytes                               )  `on` indType==INDICATOR_FULL
        (labelSetMarkup timesLabel$           bold$ showHMS secs                               )
        (labelSetMarkup totalFilesLabel$      bold$ show3 total_files                          )  `on` indType==INDICATOR_FULL
        (labelSetMarkup totalBytesLabel$      bold$ show3 total_bytes                          )
        when (b>0 && secs-sec0>0.001) $ do   -- Ïîëÿ ñêîðîñòè/êîýô. ñæàòèÿ áåññìûñëåííî ïîêàçûâàòü ïîêà íå íàêîïëåíà õîòü êàêàÿ-òî ñòàòèñòèêà
        (labelSetMarkup ratioLabel$           bold$ ratio2 cbytes b++"%"                       )  `on` indType==INDICATOR_FULL
        (labelSetMarkup speedLabel$           bold$ showSpeed b (secs-sec0)                    )
        when (processed>0.001) $ do          -- Ïîëÿ îöåíêè âðåìåíè/ðåçóëüòàòà ñæàòèÿ ïîêàçûâàþòñÿ òîëüêî ïîñëå ñæàòèÿ 0.1% âñåé èíôîðìàöèè
        (labelSetMarkup totalCompressedLabel$ bold$ total_compressed                           )  `on` indType==INDICATOR_FULL
        (labelSetMarkup totalTimesLabel$      bold$ "~"++showHMS (sec0 + (secs-sec0)/processed))

  -- Ïðîöåäóðà, î÷èùàþùàÿ òåêóùóþ ñòàòèñòèêó
  let clearStats  =  val labels' >>= mapM_ (`labelSetMarkup` "     ")
  --
  return (textBox, updateStats, clearStats)


-- |Ñîçäàäèì ïîäîêíî äëÿ ñîîáùåíèé îá îøèáêàõ
makeBoxForMessages = do
  comment <- scrollableTextView "" []
  widgetSetSizeRequest (widget comment) 0 0
  saved <- ref ""
  -- Âûâîäèòü errors/warnings â ýòîò TextView
  let log msg = postGUIAsync$ do
                  fm <- val fileManagerMode
                  if fm
                    then do saved ++= (msg++"\n")
                    else do widgetSetSizeRequest (widget comment) (-1) (-1)
                            comment ++= (msg++"\n")
  -- Ïîñëå çàêðûòèÿ FM ïåðåíåñòè âñå ñîîáùåíèÿ â ýòîò widget
  let afterFMClose = postGUIAsync$ do
                       msg <- val saved
                       saved =: ""
                       when (msg>"") $ do
                         widgetSetSizeRequest (widget comment) (-1) (-1)
                         comment ++= (msg++"\n")
  errorHandlers   ++= [log]
  warningHandlers ++= [log]
  return (widget comment, (saved =: "", afterFMClose))


{-# NOINLINE clearProgressWindow #-}
-- |Îïåðàöèÿ, î÷èùàþùàÿ îêíî èíäèêàòîðà ïðîãðåññà
clearProgressWindow = unsafePerformIO$ newIORef$ return () :: IORef (IO ())

-- |Âûçûâàåòñÿ â íà÷àëå îáðàáîòêè àðõèâà
guiStartArchive = gui$ val clearProgressWindow >>= id

-- |Âûçûâàåòñÿ â íà÷àëå îáðàáîòêè ôàéëà
guiStartFile = doNothing0

-- |Ïðèîñòàíîâèòü âûâîä èíäèêàòîðà ïðîãðåññà è ñòåðåòü åãî ñëåäû
uiSuspendProgressIndicator = do
  aProgressIndicatorEnabled =: False

-- |Âîçîáíîâèòü âûâîä èíäèêàòîðà ïðîãðåññà è âûâåñòè åãî òåêóùåå çíà÷åíèå
uiResumeProgressIndicator = do
  aProgressIndicatorEnabled =: True

-- |Ïðèîñòàíîâèòü èíäèêàòîð (åñëè îí çàïóùåí) íà âðåìÿ âûïîëíåíèÿ îïåðàöèè
uiPauseProgressIndicator action =
  bracket (do x <- val aProgressIndicatorEnabled
              aProgressIndicatorEnabled =: False
              return x)
          (\x -> aProgressIndicatorEnabled =: x)
          (\x -> action)

-- |Reset console title
resetConsoleTitle = return ()

-- |Pause progress indicator & timing while dialog runs
myDialogRun dialog  =  uiPauseProgressIndicator$ pauseTiming$ dialogRun dialog


----------------------------------------------------------------------------------------------------
---- GUI-ñïåöèôè÷íûå îïåðàöèè ñ ôàéëîì èñòîðèè -----------------------------------------------------
----------------------------------------------------------------------------------------------------

-- |Ñîõðàíèòü ðàçìåðû è ïîëîæåíèå îêíà â èñòîðèè
hfSaveSizePos hf' window name = do
    (x,y) <- windowGetPosition window
    (w,h) <- widgetGetSize     window
    hfReplaceHistory hf' (name++"Coord") (unwords$ map show [x,y,w,h])

-- |Çàïîìíèì, áûëî ëè îêíî ìàêñèìèçèðîâàíî
hfSaveMaximized hf' name = hfReplaceHistoryBool hf' (name++"Maximized")

-- |Âîññòàíîâèòü ðàçìåðû è ïîëîæåíèå îêíà èç èñòîðèè
hfRestoreSizePos hf' window name deflt = do
    coord <- hfGetHistory1 hf' (name++"Coord") deflt
    let a  = coord.$split ' '
    when (length(a)==4  &&  all isSignedInt a) $ do  -- ïðîâåðèì ÷òî a ñîñòîèò ðîâíî èç 4 ÷èñåë
      let [x,y,w,h] = map readSignedInt a
      windowMove   window x y  `on` x/= -10000
      windowResize window w h  `on` w/= -10000
    whenM (hfGetHistoryBool hf' (name++"Maximized") False) $ do
      windowMaximize window


----------------------------------------------------------------------------------------------------
---- Çàïðîñû ê ïîëüçîâàòåëþ ("Ïåðåçàïèñàòü ôàéë?" è ò.ï.) ------------------------------------------
----------------------------------------------------------------------------------------------------

{-# NOINLINE askOverwrite #-}
-- |Çàïðîñ î ïåðåçàïèñè ôàéëà
askOverwrite filename diskFileSize diskFileTime arcfile ref_answer answer_on_u = do
  (title:file:question) <- i18ns ["0078 Confirm File Replace",
                                  "0165 %1\n%2 bytes\nmodified on %3",
                                  "0162 Destination folder already contains processed file.",
                                  "",
                                  "",
                                  "",
                                  "0163 Would you like to replace the existing file",
                                  "",
                                  "%1",
                                  "",
                                  "",
                                  "0164 with this one?",
                                  "",
                                  "%2"]
  let f1 = formatn file [filename,           show3$ diskFileSize,   formatDateTime$ diskFileTime]
      f2 = formatn file [storedName arcfile, show3$ fiSize arcfile, formatDateTime$ fiTime arcfile]
  ask (format title filename) (formatn (joinWith "\n" question) [f1,f2]) ref_answer answer_on_u

-- |Îáùèé ìåõàíèçì äëÿ âûäà÷è çàïðîñîâ ê ïîëüçîâàòåëþ
ask title question ref_answer answer_on_u =  do
  old_answer <- val ref_answer
  new_answer <- case old_answer of
                  "a" -> return old_answer
                  "u" -> return old_answer
                  "s" -> return old_answer
                  _   -> ask_user title question
  ref_answer =: new_answer
  case new_answer of
    "u" -> return answer_on_u
    _   -> return (new_answer `elem` ["y","a"])

-- |Ñîáñòâåííî îáùåíèå ñ ïîëüçîâàòåëåì ïðîèñõîäèò çäåñü
ask_user title question  =  gui $ do
  -- Ñîçäàäèì äèàëîã
  bracketCtrlBreak "ask_user" (messageDialogNew Nothing [] MessageQuestion ButtonsNone question) widgetDestroy $ \dialog -> do
  set dialog [windowTitle          := title,
              windowWindowPosition := WinPosCenter]
{-
  -- Çàïðîñ ê ïîëüçîâàòåëþ
  upbox <- dialogGetUpper dialog
  label <- labelNew$ Just$ question++"?"
  boxPackStart  upbox label PackGrow 0
  widgetShowAll upbox
-}
  -- Êíîïêè äëÿ âñåõ âîçìîæíûõ îòâåòîâ
  hbox <- dialogGetActionArea dialog
  buttonBox <- tableNew 3 3 True
  boxPackStart hbox buttonBox PackGrow 0
  id' <- ref 1
  for (zip [0..] buttons) $ \(y,line) -> do
    for (zip [0..] (split '/' line)) $ \(x,text) -> do
      when (text>"") $ do
      text <- i18n text
      button <- buttonNewWithMnemonic ("  "++text++"  ")
      tableAttachDefaults buttonBox button x (x+1) y (y+1)
      id <- val id'; id' += 1
      dialogAddActionWidget dialog button (ResponseUser id)
  widgetShowAll hbox

  -- Ïîëó÷èòü îòâåò â âèäå áóêâû: y/n/a/...
  (ResponseUser id) <- myDialogRun dialog
  let answer = (split '/' valid_answers) !! (id-1)
  when (answer=="q") $ do
    terminateOperation
  return answer


-- Îòâåòû, âîçâðàùàåìûå ask_user, è ñîîòâåòñòâóþùèå èì íàäïèñè íà êíîïêàõ, ïîñòðî÷íî
valid_answers = "y/n/q/a/s/u"
buttons       = ["0079 _Yes/0080 _No/0081 _Cancel"
                ,"0082 Yes to _All/0083 No to A_ll/0084 _Update all"]


----------------------------------------------------------------------------------------------------
---- Çàïðîñ ïàðîëåé --------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------

-- |Çàïðîñ ïàðîëÿ ïðè øèôðîâàíèè/äåøèôðîâàíèè. Èñïîëüçóåòñÿ íåâèäèìûé ââîä.
-- Ïðè øèôðîâàíèè ïàðîëü íàäî ââåñòè äâàæäû - äëÿ çàùèòû îò îøèáîê ïðè ââîäå
ask_passwords = ( ask_password_dialog "0076 Enter encryption password" 2
                , ask_password_dialog "0077 Enter decryption password" 1
                , doNothing0   -- âûçûâàåòñÿ ïðè íåïðàâèëüíîì ïàðîëå
                )

-- |Äèàëîã çàïðîñà ïàðîëÿ.
ask_password_dialog title' amount opt_parseData = gui $ do
  -- Ñîçäàäèì äèàëîã ñî ñòàíäàðòíûìè êíîïêàìè OK/Cancel
  bracketCtrlBreak "ask_password_dialog" dialogNew widgetDestroy $ \dialog -> do
  title <- i18n title'
  set dialog [windowTitle          := title,
              windowWindowPosition := WinPosCenter]
  okButton <- addStdButton dialog ResponseOk
  addStdButton dialog ResponseCancel

  -- Ñîçäà¸ò òàáëèöó ñ ïîëÿìè äëÿ ââîäà îäíîãî èëè äâóõ ïàðîëåé
  (pwdTable, pwds@[pwd1,pwd2]) <- pwdBox amount
  -- Ïðîöåäóðà ïðâåðêè ïðàâèëüíîñòè ââåä¸ííûõ ïàðîëåé
  let validate = do [pwd1', pwd2'] <- mapM val pwds
                    return (pwd1'>"" && pwd1'==pwd2')
  for pwds (`onEntryActivate` whenM validate (buttonClicked okButton))
  for pwds $ flip afterKeyRelease $ \e -> do
    validate >>= widgetSetSensitivity okButton
    return False
  okButton `widgetSetSensitivity` False

  -- Äîáàâèì ïðîáåëû âîêðóã òàáëèöû è êèíåì å¸ íà ôîðìó
  set pwdTable [containerBorderWidth := 10]
  upbox <- dialogGetUpper dialog
  boxPackStart  upbox pwdTable PackGrow 0
  widgetShowAll upbox

  fix $ \reenter -> do
  choice <- myDialogRun dialog
  if choice==ResponseOk
    then do ok <- validate
            if ok  then val pwd1  else reenter
    else terminateOperation >> return ""


{-# NOINLINE ask_passwords #-}

-- |Ñîçäà¸ò òàáëèöó ñ ïîëÿìè äëÿ ââîäà îäíîãî èëè äâóõ ïàðîëåé
pwdBox amount = do
  pwdTable <- tableNew 2 amount False
  tableSetColSpacings pwdTable 0
  let newField y s = do -- Íàäïèñè â ëåâîì ñòîëáöå
                        label <- labelNewWithMnemonic =<< i18n s
                        tableAttach pwdTable label 0 1 (y-1) y [Fill] [Expand, Fill] 5 0
                        miscSetAlignment label 0 0.5
                        -- Ïîëÿ ââîäà ïàðîëÿ â ïðàâîì ñòîëáöå
                        pwd <- entryNew
                        set pwd [entryVisibility := False, entryActivatesDefault := True]
                        tableAttach pwdTable pwd 1 2 (y-1) y [Expand, Shrink, Fill] [Expand, Fill] 5 0
                        return pwd
  pwd1 <- newField 1 "0074 Enter password:"
  pwd2 <- if amount==2  then newField 2 "0075 Reenter password:"  else return pwd1
  return (pwdTable, [pwd1,pwd2])


----------------------------------------------------------------------------------------------------
---- Ââîä/âûâîä êîììåíòàðèåâ ê àðõèâó  -------------------------------------------------------------
----------------------------------------------------------------------------------------------------

{-# NOINLINE uiPrintArcComment #-}
uiPrintArcComment = doNothing

{-# NOINLINE uiInputArcComment #-}
uiInputArcComment old_comment = gui$ do
  bracketCtrlBreak "uiInputArcComment" dialogNew widgetDestroy $ \dialog -> do
  title <- i18n"0073 Enter archive comment"
  set dialog [windowTitle := title,
              windowDefaultHeight := 200, windowDefaultWidth := 400,
              windowWindowPosition := WinPosCenter]
  addStdButton dialog ResponseOk
  addStdButton dialog ResponseCancel

  commentTextView <- newTextViewWithText old_comment
  upbox <- dialogGetUpper dialog
  boxPackStart upbox commentTextView PackGrow 10
  widgetShowAll upbox

  choice <- myDialogRun dialog
  if choice==ResponseOk
    then textViewGetText commentTextView
    else terminateOperation >> return ""


----------------------------------------------------------------------------------------------------
---- Áèáëèîòåêà ------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------

-- |Âûïîëíèòü îïåðàöèþ â GUI-òðåäå
gui action = do
  gui <- val guiThread
  my  <- getOsThreadId
  if my==gui  then action else do
  x <- ref Nothing
  y <- postGUISync (action `catch` (\e -> do x=:Just e; return undefined))
  whenJustM (val x) throwIO
  return y

-- |Ãëîáàëüíàÿ ïåðåìåííàÿ, õðàíÿùàÿ òóëòèïû êîíòðîëîâ íà òåêóùåé ôîðìå
tooltips :: IORef Tooltips = unsafePerformIO$ ref$ error "undefined GUI::tooltips"
tooltip w s = do s <- i18n s; t <- val tooltips; tooltipsSetTip t w s ""

-- |Ñîçäàòü êîíòðîë, äàâ åìó ëîêàëèçîâàííóþ íàäïèñü è òóëòèï
i18t title create = do
  (label, t) <- i18n' title
  control <- create label
  tooltip control t  `on`  t/=""
  return control

-- |This instance allows to get/set radio button state using standard =:/val interface
instance Variable RadioButton Bool where
  new  = undefined
  val  = toggleButtonGetActive
  (=:) = toggleButtonSetActive

-- |This instance allows to get/set toggle button state using standard =:/val interface
instance Variable ToggleButton Bool where
  new  = undefined
  val  = toggleButtonGetActive
  (=:) = toggleButtonSetActive

-- |This instance allows to get/set checkbox state using standard =:/val interface
instance Variable CheckButton Bool where
  new  = undefined
  val  = toggleButtonGetActive
  (=:) = toggleButtonSetActive

-- |This instance allows to get/set entry state using standard =:/val interface
instance Variable Entry String where
  new  = undefined
  val  = entryGetText
  (=:) = entrySetText

-- |This instance allows to get/set expander state using standard =:/val interface
instance Variable Expander Bool where
  new  = undefined
  val  = expanderGetExpanded
  (=:) = expanderSetExpanded

-- |This instance allows to get/set expander state using standard =:/val interface
instance Variable TextView String where
  new  = undefined
  val  = textViewGetText
  (=:) = textViewSetText

-- |This instance allows to get/set value displayed by widget using standard =:/val interface
instance GtkWidgetClass w gw a => Variable w a where
  new  = undefined
  val  = getValue
  (=:) = setValue

-- |Universal interface to arbitrary GTK widget `w` that controls value of type `a`
class GtkWidgetClass w gw a | w->gw, w->a where
  widget        :: w -> gw                 -- ^The GTK widget by itself
  getTitle      :: w -> IO String          -- ^Read current widget's title
  setTitle      :: w -> String -> IO ()    -- ^Set current widget's title
  getValue      :: w -> IO a               -- ^Read current widget's value
  setValue      :: w -> a -> IO ()         -- ^Set current widget's value
  setOnUpdate   :: w -> (IO ()) -> IO ()   -- ^Called when user changes widget's value
  onClick       :: w -> (IO ()) -> IO ()   -- ^Called when user clicks button
  saveHistory   :: w -> IO ()
  rereadHistory :: w -> IO ()

data GtkWidget gw a = GtkWidget
 {gwWidget        :: gw
 ,gwGetTitle      :: IO String
 ,gwSetTitle      :: String -> IO ()
 ,gwGetValue      :: IO a
 ,gwSetValue      :: a -> IO ()
 ,gwSetOnUpdate   :: (IO ()) -> IO ()
 ,gwOnClick       :: (IO ()) -> IO ()
 ,gwSaveHistory   :: IO ()
 ,gwRereadHistory :: IO ()
 }

instance GtkWidgetClass (GtkWidget gw a) gw a where
  widget        = gwWidget
  getTitle      = gwGetTitle
  setTitle      = gwSetTitle
  getValue      = gwGetValue
  setValue      = gwSetValue
  setOnUpdate   = gwSetOnUpdate
  onClick       = gwOnClick
  saveHistory   = gwSaveHistory
  rereadHistory = gwRereadHistory

-- |Ïóñòîé GtkWidget
gtkWidget = GtkWidget { gwWidget        = undefined
                      , gwGetTitle      = undefined
                      , gwSetTitle      = undefined
                      , gwGetValue      = undefined
                      , gwSetValue      = undefined
                      , gwSetOnUpdate   = undefined
                      , gwOnClick       = undefined
                      , gwSaveHistory   = undefined
                      , gwRereadHistory = undefined
                      }

-- Èñïîëüçîâàòü æèðíûé Pango Markup äëÿ ïåðåäàííîãî òåêñòà
bold text = "<b>"++text++"</b>"


{-# NOINLINE eventKey #-}
-- |Âîçâðàùàåò ïîëíîå èìÿ êëàâèøè, íàïðèìåð <Alt><Ctrl>M
eventKey (Key {eventKeyName = name, eventModifier = modifier}) =
  let mshow Shift   = "<Shift>"
      mshow Control = "<Ctrl>"
      mshow Alt     = "<Alt>"
      mshow _       = "<_>"
  --
  in concat ((sort$ map mshow modifier)++[mapHead toUpper name])


{-# NOINLINE addStdButton #-}
-- |Äîáàâèòü ê äèàëîãó ñòàíäàðòíóþ êíîïêó ñî ñòàíäàðòíîé èêîíêîé
addStdButton dialog responseId = do
  let (emsg,item) = case responseId of
                      ResponseYes            -> ("0079 _Yes",    stockYes         )
                      ResponseNo             -> ("0080 _No",     stockNo          )
                      ResponseOk             -> ("0362 _OK",     stockOk          )
                      ResponseCancel         -> ("0081 _Cancel", stockCancel      )
                      ResponseClose          -> ("0364 _Close",  stockClose       )
                      x | x==aResponseMyYes  -> ("0079 _Yes",    stockYes         )
                      x | x==aResponseMyOk   -> ("0362 _OK",     stockOk          )
                      x | x==aResponseDetach -> ("0432 _Detach", stockMissingImage)
                      _                      -> ("???",          stockMissingImage)
  msg <- i18n emsg
  button <- dialogAddButton dialog msg responseId
  image  <- imageNewFromStock item iconSizeButton
  buttonSetImage button image
  return button

aResponseMyYes  = ResponseUser 1
aResponseMyOk   = ResponseUser 2
-- |Êíîïêà ôîíîâîãî âûïîëíåíèÿ êîìàíäû
aResponseDetach = ResponseUser 3


{-# NOINLINE debugMsg #-}
-- |Äèàëîã ñ îòëàäî÷íûì ñîîáùåíèåì
debugMsg msg = do
  bracketCtrlBreak "debugMsg" (messageDialogNew (Nothing) [] MessageError ButtonsClose msg) widgetDestroy $ \dialog -> do
  dialogRun dialog
  return ()

-- |Äèàëîã ñ èíôîðìàöèîííûì ñîîáùåíèåì
msgBox window dialogType msg  =  askConfirmation [ResponseClose] window msg  >>  return ()

-- |Çàïðîñèòü ó ïîëüçîâàòåëÿ ïîäòâåðæäåíèå îïåðàöèè
askOkCancel = askConfirmation [ResponseOk,  ResponseCancel]
askYesNo    = askConfirmation [ResponseYes, ResponseNo]
{-# NOINLINE askConfirmation #-}
askConfirmation buttons window msg = do
  -- Ñîçäàäèì äèàëîã ñ åäèíñòâåííîé êíîïêîé Close
  bracketCtrlBreak "askConfirmation" dialogNew widgetDestroy $ \dialog -> do
    set dialog [windowTitle        := aARC_NAME,
                windowTransientFor := window,
                containerBorderWidth := 10]
    mapM_ (addStdButton dialog) buttons
    -- Íàïå÷àòàåì â í¸ì ñîîáùåíèå
    label <- labelNew.Just =<< i18n msg
    upbox <- dialogGetUpper dialog
    label `set` [labelWrap := True]
    boxPackStart  upbox label PackGrow 20
    widgetShowAll upbox
    -- È çàïóñòèì
    dialogRun dialog >>== (==buttons!!0)

{-# NOINLINE inputString #-}
-- |Çàïðîñèòü ó ïîëüçîâàòåëÿ ñòðîêó
inputString window msg = do
  -- Ñîçäàäèì äèàëîã ñî ñòàíäàðòíûìè êíîïêàìè OK/Cancel
  bracketCtrlBreak "inputString" dialogNew widgetDestroy $ \dialog -> do
    set dialog [windowTitle        := msg,
                windowTransientFor := window]
    addStdButton dialog ResponseOk      >>= \okButton -> do
    addStdButton dialog ResponseCancel

    --label    <- labelNew$ Just msg
    entry <- entryNew
    entry `onEntryActivate` buttonClicked okButton

    upbox <- dialogGetUpper dialog
    --boxPackStart  upbox label    PackGrow 0
    boxPackStart  upbox entry PackGrow 0
    widgetShowAll upbox

    choice <- dialogRun dialog
    case choice of
      ResponseOk -> val entry >>== Just
      _          -> return Nothing


{-# NOINLINE boxed #-}
-- |Ñîçäàòü control è ïîìåñòèòü åãî â hbox
boxed makeControl title = do
  hbox    <- hBoxNew False 0
  control <- makeControl .$i18t title
  boxPackStart  hbox  control  PackNatural 0
  return (hbox, control)


{-# NOINLINE label #-}
-- |Ìåòêà
label title   =  do (hbox, _) <- boxed labelNewWithMnemonic title
                    return gtkWidget {gwWidget = hbox}


{-# NOINLINE button #-}
-- |Êíîïêà
button title  =  do
  (hbox, control) <- boxed buttonNewWithMnemonic title
  return gtkWidget { gwWidget   = hbox
                   , gwOnClick  = \action -> onClicked control action >> return ()
                   , gwSetTitle = buttonSetLabel control
                   , gwGetTitle = buttonGetLabel control
                   }


{-# NOINLINE checkBox #-}
-- |×åêáîêñ
checkBox title = do
  (hbox, control) <- boxed checkButtonNewWithMnemonic title
  return gtkWidget { gwWidget      = hbox
                   , gwGetValue    = val control
                   , gwSetValue    = (control=:)
                   , gwSetOnUpdate = \action -> onToggled control action >> return ()
                   }


{-# NOINLINE expander #-}
-- |Ýêñïàíäåð
expander title = do
  (hbox, control) <- boxed expanderNewWithMnemonic title
  inner_hbox <- hBoxNew False 0    -- We should return it too in order to allow inserting controls inside Expander!!!
  containerAdd control inner_hbox
  return gtkWidget { gwWidget      = hbox
                   , gwGetValue    = val control
                   , gwSetValue    = (control=:)
--                   , gwSetOnUpdate = \action -> onToggled control action >> return ()
                   }


{-# NOINLINE comboBox #-}
-- |Ñîçäà¸ò êîìáîáîêñ, ñîäåðæàùèé çàäàííûé íàáîð àëüòåðíàòèâ
comboBox title labels = do
  hbox  <- hBoxNew False 0
  label <- labelNewWithMnemonic .$i18t title
  combo <- New.comboBoxNewText
  for labels (\l -> New.comboBoxAppendText combo =<< i18n l)
  boxPackStart  hbox  label  PackNatural 5
  boxPackStart  hbox  combo  PackGrow    5
  widgetSetSizeRequest combo 10 (-1)           -- óìåíüøèì ðàçìåð êîáî-áîêñà, ïîñîëüêó èíà÷å äèàëîã ñæàòèÿ ñòàíîâèòñÿ ñëèøêîì øèðîê
  return gtkWidget { gwWidget      = hbox
                   , gwGetValue    = New.comboBoxGetActive combo >>== fromMaybe 0
                   , gwSetValue    = New.comboBoxSetActive combo
                   }


{-# NOINLINE simpleComboBox #-}
-- |Ñîçäà¸ò êîìáîáîêñ, ñîäåðæàùèé çàäàííûé íàáîð àëüòåðíàòèâ
simpleComboBox labels = do
  combo <- New.comboBoxNewText
  for labels (New.comboBoxAppendText combo)
  return combo

{-# NOINLINE makePopupMenu #-}
-- |Ñîçäà¸ò popup menu
makePopupMenu action labels = do
  m <- menuNew
  mapM_ (mkitem m) labels
  return m
    where
        mkitem menu label =
            do i <- menuItemNewWithLabel label
               menuShellAppend menu i
               i `onActivateLeaf` (action label)



{-# NOINLINE radioFrame #-}
-- |Ñîçäà¸ò ôðåéì, ñîäåðæàùèé íàáîð ðàäèîêíîïîê è âîçâðàùàåò ýòîò ôðåéì
--  ïëþñ ïðîöåäóðó äëÿ ÷òåíèÿ òåêóùåé âûáðàííîé êíîïêè
radioFrame title (label1:labels) = do
  -- Ñîçäàòü ðàäèî-êíîïêè, îáúåäèíèâ èõ â îäíó ãðóïïó
  radio1 <- radioButtonNewWithMnemonic .$i18t label1
  radios <- mapM (\title -> radioButtonNewWithMnemonicFromWidget radio1 .$i18t title) labels
  let buttons = radio1:radios
  -- Óïàêîâàòü èõ âåðòèêàëüíî è çàñòàâèòü âûïîëíÿòü ñîáûòèå, çàïîìíåííîå â ïåðåìåííîé onChanged
  vbox <- vBoxNew False 0
  onChanged <- ref doNothing0
  for buttons $ \button -> do boxPackStart vbox button PackNatural 0
                              button `onToggled` do
                                whenM (val button) $ do
                                  val onChanged >>= id
  -- Ñîçäàòü ðàìî÷êó âîêðóã êíîïîê
  frame <- i18t title $ \title -> do
             frame <- frameNew
             set frame [frameLabel := title.$ deleteIf (=='_'), containerChild := vbox]
             return frame
  return gtkWidget { gwWidget      = frame
                   , gwGetValue    = foreach buttons val >>== fromJust.elemIndex True
                   , gwSetValue    = \i -> (buttons!!i) =: True
                   , gwSetOnUpdate = (onChanged=:)
                   }


{-# NOINLINE twoColumnTable #-}
-- |Äâóõêîëîíî÷íàÿ òàáëèöà, îòîáðàæàþùàÿ çàäàííûå ìåòêè+äàííûå
twoColumnTable dataset = do
  (table, setLabels) <- emptyTwoColumnTable$ map fst dataset
  zipWithM_ ($) setLabels (map snd dataset)
  return table

{-# NOINLINE emptyTwoColumnTable #-}
-- |Äâóõêîëîíî÷íàÿ òàáëèöà: ïðèíèìàåò ñïèñîê ìåòîê äëÿ ëåâîé êîëîíêè
-- è âîçâðàùàåò ñïèñîê îïåðàöèé setLabels äëÿ ïîìåùåíèÿ äàííûõ âî âòîðóþ êîëîíêó
emptyTwoColumnTable dataset = do
  table <- tableNew (length dataset) 2 False
  -- Ñîçäàäèì ïîëÿ äëÿ âûâîäà òåêóùåé ñòàòèñòèêè è íàðèñóåì ìåòêè ê íèì
  setLabels <- foreach (zip [0..] dataset) $ \(y,s) -> do
      -- Ïåðâàÿ êîëîíêà
      label <- labelNewWithMnemonic =<< i18n s;  let x=0
      tableAttach table label (x+0) (x+1) y (y+1) [Expand, Fill] [Expand, Fill] 0 0
      miscSetAlignment label 0 0     --set label [labelWidthChars := 25]
      -- Âòîðàÿ êîëîíêà
      label <- labelNew Nothing
      tableAttach table label (x+1) (x+2) y (y+1) [Expand, Fill] [Expand, Fill] 10 0
      set label [labelSelectable := True]
      miscSetAlignment label 1 0
      -- Âîçâðàòèì îïåðàöèþ, óñòàíàâëèâàþùóþ òåêñò âòîðîé ìåòêè (ïðåäíàçíà÷åííîé äëÿ âûâîäà äàííûõ)
      return$ \text -> labelSetMarkup label$ bold$ text
  return (table, setLabels)

{-# NOINLINE scrollableTextView #-}
-- |Ïðîêðó÷èâàåìûé TextView
scrollableTextView s attributes = do
  control <- newTextViewWithText s
  set control attributes
  -- Scrolled window where the TextView will be placed
  scrwin <- scrolledWindowNew Nothing Nothing
  scrolledWindowSetPolicy scrwin PolicyAutomatic PolicyAutomatic
  containerAdd scrwin control
  return gtkWidget { gwWidget   = scrwin
                   , gwGetValue = val control
                   , gwSetValue = (control=:)
                   }

-- |Ñîçäà¸ò íîâûé îáúåêò TextView ñ çàäàííûì òåêñòîì
newTextViewWithText s = do
  textView <- textViewNew
  textViewSetText textView s
  return textView

-- |Çàäà¸ò òåêñò, îòîáðàæàåìûé â TextView
textViewSetText textView s = do
  buffer <- textViewGetBuffer textView
  textBufferSetText buffer s

-- |Ñ÷èòûâàåò òåêñò, îòîáðàæàåìûé â TextView
textViewGetText textView = do
  buffer <- textViewGetBuffer      textView
  start  <- textBufferGetStartIter buffer
  end    <- textBufferGetEndIter   buffer
  textBufferGetText buffer start end False


----------------------------------------------------------------------------------------------------
---- Âûáîð ôàéëà -----------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------

#if defined(FREEARC_WIN)

{-# NOINLINE chooseFile #-}
-- |Âûáîð ôàéëà ÷åðåç äèàëîã
chooseFile parentWindow dialogType dialogTitle filters getFilename setFilename = do
  title <- i18n dialogTitle
  filename <- getFilename >>== windosifyPath
  -- Ñòðîêà ôèëüòðîâ ñîñòîèò èç ïàð (íàçâàíèå,øàáëîíû), ðàçäåë¸ííûõ NULL char, ïëþñ äîïîëíèòåëüíûé NULL char â êîíöå
  filterStr <- prepareFilters filters >>== map (join2 "\0") >>== joinWith "\0" >>== (++"\0")
  withCFilePath title            $ \c_prompt   -> do
  withCFilePath filename         $ \c_filename -> do
  withCFilePath filterStr        $ \c_filters  -> do
  allocaBytes (long_path_size*4) $ \c_outpath  -> do
    result <- case dialogType of
                FileChooserActionSelectFolder  ->  c_BrowseForFolder c_prompt c_filename c_outpath
                _                              ->  c_BrowseForFile   c_prompt c_filters c_filename c_outpath
    when (result/=0) $ do
       setFilename =<< peekCFilePath c_outpath

foreign import ccall safe "Environment.h BrowseForFolder"  c_BrowseForFolder :: CFilePath -> CFilePath -> CFilePath -> IO CInt
foreign import ccall safe "Environment.h BrowseForFile"    c_BrowseForFile   :: CFilePath -> CFilePath -> CFilePath -> CFilePath -> IO CInt


guiFormatDateTime t = unsafePerformIO $ do
  allocaBytes 1000 $ \buf -> do
  c_GuiFormatDateTime t buf 1000 nullPtr nullPtr
  peekCString buf

foreign import ccall safe "Environment.h GuiFormatDateTime"
  c_GuiFormatDateTime :: CTime -> CString -> CInt -> CString -> CString -> IO ()

#else

{-# NOINLINE chooseFile #-}
-- |Âûáîð ôàéëà ÷åðåç äèàëîã
chooseFile parentWindow dialogType dialogTitle filters getFilename setFilename = do
  title <- i18n dialogTitle
  filename <- getFilename
  [select,cancel] <- i18ns ["0363 _Select", "0081 _Cancel"]
  bracketCtrlBreak "chooseFile" (fileChooserDialogNew (Just title) (Just$ castToWindow parentWindow) dialogType [(select,ResponseOk), (cancel,ResponseCancel)]) widgetDestroy $ \chooserDialog -> do
    fileChooserSetFilename chooserDialog (unicode2utf8 filename)
    case dialogType of
      FileChooserActionSave -> fileChooserSetCurrentName chooserDialog (takeFileName filename)
      _                     -> fileChooserSetFilename    chooserDialog (unicode2utf8 filename++"/non-existing-file") >> return ()
    prepareFilters filters >>= addFilters chooserDialog
    choice <- dialogRun chooserDialog
    when (choice==ResponseOk) $ do
      whenJustM_ (fileChooserGetFilename chooserDialog) $ \filename -> do
        setFilename (utf8_to_unicode filename)

{-# NOINLINE addFilters #-}
-- |Óñòàíîâèòü ôèëüòðû äëÿ âûáîðà ôàéëà
addFilters chooserDialog filters = do
  for filters $ \(text, patterns) -> do
    filt <- fileFilterNew
    fileFilterSetName filt text
    for (patterns.$ split ';')  (fileFilterAddPattern filt)
    fileChooserAddFilter chooserDialog filt

guiFormatDateTime = formatDateTime

#endif


-- |Ïîäãîòîâèòü ôèëüòðû ê èñïîëüçîâàíèþ â äèàëîãå
prepareFilters filters = do
  foreach (filters &&& filters++["0309 All files (*)"]) $ \element -> do
    text <- i18n element
    let patterns = text .$words .$last .$drop 1 .$dropEnd 1
    return (text, patterns)