Errors.hs: finished fixing error handling (at least now it can cancel…

… GUI operations w/o destroying whole program :)

git-svn-id: https://freearc.svn.sourceforge.net/svnroot/freearc@117 3a4f7f31-9599-433d-91b1-573e8b61252c

ArcvProcessExtract.hs

@@ -48,11 +48,11 @@ decompress_PROCESS command count_cbytes pipe = do
       state <- ref (error "Decompression state is not initialized!")
       repeat_until $ do
         decompress_block command cfile state count_cbytes pipe
-        programTerminated' <- val programTerminated
-        when programTerminated' $ do
-          sendP pipe (error "Operation terminated by user", aFREEARC_ERRCODE_OPERATION_TERMINATED)
+        operationTerminated' <- val operationTerminated
+        when operationTerminated' $ do
+          sendP pipe (error "Decompression terminated", aFREEARC_ERRCODE_OPERATION_TERMINATED)
         (x,_,_) <- val state
-        return (x == aSTOP_DECOMPRESS_THREAD || programTerminated')
+        return (x == aSTOP_DECOMPRESS_THREAD || operationTerminated')
 
 
 {-# NOINLINE decompress_block #-}

ArcvProcessRead.hs

@@ -56,7 +56,7 @@ notTheEnd  _       = True
 create_archive_structure_AND_read_files_PROCESS command archive oldarc files processDir arcComment writeRecoveryBlocks results backdoor pipe = do
   initPos <- archiveGetPos archive
   -- Ïðè âîçíèêíîâåíèè îøèáêè óñòàíîâèì ôëàã äëÿ ïðåðûâàíèÿ ðàáîòû c_compress()
-  handleCtrlBreak (programTerminated =: True) $ do
+  handleCtrlBreak (operationTerminated =: True) $ do
   -- Ñîçäàäèì ïðîöåññ äëÿ ðàñïàêîâêè ôàéëîâ èç âõîäíûõ àðõèâîâ è ãàðàíòèðóåì åãî êîððåêòíîå çàâåðøåíèå
   bracketCtrlBreak (runAsyncP$ decompress_PROCESS command doNothing)
                    ( \decompress_pipe -> do sendP decompress_pipe Nothing; joinP decompress_pipe)

Compression.hs

@@ -268,8 +268,8 @@ freearcDecompress num method                       =  checkingCtrlBreak num (Com
 -- èñêëþ÷åíèé, äîáàâèì ê ïðîöåäóðàì ÷òåíèÿ/çàïèñè ÿâíûå ïðîâåðêè
 checkingCtrlBreak num action callback = do
   let checked_callback what buf size auxdata = do
-        programTerminated' <- val programTerminated
-        if programTerminated'
+        operationTerminated' <- val operationTerminated
+        if operationTerminated'
           then return CompressionLib.aFREEARC_ERRCODE_OPERATION_TERMINATED   -- foreverM doNothing0
           else callback what buf size
   --

Errors.hs

@@ -87,21 +87,18 @@ setCtrlBreakHandler action = do
 
 -- |Âûçâàòü fail, åñëè óñòàíîâëåí ôëàã àâàðèéíîãî çàâåðøåíèÿ ïðîãðàììû
 failOnTerminated = do
-  whenM (val programTerminated) $ do
-    -- unlessM (val fileManagerMode) $ do
-      fail$ errormsg TERMINATED
+  whenM (val operationTerminated) $ do
+    fail ""
 
--- |Îáðàáîòêà Ctrl-Break ñâîäèòñÿ ê âûïîëíåíèþ ôèíàëèçàòîðîâ è
+-- |Îáðàáîòêà Ctrl-Break è íàæàòèÿ íà Cancel ñâîäèòñÿ ê âûïîëíåíèþ ôèíàëèçàòîðîâ è
 -- óñòàíîâêå ñïåö. ôëàãà, êîòîðûé ïðîâåðÿåòñÿ êîëëáýêàìè, âûçûâàåìûìè èç Ñè
 onBreak event = terminateOperation
 terminateOperation = do
   isFM <- val fileManagerMode
   registerError$ iif isFM OP_TERMINATED TERMINATED
 
-shutdown msg_ exitCode_ = do
-  programTerminated' <- val programTerminated
-  let (msg, exitCode)  | programTerminated'  =  (errormsg TERMINATED, aEXIT_CODE_USER_BREAK)
-                       | otherwise           =  (msg_, exitCode_)
+-- |Ïðèíóäèòåëüíî çàâåðøàåò âûïîëíåíèå ïðîãðàììû ñ çàäàííûì exitCode è ïå÷àòüþ ñîîáùåíèÿ msg
+shutdown msg exitCode = do
   separator' =: ("","\n")
   log_separator' =: "\n"
   fin <- val finalizers
@@ -110,7 +107,7 @@ shutdown msg_ exitCode_ = do
 
   w <- val warnings
   case w of
-    0 -> when (exitCode==aEXIT_CODE_SUCCESS) $ condPrintLineLn "k"$ "All OK"
+    0 -> when (exitCode==aEXIT_CODE_SUCCESS) $ condPrintLineLn "k" "All OK"
     _ -> condPrintLineLn "n"$ "There were "++show w++" warning(s)"
   ignoreErrors (msg &&& condPrintLineLn "n" msg)
   condPrintLineLn "e" ""
@@ -165,14 +162,14 @@ curId :: IORef Int
 curId = unsafePerformIO (ref 0)
 {-# NOINLINE curId #-}
 
--- |Ñïèñîê äåéñòâèé, êîòîðûå íàäî âûïîëíèòü ïåðåä âûõîäîì ïî ^Break
+-- |Ñïèñîê äåéñòâèé, êîòîðûå íàäî âûïîëíèòü ïåðåä àâàðèéíûì çàâåðøåíèåì ïðîãðàììû
 finalizers :: IORef [(Int, IO ())]
 finalizers = unsafePerformIO (ref [])
 {-# NOINLINE finalizers #-}
 
--- |Ýòîò ôëàã óñòàíàâëèâàåòñÿ ïîñëå òîãî, êàê ïîëüçîâàòåëü íàæàë Ctrl-Break
-programTerminated = unsafePerformIO (ref False)
-{-# NOINLINE programTerminated #-}
+-- |Ôëàã, ïîêàçûâàþùèé ÷òî ìû íàõîäèìñÿ â ðåæèìå ïðåðûâàíèÿ òåêóùåé îïåðàöèè
+operationTerminated = unsafePerformIO (ref False)
+{-# NOINLINE operationTerminated #-}
 
 -- |Ðåæèì ðàáîòû ôàéë-ìåíåäæåðà: ïðè ýòîì terminateOperation îáðàáàòûâàåòñÿ ïî-äðóãîìó - ìû äîæèäàåìñÿ çàâåðøåíèÿ âñåõ òðåäîâ óïàêîâêè è ðàñïàêîâêè
 fileManagerMode = unsafePerformIO (ref False)
@@ -383,7 +380,7 @@ registerError err = do
   -- èíà÷å - ïðîñòî ñîâåðøàåì àâàðèéíûé âûõîä èç ïðîãðàììû
   unlessM (val fileManagerMode) $ do
     shutdown ("ERROR: "++msg) (errcode err)
-  programTerminated =: True
+  operationTerminated =: True
   fail ""
 
 -- |Çàïèñü ïðåäóïðåæäåíèÿ â ëîãôàéë è âûâîä åãî íà ýêðàí

FileManager.hs

@@ -490,15 +490,15 @@ myGUI run args = do
 ----------------------------------------------------------------------------------------------------
 
   -- Ïðè âûïîëíåíèè îïåðàöèé íå âûõîäèì ïî èñêëþ÷åíèÿì, à ïå÷àòàåì ñîîáùåíèÿ î íèõ â ëîãôàéë
-  let handleErrors action x  =  do programTerminated =: False
-                                   (action x `catch` handler) `finally` (programTerminated =: False)
+  let handleErrors action x  =  do operationTerminated =: False
+                                   (action x `catch` handler) `finally` (operationTerminated =: False)
         where handler ex = do
-                programTerminated' <- val programTerminated
+                operationTerminated' <- val operationTerminated
                 errmsg <- case ex of
-                   _ | programTerminated' -> i18n"0010 Operation interrupted!"
-                   Deadlock               -> i18n"0011 No threads to run: infinite loop or deadlock?"
-                   ErrorCall s            -> return s
-                   other                  -> return$ showsPrec 0 other ""
+                   _ | operationTerminated' -> i18n"0010 Operation interrupted!"
+                   Deadlock                 -> i18n"0011 No threads to run: infinite loop or deadlock?"
+                   ErrorCall s              -> return s
+                   other                    -> return$ showsPrec 0 other ""
                 with' (val log_separator') (log_separator'=:) $ \_ -> do
                   log_separator' =: ""
                   io$ condPrintLineLn "w" errmsg

UIBase.hs

@@ -87,9 +87,9 @@ syncUI = withMVar mvarSyncUI . const;  mvarSyncUI = unsafePerformIO$ newMVar "mv
 indicatorThread secs output =
   backgroundThread secs $ do
     whenM (val aProgressIndicatorEnabled) $ do
-      aProgramTerminated <- val programTerminated
+      operationTerminated' <- val operationTerminated
       (indicator, arcname, direction, b, bytes', total') <- val aProgressIndicatorState
-      when (indicator /= NoIndicator  &&  not aProgramTerminated) $ do
+      when (indicator /= NoIndicator  &&  not operationTerminated') $ do
         bytes <- bytes' b;  total <- total'
         -- Îòíîøåíèå îáú¸ìà îáðàáîòàííûõ äàííûõ ê îáùåìó îáú¸ìó
         let processed = total>0 &&& (fromIntegral bytes / fromIntegral total :: Double)