[double turn commands intro (pending state for discarders ) paolo.veronelli@gmail.com**20080203151416] { hunk ./Editor.hs 1 -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE MultiParamTypeClasses,NoMonomorphismRestriction #-} hunk ./Editor.hs 18 - filename :: Maybe String -- ^ the file we are editing + filename :: Maybe String, -- ^ the file we are editing + pending :: Maybe Command, -- ^ a sensible state for data lost + lastsaved :: Maybe w hunk ./Editor.hs 32 +setpending x = get >>= \y -> put y {pending = x} +setlastsaved = get >>= \y -> put y {lastsaved = Just (file y)} +unsetlastsaved = get >>= \y -> put y {lastsaved = Nothing} + + + hunk ./Editor.hs 54 + | PendingState Command -- ^ a sensible data discarding command has been entered hunk ./Editor.hs 107 - deriving Show + deriving (Show,Eq) + hunk ./Eval.hs 14 + hunk ./Eval.hs 19 + + hunk ./Eval.hs 40 -eval (CC (Edit e) _) = asks readfileSio >>= liftSio . runErrorT . ($ e) >>= + +eval (CC c@(Edit e) _) = evalSensible c $ + asks readfileSio >>= liftSio . runErrorT . ($ e) >>= hunk ./Eval.hs 44 - setfilename (Just e) -eval (CC Write _) = getname (errorlog FileNameMissing >> return "") >>= write + setfilename (Just e) >> setlastsaved +eval (CC Write _) = getname (errorlog FileNameMissing >> return "") >>= write >> + unsetlastsaved hunk ./Eval.hs 49 - setfilename (Just name) -- eventually set it + setfilename (Just name) >> setlastsaved hunk ./Eval.hs 51 -eval (CC (SetFilename s) _) = setfilename (Just s) -eval (CC (EditExternal s) _) = asks externalSio >>= liftSio . runErrorT . ($ s) >>= - either (errorlog . ExternalCommandErr) (putfile . listIn . lines) +eval (CC c@(SetFilename s) _) = evalSensible c $ + setfilename (Just s) >> unsetlastsaved +eval (CC c@(EditExternal s) _) = evalSensible c $ + asks externalSio >>= liftSio . runErrorT . ($ s) >>= + either (errorlog . ExternalCommandErr) (putfile . listIn . lines) >> + unsetlastsaved hunk ./Eval.hs 70 + setlastsaved hunk ./Main.hs 34 -main = run (commandLoop parse eval) programSio (Stato empty "" Nothing) :: IO (Stato InsideAppend) +main = run (commandLoop parse eval) programSio (Stato empty "" Nothing Nothing Nothing) :: IO (Stato InsideAppend) hunk ./Operation.hs 11 +-- | a real check for file modification +modified :: Ctx m w => Editor m w Bool +modified = do + lastw <- gets lastsaved + now <- gets file + return $ maybe True (== now) lastw + +resetpending :: Ctx m w => Editor m w () +resetpending = setpending Nothing + +-- | a wrapper for commands evaluation which can discard changes +evalSensible :: Ctx m w => Command -> Editor m w () -> Editor m w () +evalSensible c action = do + mod <- modified + if mod then + let onunpending = setpending (Just c) >> errorlog (PendingState c) + onpending x = if x == c then action >> resetpending + else onunpending + in gets pending >>= maybe onunpending onpending + else action >> resetpending + +-- | a wrapper for commands evaluation which cannot discard changes +checkPendings :: Ctx m w => Editor m w () -> Editor m w () +checkPendings action = do + pends <- gets pending + action + newpends <- gets pending + when (newpends == pends) resetpending + hunk ./Operation.hs 48 - ((history line >>). eval) + ((history line >>). checkPendings . eval) hunk ./docs/Editor.html 106 +>