vty 5.6 → 5.7

raw patch · 10 files changed

+149/−6 lines, 10 filesdep ~microlensnew-component:exe:vty-mode-demo

Dependency ranges changed: microlens

Files

• CHANGELOG +14/−0
• ModeDemo.hs +52/−0
• src/Graphics/Vty.hs +2/−0
• src/Graphics/Vty/Config.hs +10/−0
• src/Graphics/Vty/Output.hs +9/−0
• src/Graphics/Vty/Output/Interface.hs +11/−0
• src/Graphics/Vty/Output/Mock.hs +3/−0
• src/Graphics/Vty/Output/TerminfoBased.hs +3/−0
• src/Graphics/Vty/Output/XTermColor.hs +29/−5
• vty.cabal +16/−1

@@ -1,3 +1,17 @@+5.7+  - Mouse and paste modes are now off by default.+  - The Config type got new fields: mouseMode and bracketedPasteMode.  These+    determine whether these modes are enabled initially (for terminals+    that support them).+  - Added a Mode type for modal terminal features (mouse events, bracketed+    paste mode) that is used with new Output interface functions:+    * 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+  - Added a new demo program, ModeDemo.hs, to demonstrate usage of modes+ 5.6   - Added support for normal and extended mouse modes in Xterm-like     terminals via the MouseDown and MouseUp Event constructors

@@ -0,0 +1,52 @@+module Main where++import Data.Monoid++import Graphics.Vty++mkUI :: (Bool, Bool, Bool, Bool) -> Maybe Event -> Image+mkUI (m, ms, p, ps) e =+    vertCat [ string defAttr $ "Mouse mode supported: " <> show m+            , string defAttr $ "Mouse mode status: " <> show ms+            , string defAttr " "+            , string defAttr $ "Paste mode supported: " <> show p+            , string defAttr $ "Paste mode status: " <> show ps+            , string defAttr " "+            , string defAttr $ "Last event: " <> show e+            , string defAttr " "+            , string defAttr "Press 'm' to toggle mouse mode, 'p' to toggle paste mode, and 'q' to quit."+            ]++main :: IO ()+main = do+    cfg <- standardIOConfig+    vty <- mkVty cfg++    let renderUI lastE = do+          let output = outputIface vty+          info <- (,,,) <$> (pure $ supportsMode output Mouse)+                        <*> getModeStatus output Mouse+                        <*> (pure $ supportsMode output BracketedPaste)+                        <*> getModeStatus output BracketedPaste+          return $ picForImage $ mkUI info lastE++    let go lastE = do+          pic <- renderUI lastE+          update vty pic+          e <- nextEvent vty+          case e of+              EvKey (KChar 'q') [] -> return ()+              EvKey (KChar 'm') [] -> do+                  let output = outputIface vty+                  enabled <- getModeStatus output Mouse+                  setMode output Mouse (not enabled)+                  go (Just e)+              EvKey (KChar 'p') [] -> do+                  let output = outputIface vty+                  enabled <- getModeStatus output BracketedPaste+                  setMode output BracketedPaste (not enabled)+                  go (Just e)+              _ -> go (Just e)++    go Nothing+    shutdown vty

@@ -49,6 +49,7 @@                     , module Graphics.Vty.Output                     , module Graphics.Vty.Picture                     , DisplayRegion+                    , Mode(..)                     )      where @@ -57,6 +58,7 @@ import Graphics.Vty.Config import Graphics.Vty.Input import Graphics.Vty.Output+import Graphics.Vty.Output.Interface import Graphics.Vty.Picture  import Control.Concurrent.STM

@@ -104,6 +104,10 @@       vmin  :: Maybe Int     -- | The default is 100 milliseconds, 0.1 seconds.     , vtime :: Maybe Int+    -- | The default is False.+    , mouseMode :: Maybe Bool+    -- | The default is False.+    , bracketedPasteMode :: Maybe Bool     -- | Debug information is appended to this file if not Nothing.     , debugLog           :: Maybe FilePath     -- | The (input byte, output event) pairs extend the internal input table of VTY and the table@@ -127,6 +131,8 @@     mempty = Config         { vmin         = Nothing         , vtime        = Nothing+        , mouseMode    = Nothing+        , bracketedPasteMode = Nothing         , debugLog     = mempty         , inputMap     = mempty         , inputFd     = Nothing@@ -137,6 +143,8 @@         -- latter config takes priority for everything but inputMap         { vmin          = vmin c1     <|> vmin c0         , vtime         = vtime c1    <|> vtime c0+        , mouseMode     = mouseMode c1+        , bracketedPasteMode = bracketedPasteMode c1         , debugLog      = debugLog c1 <|> debugLog c0         , inputMap      = inputMap c0 <>  inputMap c1         , inputFd      = inputFd c1 <|> inputFd c0@@ -163,6 +171,8 @@ standardIOConfig = do     Just t <- getEnv "TERM"     return $ def { vmin = Just 1+                 , mouseMode = Just False+                 , bracketedPasteMode = Just False                  , vtime = Just 100                  , inputFd = Just stdInput                  , outputFd = Just stdOutput

@@ -65,6 +65,15 @@         then XTermColor.reserveTerminal termName fd         -- Not an xterm-like terminal. try for generic terminfo.         else TerminfoBased.reserveTerminal termName fd++    case mouseMode of+        Just s -> setMode t Mouse s+        Nothing -> return ()++    case bracketedPasteMode of+        Just s -> setMode t BracketedPaste s+        Nothing -> return ()+     return t outputForConfig config = (<> config) <$> standardIOConfig >>= outputForConfig 

@@ -37,6 +37,11 @@ import Data.Monoid (mempty, mappend) #endif +-- | Modal terminal features that can be enabled and disabled.+data Mode = Mouse+          | BracketedPaste+          deriving (Eq, Read, Show)+ data Output = Output     { -- | Text identifier for the output device. Used for debugging.        terminalID :: String@@ -67,6 +72,12 @@     , contextColorCount :: Int     -- | if the cursor can be shown / hidden     , supportsCursorVisibility :: Bool+    -- | Indicates support for terminal modes for this output device+    , supportsMode :: Mode -> Bool+    -- | Enables or disables a mode (does nothing if the mode is unsupported)+    , setMode :: forall m. MonadIO m => Mode -> Bool -> m ()+    -- | Returns whether a mode is enabled+    , getModeStatus :: forall m. MonadIO m => Mode -> m Bool     , assumedStateRef :: IORef AssumedState     -- | Acquire display access to the given region of the display.     -- Currently all regions have the upper left corner of (0,0) and the lower right corner at 

@@ -47,6 +47,9 @@                 writeIORef outRef $ UTF8.fromRep bytes             , contextColorCount = 16             , supportsCursorVisibility = True+            , supportsMode = const False+            , setMode = const $ const $ return ()+            , getModeStatus = const $ return False             , assumedStateRef = newAssumedStateRef             , mkDisplayContext = \tActual rActual -> return $ DisplayContext                 { contextRegion = rActual

@@ -173,6 +173,9 @@                         Just v -> toEnum v                     True -> 1             , supportsCursorVisibility = isJust $ civis terminfoCaps+            , supportsMode = const False+            , setMode = const $ const $ return ()+            , getModeStatus = const $ return False             , assumedStateRef = newAssumedStateRef             -- I think fix would help assure tActual is the only reference. I was having issues             -- tho.

@@ -15,8 +15,9 @@ import Blaze.ByteString.Builder (writeToByteString) import Blaze.ByteString.Builder.Word (writeWord8) -import Control.Monad (void)+import Control.Monad (void, when) import Control.Monad.Trans+import Data.IORef  import System.Posix.IO (fdWrite) import System.Posix.Types (Fd)@@ -34,19 +35,42 @@     -- xterm-color is broken.     let variant' = if variant == "xterm-color" then "xterm" else variant     flushedPut setUtf8CharSet-    flushedPut enableBracketedPastes-    flushedPut requestMouseEvents     t <- TerminfoBased.reserveTerminal variant' outFd++    mouseModeStatus <- newIORef False+    pasteModeStatus <- newIORef False++    let xtermSetMode t' m newStatus = do+          curStatus <- getModeStatus t' m+          when (newStatus /= curStatus) $+              case m of+                  Mouse -> liftIO $ do+                      case newStatus of+                          True -> flushedPut requestMouseEvents+                          False -> flushedPut disableMouseEvents+                      writeIORef mouseModeStatus newStatus+                  BracketedPaste -> liftIO $ do+                      case newStatus of+                          True -> flushedPut enableBracketedPastes+                          False -> flushedPut disableBracketedPastes+                      writeIORef pasteModeStatus newStatus++        xtermGetMode Mouse = liftIO $ readIORef mouseModeStatus+        xtermGetMode BracketedPaste = liftIO $ readIORef pasteModeStatus+     let t' = t              { terminalID = terminalID t ++ " (xterm-color)"              , releaseTerminal = do                  liftIO $ flushedPut setDefaultCharSet-                 liftIO $ flushedPut disableBracketedPastes-                 liftIO $ flushedPut disableMouseEvents+                 setMode t' BracketedPaste False+                 setMode t' Mouse False                  releaseTerminal t              , mkDisplayContext = \tActual r -> do                 dc <- mkDisplayContext t tActual r                 return $ dc { inlineHack = xtermInlineHack t' }+             , supportsMode = const True+             , getModeStatus = xtermGetMode+             , setMode = xtermSetMode t'              }     return t' 

@@ -1,5 +1,5 @@ name:                vty-version:             5.6+version:             5.7 license:             BSD3 license-file:        LICENSE author:              AUTHORS@@ -128,6 +128,21 @@   ghc-prof-options:    -O2 -funbox-strict-fields -caf-all -Wall -fspec-constr -fspec-constr-count=10    cc-options:          -O2++executable vty-mode-demo+  main-is:             ModeDemo.hs++  default-language:    Haskell2010+  default-extensions:  ScopedTypeVariables+  ghc-options:         -threaded++  build-depends:       vty,+                       base >= 4 && < 5,+                       containers,+                       data-default >= 0.5.3,+                       microlens,+                       microlens-mtl,+                       mtl >= 1.1.1.0 && < 2.3  executable vty-demo   main-is:             Demo.hs