Merge branch 'bugfix/terminal-init-flags'

This commit is contained in:
Jonathan Daugherty 2020-07-09 15:05:20 -07:00
commit a828f305d0
2 changed files with 52 additions and 24 deletions

View File

@ -143,22 +143,8 @@ import Data.Monoid ((<>))
-- bytes comes from 'classifyMapForTerm' which is then overridden by
-- the the applicable entries from the configuration's 'inputMap'.
--
-- The terminal device is configured with the attributes:
--
-- * IXON disabled: disables software flow control on outgoing data.
-- This stops the process from being suspended if the output terminal
-- cannot keep up.
--
-- * Raw mode is used for input.
--
-- * ISIG disabled (enables keyboard combinations that result in
-- signals)
--
-- * ECHO disabled (input is not echoed to the output)
--
-- * ICANON disabled (canonical mode (line mode) input is not used)
--
-- * IEXTEN disabled (extended functions are disabled)
-- The terminal device's mode flags are configured by the
-- 'attributeControl' function.
inputForConfig :: Config -> IO Input
inputForConfig config@Config{ termName = Just termName
, inputFd = Just termFd
@ -168,7 +154,7 @@ inputForConfig config@Config{ termName = Just termName
terminal <- Terminfo.setupTerm termName
let inputOverrides = [(s,e) | (t,s,e) <- inputMap, t == Nothing || t == Just termName]
activeInputMap = classifyMapForTerm termName terminal `mappend` inputOverrides
(setAttrs,unsetAttrs) <- attributeControl termFd
(setAttrs, unsetAttrs) <- attributeControl termFd
setAttrs
input <- initInput config activeInputMap
let pokeIO = Catch $ do
@ -177,11 +163,15 @@ inputForConfig config@Config{ termName = Just termName
atomically $ writeTChan (input^.eventChannel) (EvResize e e)
_ <- installHandler windowChange pokeIO Nothing
_ <- installHandler continueProcess pokeIO Nothing
let restore = unsetAttrs
return $ input
{ shutdownInput = do
shutdownInput input
_ <- installHandler windowChange Ignore Nothing
_ <- installHandler continueProcess Ignore Nothing
unsetAttrs
restore
, restoreInputState = restoreInputState input >> restore
}
inputForConfig config = (<> config) <$> standardIOConfig >>= inputForConfig

View File

@ -52,9 +52,14 @@ data Input = Input
-- 'nextEvent' this will not refresh the display if the next event
-- is an 'EvResize'.
_eventChannel :: TChan Event
-- | Shuts down the input processing. This should return the
-- terminal input state to before he input initialized.
-- | Shuts down the input processing. As part of shutting down the
-- input, this should also restore the input state.
, shutdownInput :: IO ()
-- | Restore the terminal's input state to what it was prior
-- to configuring input for Vty. This should be done as part of
-- 'shutdownInput' but is exposed in case you need to access it
-- directly.
, restoreInputState :: IO ()
-- | Changes to this value are reflected after the next event.
, _configRef :: IORef Config
-- | input debug log
@ -171,15 +176,47 @@ runInputProcessorLoop classifyTable input = do
<*> pure (classify classifyTable)
runReaderT (evalStateT loopInputProcessor s0) input
-- | Construct two IO actions: one to configure the terminal for Vty and
-- one to restore the terminal mode flags to the values they had at the
-- time this function was called.
--
-- This function constructs a configuration action to clear the
-- following terminal mode flags:
--
-- * IXON disabled: disables software flow control on outgoing data.
-- This stops the process from being suspended if the output terminal
-- cannot keep up.
--
-- * Raw mode is used for input.
--
-- * ISIG (enables keyboard combinations that result in
-- signals)
--
-- * ECHO (input is not echoed to the output)
--
-- * ICANON (canonical mode (line mode) input is not used)
--
-- * IEXTEN (extended functions are disabled)
--
-- The configuration action also explicitly sets these flags:
--
-- * ICRNL (input carriage returns are mapped to newlines)
attributeControl :: Fd -> IO (IO (), IO ())
attributeControl fd = do
original <- getTerminalAttributes fd
let vtyMode = foldl withoutMode original [ StartStopOutput, KeyboardInterrupts
, EnableEcho, ProcessInput, ExtendedFunctions
]
let vtyMode = foldl withMode clearedFlags flagsToSet
clearedFlags = foldl withoutMode original flagsToUnset
flagsToSet = [ MapCRtoLF -- ICRNL
]
flagsToUnset = [ StartStopOutput -- IXON
, KeyboardInterrupts -- ISIG
, EnableEcho -- ECHO
, ProcessInput -- ICANON
, ExtendedFunctions -- IEXTEN
]
let setAttrs = setTerminalAttributes fd vtyMode Immediately
unsetAttrs = setTerminalAttributes fd original Immediately
return (setAttrs,unsetAttrs)
return (setAttrs, unsetAttrs)
logInitialInputState :: Input -> ClassifyMap -> IO()
logInitialInputState input classifyTable = case _inputDebug input of
@ -203,6 +240,7 @@ initInput config classifyTable = do
applyConfig fd config
stopSync <- newEmptyMVar
input <- Input <$> atomically newTChan
<*> pure (return ())
<*> pure (return ())
<*> newIORef config
<*> maybe (return Nothing)