git.iko.soy/vty
on master help sign in
Add support for bracketed paste mode in XtermColor-driven terminals (fixes #50)

For details, see http://cirw.in/blog/bracketed-paste This change adds a new Event constructor, EvPaste String to deliver the contents of a paste to the application. The constructor provides a String instead of Text as originally suggested because I wanted to punt on encoding issues and let the application deal with that. This change has been tested under tmux, Terminal.app, and iTerm2. A development build of GNU screen also supports this paste mode (provided you set TERM to "xterm" to force Vty to use the XtermColor driver for screen). The mode has apparently been supported for a few years, but I couldn't get the latest stable build in Homebrew (4.03.01) to work in this mode so my only testing with GNU Screen was with git HEAD (8d677e73). It's possible the original patch didn't actually work but interim refactorings fixed it.

commitf68bb32de5a89fb01ec2d1c2cd4b93d38ded2b5d authorJonathan Daugherty <cygnus@foobox.com> dateSun 19 Jun 2016, 14:32 (10 years ago) parent89b904f
3 files changed+50−1
compare with master
unifiedsplit
src/Graphics/Vty/Input/Classify.hs+33−1 src/Graphics/Vty/Input/Events.hs+6 src/Graphics/Vty/Output/XTermColor.hs+11
src/Graphics/Vty/Input/Classify.hs+33−1
@@ -15,7 +15,7 @@ import Graphics.Vty.Input.Events
1515
1616import Codec.Binary.UTF8.Generic (decode)
1717
18−import Data.List(inits)
18+import Data.List (inits, isPrefixOf, isInfixOf)
1919import qualified Data.Map as M( fromList, lookup )
2020import Data.Maybe ( mapMaybe )
2121import qualified Data.Set as S( fromList, member )
@@ -60,6 +60,10 @@ classify :: ClassifyMap -> [Char] -> KClass
6060classify table =
6161 let standardClassifier = compile table
6262 in \s -> case s of
63+ _ | bracketedPasteStarted s ->
64+ if bracketedPasteFinished s
65+ then parseBracketedPaste s
66+ else Prefix
6367 c:cs | ord c >= 0xC2 -> classifyUtf8 c cs
6468 _ -> standardClassifier s
6569
@@ -82,3 +86,31 @@ utf8Length c
8286 | c < 0xE0 = 2
8387 | c < 0xF0 = 3
8488 | 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
3636 -- 'nextEvent' this is the size at the time the event was processed by Vty. Typically these are
3737 -- the same, but if somebody is resizing the terminal quickly they can be different.
3838 | 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!)
3945 deriving (Eq,Show,Read,Ord)
4046
4147type ClassifyMap = [(String,Event)]
src/Graphics/Vty/Output/XTermColor.hs+11
@@ -33,11 +33,13 @@ reserveTerminal variant outFd = liftIO $ do
3333 -- xterm-color is broken.
3434 let variant' = if variant == "xterm-color" then "xterm" else variant
3535 flushedPut setUtf8CharSet
36+ flushedPut enableBracketedPastes
3637 t <- TerminfoBased.reserveTerminal variant' outFd
3738 let t' = t
3839 { terminalID = terminalID t ++ " (xterm-color)"
3940 , releaseTerminal = do
4041 liftIO $ flushedPut setDefaultCharSet
42+ liftIO $ flushedPut disableBracketedPastes
4143 releaseTerminal t
4244 , mkDisplayContext = \tActual r -> do
4345 dc <- mkDisplayContext t tActual r
@@ -45,6 +47,15 @@ reserveTerminal variant outFd = liftIO $ do
4547 }
4648 return t'
4749
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+
4859-- | These sequences set xterm based terminals to UTF-8 output.
4960--
5061-- \todo I don't know of a terminfo cap that is equivalent to this.