0b4fa64 · vty · git.iko.soy

git.iko.soy/vty

on master help sign in

Merge branch 'master' of github.com:jtdaugherty/vty into master

0b4fa64Jonathan Daugherty6 years ago

CHANGELOG.md+44

compare with master

unifiedsplit

@@ -1,4 +1,48 @@

2+5.31

3+----

5+New features and API changes:

6+ * Added support for strikethrough mode. This change adds a new

7+ `strikethrough` `Style` value and uses the `smxx` and `rmxx`

8+ Terminfo capabilities to activate and deactivate strikethrough mode,

9+ respectively. If the terminfo does not report those capabilities,

10+ this style is ignored.

11+ * `Output`: added the `setDisplayBounds` field to set the output

12+ dimensions of the output handle; added an implementation of this for

13+ the `TerminfoBased` backend.

14+

15+Other changes:

16+ * The C prototype for `vty_c_get_window_size` in `gwinsz.h` was fixed.

17+

18+5.30

19+----

20+

21+New features:

22+ * Added `Graphics.Vty.setWindowTitle` to emit an escape

23+ sequence to set the window title, provide the terminal emulator

24+ accepts Xterm-style title sequences. For details, see:

25+ https://tldp.org/HOWTO/Xterm-Title-3.html

26+

27+5.29

28+----

29+

30+API changes:

31+ * The Input type got a new field, 'restoreInputState'. This field

32+ allows the end user to have direct access to the logic needed to

33+ restore the terminal's input state flags. Prior to having this field,

34+ this state restoration logic could only be invoked as part of calling

35+ 'shutdownInput', but since that function does other things (like

36+ killing threads) it is not advisable to call it repeatedly (which is

37+ necessary in the use case this change is intended to support). This

38+ can be called directly to restore the input state flags as needed,

39+ although this is not required if 'shutdown' (or 'shutdownInput') is

40+ called.

41+

42+Other changes:

43+ * attributeControl: explicitly enable the ICRNL terminal mode flag (see

44+ #187 and c572ad).

45+

25.28.2

465.28.2

3------

47------

LICENSE+2

@@ -1,3 +1,5 @@

1+BSD 3-Clause License

1Copyright Stefan O'Rear 2006, Corey O'Connor 2008, Corey O'Connor 2009

3Copyright Stefan O'Rear 2006, Corey O'Connor 2008, Corey O'Connor 2009

3All rights reserved.

5All rights reserved.

cbits/gwinsz.c+14−5

@@ -1,9 +1,18 @@

1#include <sys/ioctl.h>

3unsigned long vty_c_get_window_size(int fd) {

4− struct winsize w;

4+ struct winsize w;

5− if (ioctl (fd, TIOCGWINSZ, &w) >= 0)

5+ if (ioctl (fd, TIOCGWINSZ, &w) >= 0)

6− return (w.ws_row << 16) + w.ws_col;

6+ return (w.ws_row << 16) + w.ws_col;

7− else

7+ else

8− return 0x190050;

8+ return 0x190050;

9+}

10+

11+void vty_c_set_window_size(int fd, unsigned long val) {

12+ struct winsize w;

13+ if (ioctl(fd, TIOCGWINSZ, &w) >= 0) {

14+ w.ws_row = val >> 16;

15+ w.ws_col = val & 0xFFFF;

16+ ioctl(fd, TIOCSWINSZ, &w);

17+ }

18}

cbits/gwinsz.h+2−1

@@ -1 +1,2 @@

1−unsigned long vty_c_get_window_size(void);

1+unsigned long vty_c_get_window_size(int fd);

2+unsigned long vty_c_set_window_size(int fd, unsigned long val);

src/Graphics/Vty.hs+25

@@ -33,6 +33,7 @@

33module Graphics.Vty

34 ( Vty(..)

35 , mkVty

36+ , setWindowTitle

36 , Mode(..)

37 , Mode(..)

37 , module Graphics.Vty.Config

38 , module Graphics.Vty.Config

38 , module Graphics.Vty.Input

39 , module Graphics.Vty.Input

@@ -54,6 +55,9 @@ import Graphics.Vty.Attributes

54import Graphics.Vty.UnicodeWidthTable.IO

55import Graphics.Vty.UnicodeWidthTable.IO

55import Graphics.Vty.UnicodeWidthTable.Install

56import Graphics.Vty.UnicodeWidthTable.Install

58+import Data.Char (isPrint, showLitChar)

59+import qualified Data.ByteString.Char8 as BS8

60+

57import qualified Control.Exception as E

61import qualified Control.Exception as E

58import Control.Monad (when)

62import Control.Monad (when)

59import Control.Concurrent.STM

63import Control.Concurrent.STM

@@ -224,3 +228,24 @@ internalMkVty input out = do

224 , shutdown = shutdownIo

228 , shutdown = shutdownIo

225 , isShutdown = shutdownStatus

229 , isShutdown = shutdownStatus

226 }

230 }

231+

232+-- | Set the terminal window title string.

233+--

234+-- This function emits an Xterm-compatible escape sequence that we

235+-- anticipate will work for essentially all modern terminal emulators.

236+-- Ideally we'd use a terminal capability for this, but there does not

237+-- seem to exist a termcap for setting window titles. If you find that

238+-- this function does not work for a given terminal emulator, please

239+-- report the issue.

240+--

241+-- For details, see:

242+--

243+-- https://tldp.org/HOWTO/Xterm-Title-3.html

244+setWindowTitle :: Vty -> String -> IO ()

245+setWindowTitle vty title = do

246+ let sanitize :: String -> String

247+ sanitize = concatMap sanitizeChar

248+ sanitizeChar c | not (isPrint c) = showLitChar c ""

249+ | otherwise = [c]

250+ let buf = BS8.pack $ "\ESC]2;" <> sanitize title <> "\007"

251+ outputByteBuffer (outputIface vty) buf

src/Graphics/Vty/Attributes.hs+6−2

@@ -43,6 +43,7 @@ module Graphics.Vty.Attributes

43 , withStyle

44 , standout

45 , italic

46+ , strikethrough

46 , underline

47 , underline

47 , reverseVideo

48 , reverseVideo

48 , blink

49 , blink

@@ -181,7 +182,7 @@ instance Eq v => Monoid ( MaybeDefault v ) where

181-- if the style attribute should not be applied.

182-- if the style attribute should not be applied.

182type Style = Word8

183type Style = Word8

183

184

184−-- | The 7 possible style attributes:

185+-- | Valid style attributes include:

185--

186--

186-- * standout

187-- * standout

187--

188--

@@ -197,9 +198,11 @@ type Style = Word8

197--

198--

198-- * italic

199-- * italic

199--

200--

201+-- * strikethrough (via the smxx/rmxx terminfo capabilities)

202+--

200-- (The invisible, protect, and altcharset display attributes some

203-- (The invisible, protect, and altcharset display attributes some

201-- terminals support are not supported via VTY.)

204-- terminals support are not supported via VTY.)

202−standout, underline, reverseVideo, blink, dim, bold, italic :: Style

205+standout, underline, reverseVideo, blink, dim, bold, italic, strikethrough :: Style

203standout = 0x01

206standout = 0x01

204underline = 0x02

207underline = 0x02

205reverseVideo = 0x04

208reverseVideo = 0x04

@@ -207,6 +210,7 @@ blink = 0x08

207dim = 0x10

210dim = 0x10

208bold = 0x20

211bold = 0x20

209italic = 0x40

212italic = 0x40

213+strikethrough = 0x80

210

214

211defaultStyleMask :: Style

215defaultStyleMask :: Style

212defaultStyleMask = 0x00

216defaultStyleMask = 0x00

src/Graphics/Vty/DisplayAttributes.hs+3

@@ -96,6 +96,8 @@ data StyleStateChange

96 | RemoveStandout

97 | ApplyItalic

98 | RemoveItalic

99+ | ApplyStrikethrough

100+ | RemoveStrikethrough

99 | ApplyUnderline

101 | ApplyUnderline

100 | RemoveUnderline

102 | RemoveUnderline

101 | ApplyReverseVideo

103 | ApplyReverseVideo

@@ -144,6 +146,7 @@ diffStyles prev cur

144 [ styleDiff standout ApplyStandout RemoveStandout

146 [ styleDiff standout ApplyStandout RemoveStandout

145 , styleDiff underline ApplyUnderline RemoveUnderline

147 , styleDiff underline ApplyUnderline RemoveUnderline

146 , styleDiff italic ApplyItalic RemoveItalic

148 , styleDiff italic ApplyItalic RemoveItalic

149+ , styleDiff strikethrough ApplyStrikethrough RemoveStrikethrough

147 , styleDiff reverseVideo ApplyReverseVideo RemoveReverseVideo

150 , styleDiff reverseVideo ApplyReverseVideo RemoveReverseVideo

148 , styleDiff blink ApplyBlink RemoveBlink

151 , styleDiff blink ApplyBlink RemoveBlink

149 , styleDiff dim ApplyDim RemoveDim

152 , styleDiff dim ApplyDim RemoveDim

src/Graphics/Vty/Input.hs+8−18

@@ -143,22 +143,8 @@ import Data.Monoid ((<>))

143-- bytes comes from 'classifyMapForTerm' which is then overridden by

144-- the the applicable entries from the configuration's 'inputMap'.

145--

146−-- The terminal device is configured with the attributes:

146+-- The terminal device's mode flags are configured by the

147−--

147+-- 'attributeControl' function.

148−-- * IXON disabled: disables software flow control on outgoing data.

149−-- This stops the process from being suspended if the output terminal

150−-- cannot keep up.

151−--

152−-- * Raw mode is used for input.

153−--

154−-- * ISIG disabled (enables keyboard combinations that result in

155−-- signals)

156−--

157−-- * ECHO disabled (input is not echoed to the output)

158−--

159−-- * ICANON disabled (canonical mode (line mode) input is not used)

160−--

161−-- * IEXTEN disabled (extended functions are disabled)

162inputForConfig :: Config -> IO Input

148inputForConfig :: Config -> IO Input

163inputForConfig config@Config{ termName = Just termName

149inputForConfig config@Config{ termName = Just termName

164 , inputFd = Just termFd

150 , inputFd = Just termFd

@@ -168,7 +154,7 @@ inputForConfig config@Config{ termName = Just termName

168 terminal <- Terminfo.setupTerm termName

154 terminal <- Terminfo.setupTerm termName

169 let inputOverrides = [(s,e) | (t,s,e) <- inputMap, t == Nothing || t == Just termName]

155 let inputOverrides = [(s,e) | (t,s,e) <- inputMap, t == Nothing || t == Just termName]

170 activeInputMap = classifyMapForTerm termName terminal `mappend` inputOverrides

156 activeInputMap = classifyMapForTerm termName terminal `mappend` inputOverrides

171− (setAttrs,unsetAttrs) <- attributeControl termFd

157+ (setAttrs, unsetAttrs) <- attributeControl termFd

172 setAttrs

158 setAttrs

173 input <- initInput config activeInputMap

159 input <- initInput config activeInputMap

174 let pokeIO = Catch $ do

160 let pokeIO = Catch $ do

@@ -177,11 +163,15 @@ inputForConfig config@Config{ termName = Just termName

177 atomically $ writeTChan (input^.eventChannel) (EvResize e e)

163 atomically $ writeTChan (input^.eventChannel) (EvResize e e)

178 _ <- installHandler windowChange pokeIO Nothing

164 _ <- installHandler windowChange pokeIO Nothing

179 _ <- installHandler continueProcess pokeIO Nothing

165 _ <- installHandler continueProcess pokeIO Nothing

166+

167+ let restore = unsetAttrs

168+

180 return $ input

169 return $ input

181 { shutdownInput = do

170 { shutdownInput = do

182 shutdownInput input

171 shutdownInput input

183 _ <- installHandler windowChange Ignore Nothing

172 _ <- installHandler windowChange Ignore Nothing

184 _ <- installHandler continueProcess Ignore Nothing

173 _ <- installHandler continueProcess Ignore Nothing

185− unsetAttrs

174+ restore

175+ , restoreInputState = restoreInputState input >> restore

186 }

176 }

187inputForConfig config = (<> config) <$> standardIOConfig >>= inputForConfig

177inputForConfig config = (<> config) <$> standardIOConfig >>= inputForConfig

src/Graphics/Vty/Input/Loop.hs+44−6

@@ -52,9 +52,14 @@ data Input = Input

52 -- 'nextEvent' this will not refresh the display if the next event

53 -- is an 'EvResize'.

54 _eventChannel :: TChan Event

55− -- | Shuts down the input processing. This should return the

55+ -- | Shuts down the input processing. As part of shutting down the

56− -- terminal input state to before he input initialized.

56+ -- input, this should also restore the input state.

57 , shutdownInput :: IO ()

58+ -- | Restore the terminal's input state to what it was prior

59+ -- to configuring input for Vty. This should be done as part of

60+ -- 'shutdownInput' but is exposed in case you need to access it

61+ -- directly.

62+ , restoreInputState :: IO ()

58 -- | Changes to this value are reflected after the next event.

63 -- | Changes to this value are reflected after the next event.

59 , _configRef :: IORef Config

64 , _configRef :: IORef Config

60 -- | input debug log

65 -- | input debug log

@@ -171,15 +176,47 @@ runInputProcessorLoop classifyTable input = do

171 <*> pure (classify classifyTable)

176 <*> pure (classify classifyTable)

172 runReaderT (evalStateT loopInputProcessor s0) input

177 runReaderT (evalStateT loopInputProcessor s0) input

173

178

179+-- | Construct two IO actions: one to configure the terminal for Vty and

180+-- one to restore the terminal mode flags to the values they had at the

181+-- time this function was called.

182+--

183+-- This function constructs a configuration action to clear the

184+-- following terminal mode flags:

185+--

186+-- * IXON disabled: disables software flow control on outgoing data.

187+-- This stops the process from being suspended if the output terminal

188+-- cannot keep up.

189+--

190+-- * Raw mode is used for input.

191+--

192+-- * ISIG (enables keyboard combinations that result in

193+-- signals)

194+--

195+-- * ECHO (input is not echoed to the output)

196+--

197+-- * ICANON (canonical mode (line mode) input is not used)

198+--

199+-- * IEXTEN (extended functions are disabled)

200+--

201+-- The configuration action also explicitly sets these flags:

202+--

203+-- * ICRNL (input carriage returns are mapped to newlines)

174attributeControl :: Fd -> IO (IO (), IO ())

204attributeControl :: Fd -> IO (IO (), IO ())

175attributeControl fd = do

205attributeControl fd = do

176 original <- getTerminalAttributes fd

206 original <- getTerminalAttributes fd

207+ let vtyMode = foldl withMode clearedFlags flagsToSet

208+ clearedFlags = foldl withoutMode original flagsToUnset

209+ flagsToSet = [ MapCRtoLF -- ICRNL

210+ ]

211+ flagsToUnset = [ StartStopOutput -- IXON

177− let vtyMode = foldl withoutMode original [ StartStopOutput, KeyboardInterrupts

212+ , KeyboardInterrupts -- ISIG

213+ , EnableEcho -- ECHO

214+ , ProcessInput -- ICANON

178− , EnableEcho, ProcessInput, ExtendedFunctions

215+ , ExtendedFunctions -- IEXTEN

179− ]

216+ ]

180 let setAttrs = setTerminalAttributes fd vtyMode Immediately

217 let setAttrs = setTerminalAttributes fd vtyMode Immediately

181 unsetAttrs = setTerminalAttributes fd original Immediately

218 unsetAttrs = setTerminalAttributes fd original Immediately

182− return (setAttrs,unsetAttrs)

219+ return (setAttrs, unsetAttrs)

183

220

184logInitialInputState :: Input -> ClassifyMap -> IO()

221logInitialInputState :: Input -> ClassifyMap -> IO()

185logInitialInputState input classifyTable = case _inputDebug input of

222logInitialInputState input classifyTable = case _inputDebug input of

@@ -203,6 +240,7 @@ initInput config classifyTable = do

203 applyConfig fd config

240 applyConfig fd config

204 stopSync <- newEmptyMVar

241 stopSync <- newEmptyMVar

205 input <- Input <$> atomically newTChan

242 input <- Input <$> atomically newTChan

243+ <*> pure (return ())

206 <*> pure (return ())

244 <*> pure (return ())

207 <*> newIORef config

245 <*> newIORef config

208 <*> maybe (return Nothing)

246 <*> maybe (return Nothing)

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

@@ -73,6 +73,8 @@ data Output = Output

73 -- | Return the display to the state before `reserveDisplay` If no

74 -- previous state then set the display state to the initial state.

75 , releaseDisplay :: IO ()

76+ -- | Sets the current display bounds (width, height).

77+ , setDisplayBounds :: (Int, Int) -> IO ()

76 -- | Returns the current display bounds.

78 -- | Returns the current display bounds.

77 , displayBounds :: IO DisplayRegion

79 , displayBounds :: IO DisplayRegion

78 -- | Output the bytestring to the terminal device.

80 -- | Output the bytestring to the terminal device.

@@ -99,6 +101,22 @@ data Output = Output

99 , ringTerminalBell :: IO ()

101 , ringTerminalBell :: IO ()

100 -- | Returns whether the terminal has an audio bell feature.

102 -- | Returns whether the terminal has an audio bell feature.

101 , supportsBell :: IO Bool

103 , supportsBell :: IO Bool

104+ -- | Returns whether the terminal supports italicized text.

105+ --

106+ -- This is terminal-dependent and should make a best effort to

107+ -- determine whether this feature is supported, but even if the

108+ -- terminal advertises support (e.g. via terminfo) that might not

109+ -- be a reliable indicator of whether the feature will work as

110+ -- desired.

111+ , supportsItalics :: IO Bool

112+ -- | Returns whether the terminal supports strikethrough text.

113+ --

114+ -- This is terminal-dependent and should make a best effort to

115+ -- determine whether this feature is supported, but even if the

116+ -- terminal advertises support (e.g. via terminfo) that might not

117+ -- be a reliable indicator of whether the feature will work as

118+ -- desired.

119+ , supportsStrikethrough :: IO Bool

102 }

120 }

103

121

104displayContext :: Output -> DisplayRegion -> IO DisplayContext

122displayContext :: Output -> DisplayRegion -> IO DisplayContext

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

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

48 , releaseDisplay = return ()

49 , ringTerminalBell = return ()

50 , supportsBell = return False

51+ , supportsItalics = return False

52+ , supportsStrikethrough = return False

53+ , setDisplayBounds = const $ return ()

51 , displayBounds = return r

54 , displayBounds = return r

52 , outputByteBuffer = \bytes -> do

55 , outputByteBuffer = \bytes -> do

53 putStrLn $ "mock outputByteBuffer of " ++ show (BS.length bytes) ++ " bytes"

56 putStrLn $ "mock outputByteBuffer of " ++ show (BS.length bytes) ++ " bytes"

src/Graphics/Vty/Output/TerminfoBased.hs+38−1

@@ -10,10 +10,12 @@

10-- Copyright Corey O'Connor (coreyoconnor@gmail.com)

11module Graphics.Vty.Output.TerminfoBased

12 ( reserveTerminal

13+ , setWindowSize

13 )

14 )

14where

15where

16import Control.Monad (when)

17import Control.Monad (when)

18+import Data.Bits (shiftL)

17import qualified Data.ByteString as BS

19import qualified Data.ByteString as BS

18import Data.ByteString.Internal (toForeignPtr)

20import Data.ByteString.Internal (toForeignPtr)

19import Data.Terminfo.Parse

21import Data.Terminfo.Parse

@@ -66,6 +68,8 @@ data DisplayAttrCaps = DisplayAttrCaps

66 , exitStandout :: Maybe CapExpression

68 , exitStandout :: Maybe CapExpression

67 , enterItalic :: Maybe CapExpression

69 , enterItalic :: Maybe CapExpression

68 , exitItalic :: Maybe CapExpression

70 , exitItalic :: Maybe CapExpression

71+ , enterStrikethrough :: Maybe CapExpression

72+ , exitStrikethrough :: Maybe CapExpression

69 , enterUnderline :: Maybe CapExpression

73 , enterUnderline :: Maybe CapExpression

70 , exitUnderline :: Maybe CapExpression

74 , exitUnderline :: Maybe CapExpression

71 , enterReverseVideo :: Maybe CapExpression

75 , enterReverseVideo :: Maybe CapExpression

@@ -164,6 +168,10 @@ reserveTerminal termName outFd = do

164 sendCap setDefaultAttr []

168 sendCap setDefaultAttr []

165 maybeSendCap cnorm []

169 maybeSendCap cnorm []

166 , supportsBell = return $ isJust $ ringBellAudio terminfoCaps

170 , supportsBell = return $ isJust $ ringBellAudio terminfoCaps

171+ , supportsItalics = return $ (isJust $ enterItalic (displayAttrCaps terminfoCaps)) &&

172+ (isJust $ exitItalic (displayAttrCaps terminfoCaps))

173+ , supportsStrikethrough = return $ (isJust $ enterStrikethrough (displayAttrCaps terminfoCaps)) &&

174+ (isJust $ exitStrikethrough (displayAttrCaps terminfoCaps))

167 , ringTerminalBell = maybeSendCap ringBellAudio []

175 , ringTerminalBell = maybeSendCap ringBellAudio []

168 , reserveDisplay = do

176 , reserveDisplay = do

169 -- If there is no support for smcup: Clear the screen

177 -- If there is no support for smcup: Clear the screen

@@ -174,6 +182,8 @@ reserveTerminal termName outFd = do

174 , releaseDisplay = do

182 , releaseDisplay = do

175 maybeSendCap rmcup []

183 maybeSendCap rmcup []

176 maybeSendCap cnorm []

184 maybeSendCap cnorm []

185+ , setDisplayBounds = \(w, h) ->

186+ setWindowSize outFd (w, h)

177 , displayBounds = do

187 , displayBounds = do

178 rawSize <- getWindowSize outFd

188 rawSize <- getWindowSize outFd

179 case rawSize of

189 case rawSize of

@@ -231,6 +241,8 @@ currentDisplayAttrCaps ti

231 <*> probeCap ti "rmso"

241 <*> probeCap ti "rmso"

232 <*> probeCap ti "sitm"

242 <*> probeCap ti "sitm"

233 <*> probeCap ti "ritm"

243 <*> probeCap ti "ritm"

244+ <*> probeCap ti "smxx"

245+ <*> probeCap ti "rmxx"

234 <*> probeCap ti "smul"

246 <*> probeCap ti "smul"

235 <*> probeCap ti "rmul"

247 <*> probeCap ti "rmul"

236 <*> probeCap ti "rev"

248 <*> probeCap ti "rev"

@@ -244,6 +256,13 @@ getWindowSize fd = do

244 (a,b) <- (`divMod` 65536) `fmap` c_getWindowSize fd

256 (a,b) <- (`divMod` 65536) `fmap` c_getWindowSize fd

245 return (fromIntegral b, fromIntegral a)

257 return (fromIntegral b, fromIntegral a)

246

258

259+foreign import ccall "gwinsz.h vty_c_set_window_size" c_setWindowSize :: Fd -> CLong -> IO ()

260+

261+setWindowSize :: Fd -> (Int, Int) -> IO ()

262+setWindowSize fd (w, h) = do

263+ let val = (h `shiftL` 16) + w

264+ c_setWindowSize fd $ fromIntegral val

265+

247terminfoDisplayContext :: Output -> TerminfoCaps -> DisplayRegion -> IO DisplayContext

266terminfoDisplayContext :: Output -> TerminfoCaps -> DisplayRegion -> IO DisplayContext

248terminfoDisplayContext tActual terminfoCaps r = return dc

267terminfoDisplayContext tActual terminfoCaps r = return dc

249 where dc = DisplayContext

268 where dc = DisplayContext

@@ -259,7 +278,11 @@ terminfoDisplayContext tActual terminfoCaps r = return dc

259 , writeSetAttr = terminfoWriteSetAttr dc terminfoCaps

278 , writeSetAttr = terminfoWriteSetAttr dc terminfoCaps

260 , writeDefaultAttr = \urlsEnabled ->

279 , writeDefaultAttr = \urlsEnabled ->

261 writeCapExpr (setDefaultAttr terminfoCaps) [] `mappend`

280 writeCapExpr (setDefaultAttr terminfoCaps) [] `mappend`

262− (if urlsEnabled then writeURLEscapes EndLink else mempty)

281+ (if urlsEnabled then writeURLEscapes EndLink else mempty) `mappend`

282+ (case exitStrikethrough $ displayAttrCaps terminfoCaps of

283+ Just cap -> writeCapExpr cap []

284+ Nothing -> mempty

285+ )

263 , writeRowEnd = writeCapExpr (clearEol terminfoCaps) []

286 , writeRowEnd = writeCapExpr (clearEol terminfoCaps) []

264 , inlineHack = return ()

287 , inlineHack = return ()

265 }

288 }

@@ -337,6 +360,7 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =

337 )

360 )

338 (sgrArgsForState state)

361 (sgrArgsForState state)

339 `mappend` setItalics

362 `mappend` setItalics

363+ `mappend` setStrikethrough

340 `mappend` setColors

364 `mappend` setColors

341 -- Otherwise the display colors are not changing or changing

365 -- Otherwise the display colors are not changing or changing

342 -- between two non-default points.

366 -- between two non-default points.

@@ -364,6 +388,7 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =

364 )

388 )

365 (sgrArgsForState state)

389 (sgrArgsForState state)

366 `mappend` setItalics

390 `mappend` setItalics

391+ `mappend` setStrikethrough

367 `mappend` setColors

392 `mappend` setColors

368 where

393 where

369 urlAttrs True = writeURLEscapes (urlDiff diffs)

394 urlAttrs True = writeURLEscapes (urlDiff diffs)

@@ -381,6 +406,11 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =

381 , Just sitm <- enterItalic (displayAttrCaps terminfoCaps)

406 , Just sitm <- enterItalic (displayAttrCaps terminfoCaps)

382 = writeCapExpr sitm []

407 = writeCapExpr sitm []

383 | otherwise = mempty

408 | otherwise = mempty

409+ setStrikethrough

410+ | hasStyle (fixedStyle attr) strikethrough

411+ , Just smxx <- enterStrikethrough (displayAttrCaps terminfoCaps)

412+ = writeCapExpr smxx []

413+ | otherwise = mempty

384 setColors =

414 setColors =

385 (case fixedForeColor attr of

415 (case fixedForeColor attr of

386 Just c -> writeCapExpr (setForeColor terminfoCaps)

416 Just c -> writeCapExpr (setForeColor terminfoCaps)

@@ -449,6 +479,7 @@ data DisplayAttrState = DisplayAttrState

449 { applyStandout :: Bool

479 { applyStandout :: Bool

450 , applyUnderline :: Bool

480 , applyUnderline :: Bool

451 , applyItalic :: Bool

481 , applyItalic :: Bool

482+ , applyStrikethrough :: Bool

452 , applyReverseVideo :: Bool

483 , applyReverseVideo :: Bool

453 , applyBlink :: Bool

484 , applyBlink :: Bool

454 , applyDim :: Bool

485 , applyDim :: Bool

@@ -485,6 +516,8 @@ reqDisplayCapSeqFor caps s diffs

485 -- set state cap then just use the set state cap.

516 -- set state cap then just use the set state cap.

486 ( True, True ) -> SetState $ stateForStyle s

517 ( True, True ) -> SetState $ stateForStyle s

487 where

518 where

519+ noEnterExitCap ApplyStrikethrough = isNothing $ enterStrikethrough caps

520+ noEnterExitCap RemoveStrikethrough = isNothing $ exitStrikethrough caps

488 noEnterExitCap ApplyItalic = isNothing $ enterItalic caps

521 noEnterExitCap ApplyItalic = isNothing $ enterItalic caps

489 noEnterExitCap RemoveItalic = isNothing $ exitItalic caps

522 noEnterExitCap RemoveItalic = isNothing $ exitItalic caps

490 noEnterExitCap ApplyStandout = isNothing $ enterStandout caps

523 noEnterExitCap ApplyStandout = isNothing $ enterStandout caps

@@ -499,6 +532,8 @@ reqDisplayCapSeqFor caps s diffs

499 noEnterExitCap RemoveDim = True

532 noEnterExitCap RemoveDim = True

500 noEnterExitCap ApplyBold = isNothing $ enterBoldMode caps

533 noEnterExitCap ApplyBold = isNothing $ enterBoldMode caps

501 noEnterExitCap RemoveBold = True

534 noEnterExitCap RemoveBold = True

535+ enterExitCap ApplyStrikethrough = fromJust $ enterStrikethrough caps

536+ enterExitCap RemoveStrikethrough = fromJust $ exitStrikethrough caps

502 enterExitCap ApplyItalic = fromJust $ enterItalic caps

537 enterExitCap ApplyItalic = fromJust $ enterItalic caps

503 enterExitCap RemoveItalic = fromJust $ exitItalic caps

538 enterExitCap RemoveItalic = fromJust $ exitItalic caps

504 enterExitCap ApplyStandout = fromJust $ enterStandout caps

539 enterExitCap ApplyStandout = fromJust $ enterStandout caps

@@ -515,6 +550,7 @@ stateForStyle s = DisplayAttrState

515 { applyStandout = isStyleSet standout

550 { applyStandout = isStyleSet standout

516 , applyUnderline = isStyleSet underline

551 , applyUnderline = isStyleSet underline

517 , applyItalic = isStyleSet italic

552 , applyItalic = isStyleSet italic

553+ , applyStrikethrough = isStyleSet strikethrough

518 , applyReverseVideo = isStyleSet reverseVideo

554 , applyReverseVideo = isStyleSet reverseVideo

519 , applyBlink = isStyleSet blink

555 , applyBlink = isStyleSet blink

520 , applyDim = isStyleSet dim

556 , applyDim = isStyleSet dim

@@ -527,6 +563,7 @@ styleToApplySeq s = concat

527 [ applyIfRequired ApplyStandout standout

563 [ applyIfRequired ApplyStandout standout

528 , applyIfRequired ApplyUnderline underline

564 , applyIfRequired ApplyUnderline underline

529 , applyIfRequired ApplyItalic italic

565 , applyIfRequired ApplyItalic italic

566+ , applyIfRequired ApplyStrikethrough strikethrough

530 , applyIfRequired ApplyReverseVideo reverseVideo

567 , applyIfRequired ApplyReverseVideo reverseVideo

531 , applyIfRequired ApplyBlink blink

568 , applyIfRequired ApplyBlink blink

532 , applyIfRequired ApplyDim dim

569 , applyIfRequired ApplyDim dim

src/Graphics/Vty/Output/XTermColor.hs−3

@@ -113,9 +113,6 @@ setUtf8CharSet, setDefaultCharSet :: String

113setUtf8CharSet = "\ESC%G"

114setDefaultCharSet = "\ESC%@"

115

116−-- | I think xterm is broken: Reseting the background color as the first

117−-- bytes serialized on a new line does not effect the background color

118−-- xterm uses to clear the line. Which is used *after* the next newline.

119xtermInlineHack :: Output -> IO ()

116xtermInlineHack :: Output -> IO ()

120xtermInlineHack t = do

117xtermInlineHack t = do

121 let writeReset = foldMap (writeWord8.toEnum.fromEnum) "\ESC[K"

118 let writeReset = foldMap (writeWord8.toEnum.fromEnum) "\ESC[K"

vty.cabal+1−1

@@ -1,5 +1,5 @@

1name: vty

2−version: 5.28.2

2+version: 5.31

3license: BSD3

4license-file: LICENSE

5author: AUTHORS