diff options
| -rw-r--r-- | Screen.hs | 32 | ||||
| -rw-r--r-- | test5.hs | 43 |
2 files changed, 43 insertions, 32 deletions
diff --git a/Screen.hs b/Screen.hs new file mode 100644 index 0000000..2bf0329 --- /dev/null +++ b/Screen.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE RecordWildCards #-} +module Screen (Screen(..), setScreen, withScreen) where + +import Control.Exception +import Data.List +import System.IO + +data Screen = Screen + { stdinEcho :: Bool + , stdinBufferMode :: BufferMode + , stdoutBufferMode :: BufferMode + , decsetPm :: [Int] + , decrstPm :: [Int] + } + +setScreen :: Screen -> IO Screen +setScreen Screen{..} = get <* set where + get = Screen <$> hGetEcho stdin + <*> hGetBuffering stdin + <*> hGetBuffering stdout + <*> pure decrstPm + <*> pure decsetPm + set = do + hSetEcho stdin stdinEcho + hSetBuffering stdin stdinBufferMode + hSetBuffering stdout stdoutBufferMode + hPutStr stdout $ "\ESC[?" ++ intercalate ";" (map show decsetPm) ++ "h" + hPutStr stdout $ "\ESC[?" ++ intercalate ";" (map show decrstPm) ++ "l" + hFlush stdout + +withScreen :: Screen -> (Screen -> IO a) -> IO a +withScreen s = bracket (setScreen s) setScreen @@ -34,6 +34,7 @@ import Event import ParseMail (readMail) import RenderTreeView (renderTreeView) import Scanner (scan,Scan(..)) +import Screen import Safe import System.Directory import System.Console.Docopt.NoTH (getArgWithDefault, parseArgsOrExit, parseUsageOrExit, shortOption) @@ -78,8 +79,6 @@ data State = State , headBuffer :: [Blessings String] , treeBuffer :: [Blessings String] , now :: UTCTime - , decset :: [Int] - , decrst :: [Int] } initState :: String -> IO State @@ -96,14 +95,6 @@ initState query = do , headBuffer = [] , treeBuffer = [] , now = UTCTime (fromGregorian 1984 5 23) 49062 - , decset = - 1000 : -- X & Y on button press and release - 1005 : -- UTF-8 mouse mode - 1049 : -- use cleared alternate screen buffer - [] - , decrst = - 25 : -- hide cursor - [] } @@ -117,7 +108,7 @@ mainWithArgs args = do usage' <- parseUsageOrExit usage args' <- parseArgsOrExit usage' args let query = getArgWithDefault args' defaultSearch (shortOption 'q') - bracket (initState query) cleanup startup + withScreen s0 (\_-> initState query >>= runState) where usage = unlines [ "Command-line MUA using notmuch." @@ -131,25 +122,20 @@ mainWithArgs args = do ] defaultSearch = "tag:inbox AND NOT tag:killed" + s0 = Screen False NoBuffering (BlockBuffering $ Just 4096) + [ 1000 -- X & Y on button press and release + , 1005 -- UTF-8 mouse mode + , 1047 -- use alternate screen buffer + ] + [ 25 -- hide cursor + ] -cleanup :: State -> IO () -cleanup q@State{..} = do - hSetEcho stdin True - resetTerm q { decset = decrst, decrst = decset } - - -startup :: State -> IO () -startup q0 = do +runState :: State -> IO () +runState q0 = do -- load-env hack maybe (return ()) (setEnv "HOME") =<< lookupEnv "OLDHOME" - -- TODO move this to resetTerm? - hSetBuffering stdin NoBuffering - hSetBuffering stdout (BlockBuffering $ Just 4096) - - resetTerm q0 - (putEvent, getEvent) <- do v <- newEmptyMVar return (putMVar v, takeMVar v) @@ -175,13 +161,6 @@ startup q0 = do mapM_ killThread threadIds -resetTerm :: State -> IO () -resetTerm State{..} = do - hSetEcho stdin False - hPutStr stdout $ "\ESC[?" ++ intercalate ";" (map show decset) ++ "h" - hPutStr stdout $ "\ESC[?" ++ intercalate ";" (map show decrst) ++ "l" - - winchHandler :: (Event -> IO ()) -> IO () winchHandler putEvent = Term.size >>= \case |