@@ -86,6 +86,8 @@ makeLenses ''InputState
87type InputM a = StateT InputState (ReaderT Input IO) a
87type InputM a = StateT InputState (ReaderT Input IO) a
89+-- this must be run on an OS thread dedicated to this input handling.
90+-- otherwise the terminal timing read behavior will block the execution of the lightweight threads.
89loop_input_processor :: InputM ()
91loop_input_processor :: InputM ()
90loop_input_processor = do
92loop_input_processor = do
91 read_from_device >>= add_bytes_to_process
93 read_from_device >>= add_bytes_to_process
@@ -117,7 +119,7 @@ read_from_device = do
117apply_timing_config :: Fd -> Config -> IO ()
119apply_timing_config :: Fd -> Config -> IO ()
118apply_timing_config fd config =
120apply_timing_config fd config =
119 let vtime = min 255 $ singleEscPeriod config `div` 100000
121 let vtime = min 255 $ singleEscPeriod config `div` 100000
120− in set_term_timing fd 0 vtime
122+ in set_term_timing fd 1 vtime
122parse_event :: InputM Event
124parse_event :: InputM Event
123parse_event = do
125parse_event = do
@@ -152,16 +154,16 @@ compile table = cl' where
152 -- create a map from strings to event
154 -- create a map from strings to event
153 event_for_input = flip M.lookup (M.fromList table)
155 event_for_input = flip M.lookup (M.fromList table)
154 cl' [] = Prefix
156 cl' [] = Prefix
157+ cl' input_block = case event_for_input input_block of
158+ Just (EvKey k m) -> Valid k m []
155− cl' input_block = case S.member input_block prefix_set of
159+ Nothing -> case S.member input_block prefix_set of
156− True -> Prefix
160+ True -> Prefix
157− -- if the input_block is exactly what is expected for an event then consume the whole
161+ -- if the input_block is exactly what is expected for an event then consume the whole
158− -- block and return the event
162+ -- block and return the event
159− False -> case event_for_input input_block of
160− Just (EvKey k m) -> Valid k m []
161 -- look up progressively large prefixes of the input block until an event is found
163 -- look up progressively large prefixes of the input block until an event is found
162 -- H: There will always be one match. The prefix_set contains, by definition, all
164 -- H: There will always be one match. The prefix_set contains, by definition, all
163 -- prefixes of an event.
165 -- prefixes of an event.
164− Nothing ->
166+ False ->
165 let input_prefixes = init $ inits input_block
167 let input_prefixes = init $ inits input_block
166 in case mapMaybe (\s -> (,) s `fmap` event_for_input s) input_prefixes of
168 in case mapMaybe (\s -> (,) s `fmap` event_for_input s) input_prefixes of
167 (s,EvKey k m) : _ -> Valid k m (drop (length s) input_block)
169 (s,EvKey k m) : _ -> Valid k m (drop (length s) input_block)
@@ -218,7 +220,7 @@ initInputForFd config_ref classify_table input_fd = do
218 <*> pure (writeIORef stop_flag True)
220 <*> pure (writeIORef stop_flag True)
219 <*> pure config_ref
221 <*> pure config_ref
220 <*> pure input_fd
222 <*> pure input_fd
221− _ <- forkIO $ run_input_processor_loop classify_table input stop_flag
223+ _ <- forkOS $ run_input_processor_loop classify_table input stop_flag
222 return input
224 return input
224foreign import ccall "vty_set_term_timing" set_term_timing :: Fd -> Int -> Int -> IO ()
226foreign import ccall "vty_set_term_timing" set_term_timing :: Fd -> Int -> Int -> IO ()