packages feed

vty 5.5.0 → 5.6

raw patch · 25 files changed

+411/−20 lines, 25 files

Files

CHANGELOG view
@@ -1,3 +1,13 @@+5.6+  - Added support for normal and extended mouse modes in Xterm-like+    terminals via the MouseDown and MouseUp Event constructors+  - Added support for bracketed paste mode in Xterm-like terminals via+    the EvPaste event constructor+  - Added derived Show instances for Event and Button (thanks Felix+    Hirn)+  - Now TERM values containing "screen" will automatically use the+    XtermColor driver rather than just TerminfoBased+ 5.5.0   - Replaced lens dependency with microlens, microlens-mtl, microlens-th dependencies. Issue #90     - Thanks Jonathan Daugherty
README.md view
@@ -68,6 +68,12 @@ * Uses the TIOCGWINSZ ioctl to find the current window size, which appears to be   limited to Linux and BSD. +* Supports "normal" and "extended" (SGR) mouse modes as described at+  http://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-Mouse-Tracking++* Supports bracketed paste mode as described at+  http://cirw.in/blog/bracketed-paste+ # Platform Support  ## Posix Terminals
+ dist/build/verify-attribute-opsStub/verify-attribute-opsStub-tmp/verify-attribute-opsStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyAttributeOps ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-crop-span-generationStub/verify-crop-span-generationStub-tmp/verify-crop-span-generationStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyCropSpanGeneration ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-display-attributesStub/verify-display-attributesStub-tmp/verify-display-attributesStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyDisplayAttributes ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-empty-image-propsStub/verify-empty-image-propsStub-tmp/verify-empty-image-propsStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyEmptyImageProps ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-eval-terminfo-capsStub/verify-eval-terminfo-capsStub-tmp/verify-eval-terminfo-capsStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyEvalTerminfoCaps ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-image-opsStub/verify-image-opsStub-tmp/verify-image-opsStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyImageOps ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-image-transStub/verify-image-transStub-tmp/verify-image-transStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyImageTrans ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-inlineStub/verify-inlineStub-tmp/verify-inlineStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyInline ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-layers-span-generationStub/verify-layers-span-generationStub-tmp/verify-layers-span-generationStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyLayersSpanGeneration ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-parse-terminfo-capsStub/verify-parse-terminfo-capsStub-tmp/verify-parse-terminfo-capsStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyParseTerminfoCaps ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-simple-span-generationStub/verify-simple-span-generationStub-tmp/verify-simple-span-generationStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifySimpleSpanGeneration ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-terminalStub/verify-terminalStub-tmp/verify-terminalStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyOutput ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-using-mock-terminalStub/verify-using-mock-terminalStub-tmp/verify-using-mock-terminalStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyUsingMockTerminal ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-utf8-widthStub/verify-utf8-widthStub-tmp/verify-utf8-widthStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyUtf8Width ( tests )+main :: IO ()+main = stubMain tests
src/Graphics/Vty/Input/Classify.hs view
@@ -12,10 +12,13 @@     ) where  import Graphics.Vty.Input.Events+import Graphics.Vty.Input.Mouse+import Graphics.Vty.Input.Paste+import Graphics.Vty.Input.Classify.Types  import Codec.Binary.UTF8.Generic (decode) -import Data.List(inits)+import Data.List (inits) import qualified Data.Map as M( fromList, lookup ) import Data.Maybe ( mapMaybe ) import qualified Data.Set as S( fromList, member )@@ -23,12 +26,6 @@ import Data.Char import Data.Word -data KClass-    = Valid Event [Char]-    | Invalid-    | Prefix-    deriving(Show, Eq)- compile :: ClassifyMap -> [Char] -> KClass compile table = cl' where     -- take all prefixes and create a set of these@@ -60,6 +57,11 @@ classify table =     let standardClassifier = compile table     in \s -> case s of+        _ | bracketedPasteStarted s ->+            if bracketedPasteFinished s+            then parseBracketedPaste s+            else Prefix+        _ | isMouseEvent s   -> classifyMouseEvent s         c:cs | ord c >= 0xC2 -> classifyUtf8 c cs         _                    -> standardClassifier s 
+ src/Graphics/Vty/Input/Classify/Parse.hs view
@@ -0,0 +1,57 @@+-- | This module provides a simple parser for parsing input event+-- control sequences.+module Graphics.Vty.Input.Classify.Parse+    ( Parser+    , runParser+    , failParse+    , readInt+    , readChar+    , expectChar+    ) where++import Graphics.Vty.Input.Events+import Graphics.Vty.Input.Classify.Types++import Control.Monad.Trans.Maybe+import Control.Monad.State++type Parser a = MaybeT (State String) a++-- | Run a parser on a given input string. If the parser fails, return+-- 'Invalid'. Otherwise return the valid event ('Valid') and the+-- remaining unparsed characters.+runParser :: String -> Parser Event -> KClass+runParser s parser =+    case runState (runMaybeT parser) s of+        (Nothing, _)        -> Invalid+        (Just e, remaining) -> Valid e remaining++-- | Fail a parsing operation.+failParse :: Parser a+failParse = fail "invalid parse"++-- | Read an integer from the input stream. If an integer cannot be+-- read, fail parsing. E.g. calling readInt on an input of "123abc" will+-- return '123' and consume those characters.+readInt :: Parser Int+readInt = do+    s <- get+    case (reads :: ReadS Int) s of+        [(i, rest)] -> put rest >> return i+        _ -> failParse++-- | Read a character from the input stream. If one cannot be read (e.g.+-- we are out of characters), fail parsing.+readChar :: Parser Char+readChar = do+    s <- get+    case s of+        c:rest -> put rest >> return c+        _ -> failParse++-- | Read a character from the input stream and fail parsing if it is+-- not the specified character.+expectChar :: Char -> Parser ()+expectChar c = do+    c' <- readChar+    if c' == c then return () else failParse
+ src/Graphics/Vty/Input/Classify/Types.hs view
@@ -0,0 +1,18 @@+-- | This module exports the input classification type to avoid import+-- cycles between other modules that need this.+module Graphics.Vty.Input.Classify.Types+    ( KClass(..)+    ) where++import Graphics.Vty.Input.Events++data KClass+    = Valid Event [Char]+    -- ^ A valid event was parsed. Any unused characters from the input+    -- stream are also provided.+    | Invalid+    -- ^ The input characters did not represent a valid event.+    | Prefix+    -- ^ The input characters form the prefix of a valid event character+    -- sequence.+    deriving(Show, Eq)
src/Graphics/Vty/Input/Events.hs view
@@ -22,20 +22,32 @@     deriving (Eq,Show,Read,Ord)  -- | Mouse buttons.------ \todo not supported. data Button = BLeft | BMiddle | BRight-    deriving (Eq,Show,Ord)+    deriving (Eq,Show,Read,Ord)  -- | Events. data Event     = EvKey Key [Modifier]-    -- | \todo mouse events are not supported-    | EvMouse Int Int Button [Modifier]-    -- | if read from 'eventChannel' this is the size at the time of the signal. If read from-    -- 'nextEvent' this is the size at the time the event was processed by Vty. Typically these are-    -- the same, but if somebody is resizing the terminal quickly they can be different.+    -- ^ A keyboard key was pressed with the specified modifiers.+    | EvMouseDown Int Int Button [Modifier]+    -- ^ A mouse button was pressed at the specified column and row. Any+    -- modifiers available in the event are also provided.+    | EvMouseUp Int Int (Maybe Button)+    -- ^ A mouse button was released at the specified column and+    -- row. Some terminals report only that a button was released+    -- without specifying which one; in that case, Nothing is provided.+    -- Otherwise Just the button released is included in the event.     | EvResize Int Int-    deriving (Eq,Show,Ord)+    -- ^ If read from 'eventChannel' this is the size at the time of the+    -- signal. If read from 'nextEvent' this is the size at the time the+    -- event was processed by Vty. Typically these are the same, but if+    -- somebody is resizing the terminal quickly they can be different.+    | EvPaste String+    -- ^ A paste event occurs when a bracketed paste input sequence is+    -- received. For terminals that support bracketed paste mode, these+    -- events will be triggered on a paste event. Terminals that do not+    -- support bracketed pastes will send the paste contents as ordinary+    -- input (which is probably bad, so beware!)+    deriving (Eq,Show,Read,Ord)  type ClassifyMap = [(String,Event)]
+ src/Graphics/Vty/Input/Mouse.hs view
@@ -0,0 +1,152 @@+-- | This module provides parsers for mouse events for both "normal" and+-- "extended" modes. This implementation was informed by+--+-- http://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-Mouse-Tracking+module Graphics.Vty.Input.Mouse+    ( requestMouseEvents+    , disableMouseEvents+    , isMouseEvent+    , classifyMouseEvent+    ) where++import Graphics.Vty.Input.Events+import Graphics.Vty.Input.Classify.Types+import Graphics.Vty.Input.Classify.Parse++import Control.Monad.State+import Data.List (isPrefixOf)+import Data.Maybe (catMaybes)+import Data.Bits ((.&.))++-- A mouse event in SGR extended mode is+--+-- '\ESC' '[' '<' B ';' X ';' Y ';' ('M'|'m')+--+-- where+--+-- * B is the number with button and modifier bits set,+-- * X is the X coordinate of the event starting at 1+-- * Y is the Y coordinate of the event starting at 1+-- * the final character is 'M' for a press, 'm' for a release++-- | These sequences set xterm-based terminals to send mouse event+-- sequences.+requestMouseEvents :: String+requestMouseEvents = "\ESC[?1000h\ESC[?1002h\ESC[?1006h\ESC[?1005h"++-- | These sequences disable mouse events.+disableMouseEvents :: String+disableMouseEvents = "\ESC[?1000l\ESC[?1002l\ESC[?1006l\ESC[?1005l"++-- | Does the specified string begin with a mouse event?+isMouseEvent :: String -> Bool+isMouseEvent s = isSGREvent s || isNormalEvent s++isSGREvent :: String -> Bool+isSGREvent = isPrefixOf sgrPrefix++sgrPrefix :: String+sgrPrefix = "\ESC[M"++isNormalEvent :: String -> Bool+isNormalEvent = isPrefixOf normalPrefix++normalPrefix :: String+normalPrefix = "\ESC[<"++-- Modifier bits:+shiftBit :: Int+shiftBit = 4++metaBit :: Int+metaBit = 8++ctrlBit :: Int+ctrlBit = 16++-- These bits indicate the buttons involved:+buttonMask :: Int+buttonMask = 3++leftButton :: Int+leftButton = 0++middleButton :: Int+middleButton = 1++rightButton :: Int+rightButton = 2++hasBitSet :: Int -> Int -> Bool+hasBitSet val bit = val .&. bit > 0++-- | Attempt to lassify an input string as a mouse event.+classifyMouseEvent :: String -> KClass+classifyMouseEvent s = runParser s $ do+    when (not $ isMouseEvent s) failParse++    expectChar '\ESC'+    expectChar '['+    ty <- readChar+    case ty of+        '<' -> classifySGRMouseEvent+        'M' -> classifyNormalMouseEvent+        _   -> failParse++-- Given a modifer/button value, determine which button was indicated+getSGRButton :: Int -> Parser Button+getSGRButton mods =+    let buttonMap = [ (leftButton,   BLeft)+                    , (middleButton, BMiddle)+                    , (rightButton,  BRight)+                    ]+    in case lookup (mods .&. buttonMask) buttonMap of+        Nothing -> failParse+        Just b -> return b++getModifiers :: Int -> [Modifier]+getModifiers mods =+    catMaybes [ if mods `hasBitSet` shiftBit then Just MShift else Nothing+              , if mods `hasBitSet` metaBit  then Just MMeta  else Nothing+              , if mods `hasBitSet` ctrlBit  then Just MCtrl  else Nothing+              ]++-- Attempt to classify a control sequence as a "normal" mouse event. To+-- get here we should have already read "\ESC[M" so that will not be+-- included in the string to be parsed.+classifyNormalMouseEvent :: Parser Event+classifyNormalMouseEvent = do+    statusChar <- readChar+    xCoordChar <- readChar+    yCoordChar <- readChar++    let xCoord = fromEnum xCoordChar - 32+        yCoord = fromEnum yCoordChar - 32+        status = fromEnum statusChar+        modifiers = getModifiers status++    let press = status .&. buttonMask /= 3+    case press of+            True -> do+                button <- getSGRButton status+                return $ EvMouseDown xCoord yCoord button modifiers+            False -> return $ EvMouseUp xCoord yCoord Nothing++-- Attempt to classify a control sequence as an SGR mouse event. To+-- get here we should have already read "\ESC[<" so that will not be+-- included in the string to be parsed.+classifySGRMouseEvent :: Parser Event+classifySGRMouseEvent = do+    mods <- readInt+    expectChar ';'+    xCoord <- readInt+    expectChar ';'+    yCoord <- readInt+    final <- readChar++    let modifiers = getModifiers mods+    button <- getSGRButton mods+    case final of+        'M' -> return $ EvMouseDown xCoord yCoord button modifiers+        'm' -> return $ EvMouseUp   xCoord yCoord (Just button)+        _ -> failParse
+ src/Graphics/Vty/Input/Paste.hs view
@@ -0,0 +1,46 @@+-- | This module provides bracketed paste support as described at+--+-- http://cirw.in/blog/bracketed-paste+module Graphics.Vty.Input.Paste+    ( parseBracketedPaste+    , bracketedPasteStarted+    , bracketedPasteFinished+    ) where++import Graphics.Vty.Input.Events+import Graphics.Vty.Input.Classify.Types++import Data.List (isPrefixOf, isInfixOf)++bracketedPasteStart :: String+bracketedPasteStart = "\ESC[200~"++bracketedPasteEnd :: String+bracketedPasteEnd = "\ESC[201~"++-- | Does the input start a bracketed paste?+bracketedPasteStarted :: String -> Bool+bracketedPasteStarted = isPrefixOf bracketedPasteStart++-- | Does the input contain a complete bracketed paste?+bracketedPasteFinished :: String -> Bool+bracketedPasteFinished = isInfixOf bracketedPasteEnd++-- | Parse a bracketed paste. This should only be called on a string if+-- both 'bracketedPasteStarted' and 'bracketedPasteFinished' return+-- 'True'.+parseBracketedPaste :: String -> KClass+parseBracketedPaste s =+    let (p, rest) = takeUntil (drop (length bracketedPasteStart) s) bracketedPasteEnd+        rest' = if bracketedPasteEnd `isPrefixOf` rest+                then drop (length bracketedPasteEnd) rest+                else rest+    in Valid (EvPaste p) rest'++takeUntil :: (Eq a) => [a] -> [a] -> ([a],[a])+takeUntil [] _ = ([], [])+takeUntil cs sub+  | length cs < length sub      = (cs, [])+  | take (length sub) cs == sub = ([], drop (length sub) cs)+  | otherwise                   = let (pre, suf) = takeUntil (tail cs) sub+                                  in (head cs:pre, suf)
src/Graphics/Vty/Output.hs view
@@ -54,14 +54,14 @@ -- -- Selection of a terminal is done as follows: -----      * If TERM == xterm use XTermColor.---      * for any other TERM value TerminfoBased is used.+--      * If TERM contains "xterm" or "screen", use XTermColor.+--      * otherwise use the TerminfoBased driver. -- -- \todo add an implementation for windows that does not depend on terminfo. Should be installable -- with only what is provided in the haskell platform. Use ansi-terminal outputForConfig :: Config -> IO Output outputForConfig Config{ outputFd = Just fd, termName = Just termName, .. } = do-    t <- if "xterm" `isPrefixOf` termName+    t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName         then XTermColor.reserveTerminal termName fd         -- Not an xterm-like terminal. try for generic terminfo.         else TerminfoBased.reserveTerminal termName fd
src/Graphics/Vty/Output/XTermColor.hs view
@@ -9,6 +9,7 @@     where  import Graphics.Vty.Output.Interface+import Graphics.Vty.Input.Mouse import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased  import Blaze.ByteString.Builder (writeToByteString)@@ -33,17 +34,30 @@     -- 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     let t' = t              { terminalID = terminalID t ++ " (xterm-color)"              , releaseTerminal = do                  liftIO $ flushedPut setDefaultCharSet+                 liftIO $ flushedPut disableBracketedPastes+                 liftIO $ flushedPut disableMouseEvents                  releaseTerminal t              , mkDisplayContext = \tActual r -> do                 dc <- mkDisplayContext t tActual r                 return $ dc { inlineHack = xtermInlineHack t' }              }     return t'++-- | Enable bracketed paste mode:+-- http://cirw.in/blog/bracketed-paste+enableBracketedPastes :: String+enableBracketedPastes = "\ESC[?2004h"++-- | Disable bracketed paste mode:+disableBracketedPastes :: String+disableBracketedPastes = "\ESC[?2004l"  -- | These sequences set xterm based terminals to UTF-8 output. --
vty.cabal view
@@ -1,5 +1,5 @@ name:                vty-version:             5.5.0+version:             5.6 license:             BSD3 license-file:        LICENSE author:              AUTHORS@@ -94,7 +94,11 @@                        Graphics.Vty.DisplayAttributes                        Graphics.Vty.Image.Internal                        Graphics.Vty.Input.Classify+                       Graphics.Vty.Input.Classify.Types+                       Graphics.Vty.Input.Classify.Parse                        Graphics.Vty.Input.Loop+                       Graphics.Vty.Input.Mouse+                       Graphics.Vty.Input.Paste                        Graphics.Vty.Input.Terminfo                        Graphics.Vty.PictureToSpans                        Graphics.Vty.Span