a828f30 · vty · git.iko.soy

git.iko.soy/vty

Merge branch 'bugfix/terminal-init-flags'

commita828f305d0d226b978623edba9a7e1b228ce83af authorJonathan Daugherty <cygnus@foobox.com> dateThu 9 Jul 2020, 15:05 (6 years ago) parent17e2560 812e873

2 files changed+52−24

compare with master

unifiedsplit

src/Graphics/Vty/Input.hs+8−18 src/Graphics/Vty/Input/Loop.hs+44−6

src/Graphics/Vty/Input.hs+8−18

@@ -143,22 +143,8 @@ import Data.Monoid ((<>))

143143-- bytes comes from 'classifyMapForTerm' which is then overridden by

144144-- the the applicable entries from the configuration's 'inputMap'.

145145--

146−-- The terminal device is configured with the attributes:

147−--

148−-- * IXON disabled: disables software flow control on outgoing data.

149−-- This stops the process from being suspended if the output terminal

150−-- cannot keep up.

151−--

152−-- * Raw mode is used for input.

153−--

154−-- * ISIG disabled (enables keyboard combinations that result in

155−-- signals)

156−--

157−-- * ECHO disabled (input is not echoed to the output)

158−--

159−-- * ICANON disabled (canonical mode (line mode) input is not used)

160−--

161−-- * IEXTEN disabled (extended functions are disabled)

146+-- The terminal device's mode flags are configured by the

147+-- 'attributeControl' function.

162148inputForConfig :: Config -> IO Input

163149inputForConfig config@Config{ termName = Just termName

164150 , inputFd = Just termFd

@@ -168,7 +154,7 @@ inputForConfig config@Config{ termName = Just termName

168154 terminal <- Terminfo.setupTerm termName

169155 let inputOverrides = [(s,e) | (t,s,e) <- inputMap, t == Nothing || t == Just termName]

170156 activeInputMap = classifyMapForTerm termName terminal `mappend` inputOverrides

171− (setAttrs,unsetAttrs) <- attributeControl termFd

157+ (setAttrs, unsetAttrs) <- attributeControl termFd

172158 setAttrs

173159 input <- initInput config activeInputMap

174160 let pokeIO = Catch $ do

@@ -177,11 +163,15 @@ inputForConfig config@Config{ termName = Just termName

177163 atomically $ writeTChan (input^.eventChannel) (EvResize e e)

178164 _ <- installHandler windowChange pokeIO Nothing

179165 _ <- installHandler continueProcess pokeIO Nothing

166+

167+ let restore = unsetAttrs

168+

180169 return $ input

181170 { shutdownInput = do

182171 shutdownInput input

183172 _ <- installHandler windowChange Ignore Nothing

184173 _ <- installHandler continueProcess Ignore Nothing

185− unsetAttrs

174+ restore

175+ , restoreInputState = restoreInputState input >> restore

186176 }

187177inputForConfig config = (<> config) <$> standardIOConfig >>= inputForConfig

src/Graphics/Vty/Input/Loop.hs+44−6

@@ -52,9 +52,14 @@ data Input = Input

5252 -- 'nextEvent' this will not refresh the display if the next event

5353 -- is an 'EvResize'.

5454 _eventChannel :: TChan Event

55− -- | Shuts down the input processing. This should return the

56− -- terminal input state to before he input initialized.

55+ -- | Shuts down the input processing. As part of shutting down the

56+ -- input, this should also restore the input state.

5757 , shutdownInput :: IO ()

58+ -- | Restore the terminal's input state to what it was prior

59+ -- to configuring input for Vty. This should be done as part of

60+ -- 'shutdownInput' but is exposed in case you need to access it

61+ -- directly.

62+ , restoreInputState :: IO ()

5863 -- | Changes to this value are reflected after the next event.

5964 , _configRef :: IORef Config

6065 -- | input debug log

@@ -171,15 +176,47 @@ runInputProcessorLoop classifyTable input = do

171176 <*> pure (classify classifyTable)

172177 runReaderT (evalStateT loopInputProcessor s0) input

173178

179+-- | Construct two IO actions: one to configure the terminal for Vty and

180+-- one to restore the terminal mode flags to the values they had at the

181+-- time this function was called.

182+--

183+-- This function constructs a configuration action to clear the

184+-- following terminal mode flags:

185+--

186+-- * IXON disabled: disables software flow control on outgoing data.

187+-- This stops the process from being suspended if the output terminal

188+-- cannot keep up.

189+--

190+-- * Raw mode is used for input.

191+--

192+-- * ISIG (enables keyboard combinations that result in

193+-- signals)

194+--

195+-- * ECHO (input is not echoed to the output)

196+--

197+-- * ICANON (canonical mode (line mode) input is not used)

198+--

199+-- * IEXTEN (extended functions are disabled)

200+--

201+-- The configuration action also explicitly sets these flags:

202+--

203+-- * ICRNL (input carriage returns are mapped to newlines)

174204attributeControl :: Fd -> IO (IO (), IO ())

175205attributeControl fd = do

176206 original <- getTerminalAttributes fd

177− let vtyMode = foldl withoutMode original [ StartStopOutput, KeyboardInterrupts

178− , EnableEcho, ProcessInput, ExtendedFunctions

179− ]

207+ let vtyMode = foldl withMode clearedFlags flagsToSet

208+ clearedFlags = foldl withoutMode original flagsToUnset

209+ flagsToSet = [ MapCRtoLF -- ICRNL

210+ ]

211+ flagsToUnset = [ StartStopOutput -- IXON

212+ , KeyboardInterrupts -- ISIG

213+ , EnableEcho -- ECHO

214+ , ProcessInput -- ICANON

215+ , ExtendedFunctions -- IEXTEN

216+ ]

180217 let setAttrs = setTerminalAttributes fd vtyMode Immediately

181218 unsetAttrs = setTerminalAttributes fd original Immediately

182− return (setAttrs,unsetAttrs)

219+ return (setAttrs, unsetAttrs)

183220

184221logInitialInputState :: Input -> ClassifyMap -> IO()

185222logInitialInputState input classifyTable = case _inputDebug input of

@@ -203,6 +240,7 @@ initInput config classifyTable = do

203240 applyConfig fd config

204241 stopSync <- newEmptyMVar

205242 input <- Input <$> atomically newTChan

243+ <*> pure (return ())

206244 <*> pure (return ())

207245 <*> newIORef config

208246 <*> maybe (return Nothing)