on master help sign in
Add support for terminal focus events
commit4bcebb1bfe3baceba80f10d22a35dc66cc2c35ad authorJonathan Daugherty <cygnus@foobox.com> dateMon 7 Aug 2017, 13:17 (9 years ago) parentb4111dd
6 files changed+66
src/Graphics/Vty/Input/Classify.hs+2 src/Graphics/Vty/Input/Events.hs+4 src/Graphics/Vty/Input/Focus.hs+47 src/Graphics/Vty/Output/Interface.hs+3 src/Graphics/Vty/Output/XTermColor.hs+9 vty.cabal+1
src/Graphics/Vty/Input/Classify.hs+2
@@ -10,6 +10,7 @@ where
1010
1111import Graphics.Vty.Input.Events
1212import Graphics.Vty.Input.Mouse
13+import Graphics.Vty.Input.Focus
1314import Graphics.Vty.Input.Paste
1415import Graphics.Vty.Input.Classify.Types
1516
@@ -59,6 +60,7 @@ classify table =
5960 then parseBracketedPaste s
6061 else Prefix
6162 _ | isMouseEvent s -> classifyMouseEvent s
63+ _ | isFocusEvent s -> classifyFocusEvent s
6264 c:cs | ord c >= 0xC2 -> classifyUtf8 c cs
6365 _ -> standardClassifier s
6466
src/Graphics/Vty/Input/Events.hs+4
@@ -56,6 +56,10 @@ data Event
5656 -- input (which is probably bad, so beware!) Note that the data is
5757 -- provided in raw form and you'll have to decode (e.g. as UTF-8) if
5858 -- that's what your application expects.
59+ | EvLostFocus
60+ -- ^ The terminal running the application lost input focus.
61+ | EvGainedFocus
62+ -- ^ The terminal running the application gained input focus.
5963 deriving (Eq,Show,Read,Ord,Generic)
6064
6165type ClassifyMap = [(String,Event)]
src/Graphics/Vty/Input/Focus.hsnew file+47
@@ -0,0 +1,47 @@
1+module Graphics.Vty.Input.Focus
2+ ( requestFocusEvents
3+ , disableFocusEvents
4+ , isFocusEvent
5+ , classifyFocusEvent
6+ )
7+where
8+
9+import Graphics.Vty.Input.Events
10+import Graphics.Vty.Input.Classify.Types
11+import Graphics.Vty.Input.Classify.Parse
12+
13+import Control.Monad.State
14+import Data.List (isPrefixOf)
15+
16+-- | These sequences set xterm-based terminals to send focus event
17+-- sequences.
18+requestFocusEvents :: String
19+requestFocusEvents = "\ESC[?1004h"
20+
21+-- | These sequences disable focus events.
22+disableFocusEvents :: String
23+disableFocusEvents = "\ESC[?1004l"
24+
25+-- | Does the specified string begin with a focus event?
26+isFocusEvent :: String -> Bool
27+isFocusEvent s = isPrefixOf focusIn s ||
28+ isPrefixOf focusOut s
29+
30+focusIn :: String
31+focusIn = "\ESC[I"
32+
33+focusOut :: String
34+focusOut = "\ESC[O"
35+
36+-- | Attempt to classify an input string as a focus event.
37+classifyFocusEvent :: String -> KClass
38+classifyFocusEvent s = runParser s $ do
39+ when (not $ isFocusEvent s) failParse
40+
41+ expectChar '\ESC'
42+ expectChar '['
43+ ty <- readChar
44+ case ty of
45+ 'I' -> return EvGainedFocus
46+ 'O' -> return EvLostFocus
47+ _ -> failParse
src/Graphics/Vty/Output/Interface.hs+3
@@ -44,6 +44,9 @@ data Mode = Mouse
4444 | BracketedPaste
4545 -- ^ Paste mode (whether the terminal is configured to provide
4646 -- events on OS pastes)
47+ | Focus
48+ -- ^ Focus-in/focus-out events (whether the terminal is
49+ -- configured to provide events on focus change)
4750 deriving (Eq, Read, Show)
4851
4952-- | The Vty terminal output interface.
src/Graphics/Vty/Output/XTermColor.hs+9
@@ -8,6 +8,7 @@ where
88
99import Graphics.Vty.Output.Interface
1010import Graphics.Vty.Input.Mouse
11+import Graphics.Vty.Input.Focus
1112import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased
1213
1314import Blaze.ByteString.Builder (writeToByteString)
@@ -38,12 +39,18 @@ reserveTerminal variant outFd = liftIO $ do
3839 t <- TerminfoBased.reserveTerminal variant' outFd
3940
4041 mouseModeStatus <- newIORef False
42+ focusModeStatus <- newIORef False
4143 pasteModeStatus <- newIORef False
4244
4345 let xtermSetMode t' m newStatus = do
4446 curStatus <- getModeStatus t' m
4547 when (newStatus /= curStatus) $
4648 case m of
49+ Focus -> liftIO $ do
50+ case newStatus of
51+ True -> flushedPut requestFocusEvents
52+ False -> flushedPut disableFocusEvents
53+ writeIORef focusModeStatus newStatus
4754 Mouse -> liftIO $ do
4855 case newStatus of
4956 True -> flushedPut requestMouseEvents
@@ -56,6 +63,7 @@ reserveTerminal variant outFd = liftIO $ do
5663 writeIORef pasteModeStatus newStatus
5764
5865 xtermGetMode Mouse = liftIO $ readIORef mouseModeStatus
66+ xtermGetMode Focus = liftIO $ readIORef focusModeStatus
5967 xtermGetMode BracketedPaste = liftIO $ readIORef pasteModeStatus
6068
6169 let t' = t
@@ -64,6 +72,7 @@ reserveTerminal variant outFd = liftIO $ do
6472 when (not utf8a) $ liftIO $ flushedPut setDefaultCharSet
6573 setMode t' BracketedPaste False
6674 setMode t' Mouse False
75+ setMode t' Focus False
6776 releaseTerminal t
6877 , mkDisplayContext = \tActual r -> do
6978 dc <- mkDisplayContext t tActual r
vty.cabal+1
@@ -85,6 +85,7 @@ library
8585 Graphics.Vty.Input.Classify.Parse
8686 Graphics.Vty.Input.Loop
8787 Graphics.Vty.Input.Mouse
88+ Graphics.Vty.Input.Focus
8889 Graphics.Vty.Input.Paste
8990 Graphics.Vty.Input.Terminfo
9091 Graphics.Vty.PictureToSpans