git.iko.soy/vty
on master help sign in
Add support for bracketed paste mode in XtermColor-driven terminals (fixes #50)
f68bb32Jonathan Daugherty
src/Graphics/Vty/Input/Classify.hs+33−1
compare with master
unifiedsplit
@@ -15,7 +15,7 @@ import Graphics.Vty.Input.Events
15
15
16import Codec.Binary.UTF8.Generic (decode)
16import Codec.Binary.UTF8.Generic (decode)
17
17
18−import Data.List(inits)
18+import Data.List (inits, isPrefixOf, isInfixOf)
19import qualified Data.Map as M( fromList, lookup )
19import qualified Data.Map as M( fromList, lookup )
20import Data.Maybe ( mapMaybe )
20import Data.Maybe ( mapMaybe )
21import qualified Data.Set as S( fromList, member )
21import qualified Data.Set as S( fromList, member )
@@ -60,6 +60,10 @@ classify :: ClassifyMap -> [Char] -> KClass
60classify table =
60classify table =
61 let standardClassifier = compile table
61 let standardClassifier = compile table
62 in \s -> case s of
62 in \s -> case s of
63+ _ | bracketedPasteStarted s ->
64+ if bracketedPasteFinished s
65+ then parseBracketedPaste s
66+ else Prefix
63 c:cs | ord c >= 0xC2 -> classifyUtf8 c cs
67 c:cs | ord c >= 0xC2 -> classifyUtf8 c cs
64 _ -> standardClassifier s
68 _ -> standardClassifier s
65
69
@@ -82,3 +86,31 @@ utf8Length c
82 | c < 0xE0 = 2
86 | c < 0xE0 = 2
83 | c < 0xF0 = 3
87 | c < 0xF0 = 3
84 | otherwise = 4
88 | otherwise = 4
89+
90+bracketedPasteStart :: String
91+bracketedPasteStart = "\ESC[200~"
92+
93+bracketedPasteEnd :: String
94+bracketedPasteEnd = "\ESC[201~"
95+
96+bracketedPasteStarted :: String -> Bool
97+bracketedPasteStarted = isPrefixOf bracketedPasteStart
98+
99+bracketedPasteFinished :: String -> Bool
100+bracketedPasteFinished = isInfixOf bracketedPasteEnd
101+
102+takeUntil :: (Eq a) => [a] -> [a] -> ([a],[a])
103+takeUntil [] _ = ([], [])
104+takeUntil cs sub
105+ | length cs < length sub = (cs, [])
106+ | take (length sub) cs == sub = ([], drop (length sub) cs)
107+ | otherwise = let (pre, suf) = takeUntil (tail cs) sub
108+ in (head cs:pre, suf)
109+
110+parseBracketedPaste :: String -> KClass
111+parseBracketedPaste s =
112+ let (p, rest) = takeUntil (drop (length bracketedPasteStart) s) bracketedPasteEnd
113+ rest' = if bracketedPasteEnd `isPrefixOf` rest
114+ then drop (length bracketedPasteEnd) rest
115+ else rest
116+ in Valid (EvPaste p) rest'
src/Graphics/Vty/Input/Events.hs+6
@@ -36,6 +36,12 @@ data Event
36 -- 'nextEvent' this is the size at the time the event was processed by Vty. Typically these are
36 -- 'nextEvent' this is the size at the time the event was processed by Vty. Typically these are
37 -- the same, but if somebody is resizing the terminal quickly they can be different.
37 -- the same, but if somebody is resizing the terminal quickly they can be different.
38 | EvResize Int Int
38 | EvResize Int Int
39+ | EvPaste String
40+ -- ^ A paste event occurs when a bracketed paste input sequence is
41+ -- received. For terminals that support bracketed paste mode, these
42+ -- events will be triggered on a paste event. Terminals that do not
43+ -- support bracketed pastes will send the paste contents as ordinary
44+ -- input (which is probably bad, so beware!)
39 deriving (Eq,Show,Read,Ord)
45 deriving (Eq,Show,Read,Ord)
40
46
41type ClassifyMap = [(String,Event)]
47type ClassifyMap = [(String,Event)]
src/Graphics/Vty/Output/XTermColor.hs+11
@@ -33,11 +33,13 @@ reserveTerminal variant outFd = liftIO $ do
33 -- xterm-color is broken.
33 -- xterm-color is broken.
34 let variant' = if variant == "xterm-color" then "xterm" else variant
34 let variant' = if variant == "xterm-color" then "xterm" else variant
35 flushedPut setUtf8CharSet
35 flushedPut setUtf8CharSet
36+ flushedPut enableBracketedPastes
36 t <- TerminfoBased.reserveTerminal variant' outFd
37 t <- TerminfoBased.reserveTerminal variant' outFd
37 let t' = t
38 let t' = t
38 { terminalID = terminalID t ++ " (xterm-color)"
39 { terminalID = terminalID t ++ " (xterm-color)"
39 , releaseTerminal = do
40 , releaseTerminal = do
40 liftIO $ flushedPut setDefaultCharSet
41 liftIO $ flushedPut setDefaultCharSet
42+ liftIO $ flushedPut disableBracketedPastes
41 releaseTerminal t
43 releaseTerminal t
42 , mkDisplayContext = \tActual r -> do
44 , mkDisplayContext = \tActual r -> do
43 dc <- mkDisplayContext t tActual r
45 dc <- mkDisplayContext t tActual r
@@ -45,6 +47,15 @@ reserveTerminal variant outFd = liftIO $ do
45 }
47 }
46 return t'
48 return t'
47
49
50+-- | Enable bracketed paste mode:
51+-- http://cirw.in/blog/bracketed-paste
52+enableBracketedPastes :: String
53+enableBracketedPastes = "\ESC[?2004h"
54+
55+-- | Disable bracketed paste mode:
56+disableBracketedPastes :: String
57+disableBracketedPastes = "\ESC[?2004l"
58+
48-- | These sequences set xterm based terminals to UTF-8 output.
59-- | These sequences set xterm based terminals to UTF-8 output.
49--
60--
50-- \todo I don't know of a terminfo cap that is equivalent to this.
61-- \todo I don't know of a terminfo cap that is equivalent to this.