0b4fa64 · vty · git.iko.soy

CHANGELOG.md+44

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

11

2+5.31

3+----

4+

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+

2465.28.2

347------

448

LICENSE+2

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

1+BSD 3-Clause License

2+

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

24

35All rights reserved.

cbits/gwinsz.c+14−5

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

11#include <sys/ioctl.h>

22

33unsigned long vty_c_get_window_size(int fd) {

4− struct winsize w;

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

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

7− else

8− return 0x190050;

4+ struct winsize w;

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

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

7+ else

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+ }

918}

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 @@

3333module Graphics.Vty

3434 ( Vty(..)

3535 , mkVty

36+ , setWindowTitle

3637 , Mode(..)

3738 , module Graphics.Vty.Config

3839 , module Graphics.Vty.Input

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

5455import Graphics.Vty.UnicodeWidthTable.IO

5556import Graphics.Vty.UnicodeWidthTable.Install

5657

58+import Data.Char (isPrint, showLitChar)

59+import qualified Data.ByteString.Char8 as BS8

60+

5761import qualified Control.Exception as E

5862import Control.Monad (when)

5963import Control.Concurrent.STM

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

224228 , shutdown = shutdownIo

225229 , isShutdown = shutdownStatus

226230 }

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

4343 , withStyle

4444 , standout

4545 , italic

46+ , strikethrough

4647 , underline

4748 , reverseVideo

4849 , blink

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

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

182183type Style = Word8

183184

184−-- | The 7 possible style attributes:

185+-- | Valid style attributes include:

185186--

186187-- * standout

187188--

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

197198--

198199-- * italic

199200--

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

202+--

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

201204-- 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

203206standout = 0x01

204207underline = 0x02

205208reverseVideo = 0x04

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

207210dim = 0x10

208211bold = 0x20

209212italic = 0x40

213+strikethrough = 0x80

210214

211215defaultStyleMask :: Style

212216defaultStyleMask = 0x00

src/Graphics/Vty/DisplayAttributes.hs+3

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

9696 | RemoveStandout

9797 | ApplyItalic

9898 | RemoveItalic

99+ | ApplyStrikethrough

100+ | RemoveStrikethrough

99101 | ApplyUnderline

100102 | RemoveUnderline

101103 | ApplyReverseVideo

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

144146 [ styleDiff standout ApplyStandout RemoveStandout

145147 , styleDiff underline ApplyUnderline RemoveUnderline

146148 , styleDiff italic ApplyItalic RemoveItalic

149+ , styleDiff strikethrough ApplyStrikethrough RemoveStrikethrough

147150 , styleDiff reverseVideo ApplyReverseVideo RemoveReverseVideo

148151 , styleDiff blink ApplyBlink RemoveBlink

149152 , styleDiff dim ApplyDim RemoveDim

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

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

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

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

145145--

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

147−--

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)

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

147+-- 'attributeControl' function.

162148inputForConfig :: Config -> IO Input

163149inputForConfig config@Config{ termName = Just termName

164150 , inputFd = Just termFd

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

168154 terminal <- Terminfo.setupTerm termName

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

170156 activeInputMap = classifyMapForTerm termName terminal `mappend` inputOverrides

171− (setAttrs,unsetAttrs) <- attributeControl termFd

157+ (setAttrs, unsetAttrs) <- attributeControl termFd

172158 setAttrs

173159 input <- initInput config activeInputMap

174160 let pokeIO = Catch $ do

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

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

178164 _ <- installHandler windowChange pokeIO Nothing

179165 _ <- installHandler continueProcess pokeIO Nothing

166+

167+ let restore = unsetAttrs

168+

180169 return $ input

181170 { shutdownInput = do

182171 shutdownInput input

183172 _ <- installHandler windowChange Ignore Nothing

184173 _ <- installHandler continueProcess Ignore Nothing

185− unsetAttrs

174+ restore

175+ , restoreInputState = restoreInputState input >> restore

186176 }

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

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

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

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

5353 -- is an 'EvResize'.

5454 _eventChannel :: TChan Event

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

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

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

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

5757 , 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 ()

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

5964 , _configRef :: IORef Config

6065 -- | input debug log

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

171176 <*> pure (classify classifyTable)

172177 runReaderT (evalStateT loopInputProcessor s0) input

173178

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)

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

175205attributeControl fd = do

176206 original <- getTerminalAttributes fd

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

178− , EnableEcho, ProcessInput, ExtendedFunctions

179− ]

207+ let vtyMode = foldl withMode clearedFlags flagsToSet

208+ clearedFlags = foldl withoutMode original flagsToUnset

209+ flagsToSet = [ MapCRtoLF -- ICRNL

210+ ]

211+ flagsToUnset = [ StartStopOutput -- IXON

212+ , KeyboardInterrupts -- ISIG

213+ , EnableEcho -- ECHO

214+ , ProcessInput -- ICANON

215+ , ExtendedFunctions -- IEXTEN

216+ ]

180217 let setAttrs = setTerminalAttributes fd vtyMode Immediately

181218 unsetAttrs = setTerminalAttributes fd original Immediately

182− return (setAttrs,unsetAttrs)

219+ return (setAttrs, unsetAttrs)

183220

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

185222logInitialInputState input classifyTable = case _inputDebug input of

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

203240 applyConfig fd config

204241 stopSync <- newEmptyMVar

205242 input <- Input <$> atomically newTChan

243+ <*> pure (return ())

206244 <*> pure (return ())

207245 <*> newIORef config

208246 <*> maybe (return Nothing)

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

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

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

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

7575 , releaseDisplay :: IO ()

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

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

7678 -- | Returns the current display bounds.

7779 , displayBounds :: IO DisplayRegion

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

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

99101 , ringTerminalBell :: IO ()

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

101103 , 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

102120 }

103121

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

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

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

4848 , releaseDisplay = return ()

4949 , ringTerminalBell = return ()

5050 , supportsBell = return False

51+ , supportsItalics = return False

52+ , supportsStrikethrough = return False

53+ , setDisplayBounds = const $ return ()

5154 , displayBounds = return r

5255 , outputByteBuffer = \bytes -> do

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

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

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

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

1111module Graphics.Vty.Output.TerminfoBased

1212 ( reserveTerminal

13+ , setWindowSize

1314 )

1415where

1516

1617import Control.Monad (when)

18+import Data.Bits (shiftL)

1719import qualified Data.ByteString as BS

1820import Data.ByteString.Internal (toForeignPtr)

1921import Data.Terminfo.Parse

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

6668 , exitStandout :: Maybe CapExpression

6769 , enterItalic :: Maybe CapExpression

6870 , exitItalic :: Maybe CapExpression

71+ , enterStrikethrough :: Maybe CapExpression

72+ , exitStrikethrough :: Maybe CapExpression

6973 , enterUnderline :: Maybe CapExpression

7074 , exitUnderline :: Maybe CapExpression

7175 , enterReverseVideo :: Maybe CapExpression

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

164168 sendCap setDefaultAttr []

165169 maybeSendCap cnorm []

166170 , 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))

167175 , ringTerminalBell = maybeSendCap ringBellAudio []

168176 , reserveDisplay = do

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

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

174182 , releaseDisplay = do

175183 maybeSendCap rmcup []

176184 maybeSendCap cnorm []

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

186+ setWindowSize outFd (w, h)

177187 , displayBounds = do

178188 rawSize <- getWindowSize outFd

179189 case rawSize of

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

231241 <*> probeCap ti "rmso"

232242 <*> probeCap ti "sitm"

233243 <*> probeCap ti "ritm"

244+ <*> probeCap ti "smxx"

245+ <*> probeCap ti "rmxx"

234246 <*> probeCap ti "smul"

235247 <*> probeCap ti "rmul"

236248 <*> probeCap ti "rev"

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

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

245257 return (fromIntegral b, fromIntegral a)

246258

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+

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

248267terminfoDisplayContext tActual terminfoCaps r = return dc

249268 where dc = DisplayContext

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

259278 , writeSetAttr = terminfoWriteSetAttr dc terminfoCaps

260279 , writeDefaultAttr = \urlsEnabled ->

261280 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+ )

263286 , writeRowEnd = writeCapExpr (clearEol terminfoCaps) []

264287 , inlineHack = return ()

265288 }

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

337360 )

338361 (sgrArgsForState state)

339362 `mappend` setItalics

363+ `mappend` setStrikethrough

340364 `mappend` setColors

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

342366 -- between two non-default points.

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

364388 )

365389 (sgrArgsForState state)

366390 `mappend` setItalics

391+ `mappend` setStrikethrough

367392 `mappend` setColors

368393 where

369394 urlAttrs True = writeURLEscapes (urlDiff diffs)

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

381406 , Just sitm <- enterItalic (displayAttrCaps terminfoCaps)

382407 = writeCapExpr sitm []

383408 | otherwise = mempty

409+ setStrikethrough

410+ | hasStyle (fixedStyle attr) strikethrough

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

412+ = writeCapExpr smxx []

413+ | otherwise = mempty

384414 setColors =

385415 (case fixedForeColor attr of

386416 Just c -> writeCapExpr (setForeColor terminfoCaps)

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

449479 { applyStandout :: Bool

450480 , applyUnderline :: Bool

451481 , applyItalic :: Bool

482+ , applyStrikethrough :: Bool

452483 , applyReverseVideo :: Bool

453484 , applyBlink :: Bool

454485 , applyDim :: Bool

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

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

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

487518 where

519+ noEnterExitCap ApplyStrikethrough = isNothing $ enterStrikethrough caps

520+ noEnterExitCap RemoveStrikethrough = isNothing $ exitStrikethrough caps

488521 noEnterExitCap ApplyItalic = isNothing $ enterItalic caps

489522 noEnterExitCap RemoveItalic = isNothing $ exitItalic caps

490523 noEnterExitCap ApplyStandout = isNothing $ enterStandout caps

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

499532 noEnterExitCap RemoveDim = True

500533 noEnterExitCap ApplyBold = isNothing $ enterBoldMode caps

501534 noEnterExitCap RemoveBold = True

535+ enterExitCap ApplyStrikethrough = fromJust $ enterStrikethrough caps

536+ enterExitCap RemoveStrikethrough = fromJust $ exitStrikethrough caps

502537 enterExitCap ApplyItalic = fromJust $ enterItalic caps

503538 enterExitCap RemoveItalic = fromJust $ exitItalic caps

504539 enterExitCap ApplyStandout = fromJust $ enterStandout caps

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

515550 { applyStandout = isStyleSet standout

516551 , applyUnderline = isStyleSet underline

517552 , applyItalic = isStyleSet italic

553+ , applyStrikethrough = isStyleSet strikethrough

518554 , applyReverseVideo = isStyleSet reverseVideo

519555 , applyBlink = isStyleSet blink

520556 , applyDim = isStyleSet dim

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

527563 [ applyIfRequired ApplyStandout standout

528564 , applyIfRequired ApplyUnderline underline

529565 , applyIfRequired ApplyItalic italic

566+ , applyIfRequired ApplyStrikethrough strikethrough

530567 , applyIfRequired ApplyReverseVideo reverseVideo

531568 , applyIfRequired ApplyBlink blink

532569 , applyIfRequired ApplyDim dim

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

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

113113setUtf8CharSet = "\ESC%G"

114114setDefaultCharSet = "\ESC%@"

115115

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.

119116xtermInlineHack :: Output -> IO ()

120117xtermInlineHack t = do

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

vty.cabal+1−1

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

11name: vty

2−version: 5.28.2

2+version: 5.31

33license: BSD3

44license-file: LICENSE

55author: AUTHORS