d478957 · vty · git.iko.soy

git.iko.soy/vty

Make mouse and paste modes optional and reconfigurable

- Adds mouseMode and bracketedPasteMode fields to Config - Config fields default to False - Adds a Mode type for modal terminal features (mouse events, bracketed paste mode) - The Output interface now has new fields: * supportsMode :: Mode -> Bool tells whether the device supports a mode * setMode :: Mode -> Bool -> IO () turns a mode on or off * getModeStatus :: Mode -> IO Bool tells you whether a mode is on or off

commitd4789578eda60a80cde7f3c12cc3a6a31c11049f authorJonathan Daugherty <cygnus@foobox.com> dateSun 26 Jun 2016, 12:11 (10 years ago) parent6ffd241

9 files changed+134−5

compare with master

unifiedsplit

ModeDemo.hs+52 src/Graphics/Vty.hs+2 src/Graphics/Vty/Config.hs+10 src/Graphics/Vty/Output.hs+9 src/Graphics/Vty/Output/Interface.hs+11 src/Graphics/Vty/Output/Mock.hs+3 src/Graphics/Vty/Output/TerminfoBased.hs+3 src/Graphics/Vty/Output/XTermColor.hs+29−5 vty.cabal+15

ModeDemo.hsnew file+52

@@ -0,0 +1,52 @@

1+module Main where

3+import Data.Monoid

5+import Graphics.Vty

7+mkUI :: (Bool, Bool, Bool, Bool) -> Maybe Event -> Image

8+mkUI (m, ms, p, ps) e =

9+ vertCat [ string defAttr $ "Mouse mode supported: " <> show m

10+ , string defAttr $ "Mouse mode status: " <> show ms

11+ , string defAttr " "

12+ , string defAttr $ "Paste mode supported: " <> show p

13+ , string defAttr $ "Paste mode status: " <> show ps

14+ , string defAttr " "

15+ , string defAttr $ "Last event: " <> show e

16+ , string defAttr " "

17+ , string defAttr "Press 'm' to toggle mouse mode, 'p' to toggle paste mode, and 'q' to quit."

18+ ]

19+

20+main :: IO ()

21+main = do

22+ cfg <- standardIOConfig

23+ vty <- mkVty cfg

24+

25+ let renderUI lastE = do

26+ let output = outputIface vty

27+ info <- (,,,) <$> (pure $ supportsMode output Mouse)

28+ <*> getModeStatus output Mouse

29+ <*> (pure $ supportsMode output BracketedPaste)

30+ <*> getModeStatus output BracketedPaste

31+ return $ picForImage $ mkUI info lastE

32+

33+ let go lastE = do

34+ pic <- renderUI lastE

35+ update vty pic

36+ e <- nextEvent vty

37+ case e of

38+ EvKey (KChar 'q') [] -> return ()

39+ EvKey (KChar 'm') [] -> do

40+ let output = outputIface vty

41+ enabled <- getModeStatus output Mouse

42+ setMode output Mouse (not enabled)

43+ go (Just e)

44+ EvKey (KChar 'p') [] -> do

45+ let output = outputIface vty

46+ enabled <- getModeStatus output BracketedPaste

47+ setMode output BracketedPaste (not enabled)

48+ go (Just e)

49+ _ -> go (Just e)

50+

51+ go Nothing

52+ shutdown vty

src/Graphics/Vty.hs+2

@@ -49,6 +49,7 @@ module Graphics.Vty ( Vty(..)

4949 , module Graphics.Vty.Output

5050 , module Graphics.Vty.Picture

5151 , DisplayRegion

52+ , Mode(..)

5253 )

5354 where

5455

@@ -57,6 +58,7 @@ import Graphics.Vty.Prelude

5758import Graphics.Vty.Config

5859import Graphics.Vty.Input

5960import Graphics.Vty.Output

61+import Graphics.Vty.Output.Interface

6062import Graphics.Vty.Picture

6163

6264import Control.Concurrent.STM

src/Graphics/Vty/Config.hs+10

@@ -104,6 +104,10 @@ data Config = Config

104104 vmin :: Maybe Int

105105 -- | The default is 100 milliseconds, 0.1 seconds.

106106 , vtime :: Maybe Int

107+ -- | The default is False.

108+ , mouseMode :: Maybe Bool

109+ -- | The default is False.

110+ , bracketedPasteMode :: Maybe Bool

107111 -- | Debug information is appended to this file if not Nothing.

108112 , debugLog :: Maybe FilePath

109113 -- | The (input byte, output event) pairs extend the internal input table of VTY and the table

@@ -127,6 +131,8 @@ instance Monoid Config where

127131 mempty = Config

128132 { vmin = Nothing

129133 , vtime = Nothing

134+ , mouseMode = Nothing

135+ , bracketedPasteMode = Nothing

130136 , debugLog = mempty

131137 , inputMap = mempty

132138 , inputFd = Nothing

@@ -137,6 +143,8 @@ instance Monoid Config where

137143 -- latter config takes priority for everything but inputMap

138144 { vmin = vmin c1 <|> vmin c0

139145 , vtime = vtime c1 <|> vtime c0

146+ , mouseMode = mouseMode c1

147+ , bracketedPasteMode = bracketedPasteMode c1

140148 , debugLog = debugLog c1 <|> debugLog c0

141149 , inputMap = inputMap c0 <> inputMap c1

142150 , inputFd = inputFd c1 <|> inputFd c0

@@ -163,6 +171,8 @@ standardIOConfig :: IO Config

163171standardIOConfig = do

164172 Just t <- getEnv "TERM"

165173 return $ def { vmin = Just 1

174+ , mouseMode = Just False

175+ , bracketedPasteMode = Just False

166176 , vtime = Just 100

167177 , inputFd = Just stdInput

168178 , outputFd = Just stdOutput

src/Graphics/Vty/Output.hs+9

@@ -65,6 +65,15 @@ outputForConfig Config{ outputFd = Just fd, termName = Just termName, .. } = do

6565 then XTermColor.reserveTerminal termName fd

6666 -- Not an xterm-like terminal. try for generic terminfo.

6767 else TerminfoBased.reserveTerminal termName fd

68+

69+ case mouseMode of

70+ Just s -> setMode t Mouse s

71+ Nothing -> return ()

72+

73+ case bracketedPasteMode of

74+ Just s -> setMode t BracketedPaste s

75+ Nothing -> return ()

76+

6877 return t

6978outputForConfig config = (<> config) <$> standardIOConfig >>= outputForConfig

7079

src/Graphics/Vty/Output/Interface.hs+11

@@ -37,6 +37,11 @@ import qualified Data.Vector as Vector

3737import Data.Monoid (mempty, mappend)

3838#endif

3939

40+-- | Modal terminal features that can be enabled and disabled.

41+data Mode = Mouse

42+ | BracketedPaste

43+ deriving (Eq, Read, Show)

44+

4045data Output = Output

4146 { -- | Text identifier for the output device. Used for debugging.

4247 terminalID :: String

@@ -67,6 +72,12 @@ data Output = Output

6772 , contextColorCount :: Int

6873 -- | if the cursor can be shown / hidden

6974 , supportsCursorVisibility :: Bool

75+ -- | Indicates support for terminal modes for this output device

76+ , supportsMode :: Mode -> Bool

77+ -- | Enables or disables a mode (does nothing if the mode is unsupported)

78+ , setMode :: forall m. MonadIO m => Mode -> Bool -> m ()

79+ -- | Returns whether a mode is enabled

80+ , getModeStatus :: forall m. MonadIO m => Mode -> m Bool

7081 , assumedStateRef :: IORef AssumedState

7182 -- | Acquire display access to the given region of the display.

7283 -- Currently all regions have the upper left corner of (0,0) and the lower right corner at

src/Graphics/Vty/Output/Mock.hs+3

@@ -47,6 +47,9 @@ mockTerminal r = liftIO $ do

4747 writeIORef outRef $ UTF8.fromRep bytes

4848 , contextColorCount = 16

4949 , supportsCursorVisibility = True

50+ , supportsMode = const False

51+ , setMode = const $ const $ return ()

52+ , getModeStatus = const $ return False

5053 , assumedStateRef = newAssumedStateRef

5154 , mkDisplayContext = \tActual rActual -> return $ DisplayContext

5255 { contextRegion = rActual

src/Graphics/Vty/Output/TerminfoBased.hs+3

@@ -173,6 +173,9 @@ reserveTerminal termName outFd = liftIO $ do

173173 Just v -> toEnum v

174174 True -> 1

175175 , supportsCursorVisibility = isJust $ civis terminfoCaps

176+ , supportsMode = const False

177+ , setMode = const $ const $ return ()

178+ , getModeStatus = const $ return False

176179 , assumedStateRef = newAssumedStateRef

177180 -- I think fix would help assure tActual is the only reference. I was having issues

178181 -- tho.

src/Graphics/Vty/Output/XTermColor.hs+29−5

@@ -15,8 +15,9 @@ import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased

1515import Blaze.ByteString.Builder (writeToByteString)

1616import Blaze.ByteString.Builder.Word (writeWord8)

1717

18−import Control.Monad (void)

18+import Control.Monad (void, when)

1919import Control.Monad.Trans

20+import Data.IORef

2021

2122import System.Posix.IO (fdWrite)

2223import System.Posix.Types (Fd)

@@ -34,19 +35,42 @@ reserveTerminal variant outFd = liftIO $ do

3435 -- xterm-color is broken.

3536 let variant' = if variant == "xterm-color" then "xterm" else variant

3637 flushedPut setUtf8CharSet

37− flushedPut enableBracketedPastes

38− flushedPut requestMouseEvents

3938 t <- TerminfoBased.reserveTerminal variant' outFd

39+

40+ mouseModeStatus <- newIORef False

41+ pasteModeStatus <- newIORef False

42+

43+ let xtermSetMode t' m newStatus = do

44+ curStatus <- getModeStatus t' m

45+ when (newStatus /= curStatus) $

46+ case m of

47+ Mouse -> liftIO $ do

48+ case newStatus of

49+ True -> flushedPut requestMouseEvents

50+ False -> flushedPut disableMouseEvents

51+ writeIORef mouseModeStatus newStatus

52+ BracketedPaste -> liftIO $ do

53+ case newStatus of

54+ True -> flushedPut enableBracketedPastes

55+ False -> flushedPut disableBracketedPastes

56+ writeIORef pasteModeStatus newStatus

57+

58+ xtermGetMode Mouse = liftIO $ readIORef mouseModeStatus

59+ xtermGetMode BracketedPaste = liftIO $ readIORef pasteModeStatus

60+

4061 let t' = t

4162 { terminalID = terminalID t ++ " (xterm-color)"

4263 , releaseTerminal = do

4364 liftIO $ flushedPut setDefaultCharSet

44− liftIO $ flushedPut disableBracketedPastes

45− liftIO $ flushedPut disableMouseEvents

65+ setMode t' BracketedPaste False

66+ setMode t' Mouse False

4667 releaseTerminal t

4768 , mkDisplayContext = \tActual r -> do

4869 dc <- mkDisplayContext t tActual r

4970 return $ dc { inlineHack = xtermInlineHack t' }

71+ , supportsMode = const True

72+ , getModeStatus = xtermGetMode

73+ , setMode = xtermSetMode t'

5074 }

5175 return t'

5276

vty.cabal+15

@@ -129,6 +129,21 @@ library

129129

130130 cc-options: -O2

131131

132+executable vty-mode-demo

133+ main-is: ModeDemo.hs

134+

135+ default-language: Haskell2010

136+ default-extensions: ScopedTypeVariables

137+ ghc-options: -threaded

138+

139+ build-depends: vty,

140+ base >= 4 && < 5,

141+ containers,

142+ data-default >= 0.5.3,

143+ microlens,

144+ microlens-mtl,

145+ mtl >= 1.1.1.0 && < 2.3

146+

132147executable vty-demo

133148 main-is: Demo.hs

134149