598b014 · vty · git.iko.soy

CHANGELOG.md+28

@@ -1,4 +1,32 @@

11

2+5.32

3+----

4+

5+New features:

6+ * Meta-PageUp and Meta-PageDown are now supported (#193)

7+ * Added `supportsItalics` and `supportsStrikethrough` functions to

8+ check for feature support in terminfo

9+

10+Bug fixes:

11+ * Detect utf-8 mode in `LANG` regardless of case (thanks Emeka

12+ Nkurumeh)

13+

14+5.31

15+----

16+

17+New features and API changes:

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

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

20+ Terminfo capabilities to activate and deactivate strikethrough mode,

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

22+ this style is ignored.

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

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

25+ the `TerminfoBased` backend.

26+

27+Other changes:

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

29+

2305.30

331----

432

src/Data/Sequence/Extra.hs+1−1

@@ -7,7 +7,7 @@ import Data.Sequence

77import Control.Parallel.Strategies

88

99instance NFData a => NFData (Seq a) where

10− rnf = \v -> rnf' (viewl v)

10+ rnf = rnf' . viewl

1111 where

1212 rnf' EmptyL = ()

1313 rnf' (a :< r) = rnf a >| rnf' (viewl r)

src/Data/Terminfo/Parse.hs+5−5

@@ -39,7 +39,7 @@ instance Show CapExpression where

3939 ++ " <= " ++ show (sourceString c)

4040 where

4141 hexDump :: [Word8] -> String

42− hexDump = foldr (\b s -> showHex b s) ""

42+ hexDump = foldr showHex ""

4343

4444instance NFData CapExpression where

4545 rnf (CapExpression ops !_bytes !str !c !pOps)

@@ -99,7 +99,7 @@ parseCapExpression capString =

9999 Left e -> Left e

100100 Right buildResults -> Right $ constructCapExpression capString buildResults

101101

102−constructCapExpression :: [Char] -> BuildResults -> CapExpression

102+constructCapExpression :: String -> BuildResults -> CapExpression

103103constructCapExpression capString buildResults =

104104 let expr = CapExpression

105105 { capOps = outCapOps buildResults

@@ -336,9 +336,9 @@ data BuildResults = BuildResults

336336instance Semigroup BuildResults where

337337 v0 <> v1

338338 = BuildResults

339− { outParamCount = (outParamCount v0) `max` (outParamCount v1)

340− , outCapOps = (outCapOps v0) <> (outCapOps v1)

341− , outParamOps = (outParamOps v0) <> (outParamOps v1)

339+ { outParamCount = outParamCount v0 `max` outParamCount v1

340+ , outCapOps = outCapOps v0 <> outCapOps v1

341+ , outParamOps = outParamOps v0 <> outParamOps v1

342342 }

343343

344344instance Monoid BuildResults where

src/Graphics/Vty/Attributes.hs+8−13

@@ -1,7 +1,4 @@

11{-# LANGUAGE CPP #-}

2−{-# LANGUAGE StandaloneDeriving #-}

3−{-# LANGUAGE GADTs #-}

4−{-# LANGUAGE RankNTypes #-}

52{-# LANGUAGE DeriveGeneric #-}

63{-# LANGUAGE DeriveAnyClass #-}

74

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

4340 , withStyle

4441 , standout

4542 , italic

43+ , strikethrough

4644 , underline

4745 , reverseVideo

4846 , blink

@@ -145,20 +143,14 @@ data FixedAttr = FixedAttr

145143-- | The style and color attributes can either be the terminal defaults.

146144-- Or be equivalent to the previously applied style. Or be a specific

147145-- value.

148−data MaybeDefault v where

149− Default :: MaybeDefault v

150− KeepCurrent :: MaybeDefault v

151− SetTo :: forall v . ( Eq v, Show v, Read v ) => !v -> MaybeDefault v

146+data MaybeDefault v = Default | KeepCurrent | SetTo !v

147+ deriving (Eq, Read, Show)

152148

153149instance (NFData v) => NFData (MaybeDefault v) where

154150 rnf Default = ()

155151 rnf KeepCurrent = ()

156152 rnf (SetTo v) = rnf v

157153

158−deriving instance Eq v => Eq (MaybeDefault v)

159−deriving instance Eq v => Show (MaybeDefault v)

160−deriving instance (Eq v, Show v, Read v) => Read (MaybeDefault v)

161−

162154instance Eq v => Semigroup (MaybeDefault v) where

163155 Default <> Default = Default

164156 Default <> KeepCurrent = Default

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

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

182174type Style = Word8

183175

184−-- | The 7 possible style attributes:

176+-- | Valid style attributes include:

185177--

186178-- * standout

187179--

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

197189--

198190-- * italic

199191--

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

193+--

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

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

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

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

203197standout = 0x01

204198underline = 0x02

205199reverseVideo = 0x04

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

207201dim = 0x10

208202bold = 0x20

209203italic = 0x40

204+strikethrough = 0x80

210205

211206defaultStyleMask :: Style

212207defaultStyleMask = 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/Classify.hs+3−3

@@ -24,7 +24,7 @@ import qualified Data.Set as S( fromList, member )

2424import Data.Char

2525import Data.Word

2626

27−compile :: ClassifyMap -> [Char] -> KClass

27+compile :: ClassifyMap -> String -> KClass

2828compile table = cl' where

2929 -- take all prefixes and create a set of these

3030 prefixSet = S.fromList $ concatMap (init . inits . fst) $ table

@@ -51,7 +51,7 @@ compile table = cl' where

5151 -- neither a prefix or a full event.

5252 [] -> Invalid

5353

54−classify :: ClassifyMap -> [Char] -> KClass

54+classify :: ClassifyMap -> String -> KClass

5555classify table =

5656 let standardClassifier = compile table

5757 in \s -> case s of

@@ -64,7 +64,7 @@ classify table =

6464 c:cs | ord c >= 0xC2 -> classifyUtf8 c cs

6565 _ -> standardClassifier s

6666

67−classifyUtf8 :: Char -> [Char] -> KClass

67+classifyUtf8 :: Char -> String -> KClass

6868classifyUtf8 c cs =

6969 let n = utf8Length (ord c)

7070 (codepoint,rest) = splitAt n (c:cs)

src/Graphics/Vty/Input/Classify/Types.hs+1−1

@@ -8,7 +8,7 @@ where

88import Graphics.Vty.Input.Events

99

1010data KClass

11− = Valid Event [Char]

11+ = Valid Event String

1212 -- ^ A valid event was parsed. Any unused characters from the input

1313 -- stream are also provided.

1414 | Invalid

src/Graphics/Vty/Input/Loop.hs+1−1

@@ -224,7 +224,7 @@ logInitialInputState input classifyTable = case _inputDebug input of

224224 Just h -> do

225225 Config{ vmin = Just theVmin

226226 , vtime = Just theVtime

227− , termName = Just theTerm, .. } <- readIORef $ _configRef input

227+ , termName = Just theTerm } <- readIORef $ _configRef input

228228 _ <- hPrintf h "initial (vmin,vtime): %s\n" (show (theVmin, theVtime))

229229 forM_ classifyTable $ \i -> case i of

230230 (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s %s\n" (show theTerm)

src/Graphics/Vty/Input/Terminfo.hs+5−3

@@ -74,7 +74,7 @@ visibleChars = [ ([x], EvKey (KChar x) [])

7474ctrlChars :: ClassifyMap

7575ctrlChars =

7676 [ ([toEnum x],EvKey (KChar y) [MCtrl])

77− | (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_'])

77+ | (x,y) <- zip [0..31] ('@':['a'..'z']++['['..'_'])

7878 , y /= 'i' -- Resolve issue #3 where CTRL-i hides TAB.

7979 , y /= 'h' -- CTRL-h should not hide BS

8080 ]

@@ -86,8 +86,10 @@ ctrlMetaChars = map (\(s,EvKey c m) -> ('\ESC':s, EvKey c (MMeta:m))) ctrlChars

8686-- | Esc, meta-esc, delete, meta-delete, enter, meta-enter.

8787specialSupportKeys :: ClassifyMap

8888specialSupportKeys =

89− [ -- special support for ESC

90− ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])

89+ [ ("\ESC\ESC[5~",EvKey KPageUp [MMeta])

90+ , ("\ESC\ESC[6~",EvKey KPageDown [MMeta])

91+ -- special support for ESC

92+ , ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])

9193 -- Special support for backspace

9294 , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta])

9395 -- Special support for Enter

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

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

101101 , ringTerminalBell :: IO ()

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

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

104120 }

105121

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

@@ -191,6 +207,12 @@ outputPicture dc pic = do

191207 AbsoluteCursor x y ->

192208 writeShowCursor dc `mappend`

193209 writeMoveCursor dc (clampX x) (clampY y)

210+ PositionOnly isAbs x y ->

211+ if isAbs

212+ then writeMoveCursor dc (clampX x) (clampY y)

213+ else let (ox, oy) = charToOutputPos m (clampX x, clampY y)

214+ m = cursorOutputMap ops $ picCursor pic

215+ in writeMoveCursor dc (clampX ox) (clampY oy)

194216 Cursor x y ->

195217 let m = cursorOutputMap ops $ picCursor pic

196218 (ox, oy) = charToOutputPos m (clampX x, clampY y)

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

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

4848 , releaseDisplay = return ()

4949 , ringTerminalBell = return ()

5050 , supportsBell = return False

51+ , supportsItalics = return False

52+ , supportsStrikethrough = return False

5153 , setDisplayBounds = const $ return ()

5254 , displayBounds = return r

5355 , outputByteBuffer = \bytes -> do

src/Graphics/Vty/Output/TerminfoBased.hs+28−2

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

6868 , exitStandout :: Maybe CapExpression

6969 , enterItalic :: Maybe CapExpression

7070 , exitItalic :: Maybe CapExpression

71+ , enterStrikethrough :: Maybe CapExpression

72+ , exitStrikethrough :: Maybe CapExpression

7173 , enterUnderline :: Maybe CapExpression

7274 , exitUnderline :: Maybe CapExpression

7375 , enterReverseVideo :: Maybe CapExpression

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

166168 sendCap setDefaultAttr []

167169 maybeSendCap cnorm []

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

169175 , ringTerminalBell = maybeSendCap ringBellAudio []

170176 , reserveDisplay = do

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

@@ -203,7 +209,7 @@ reserveTerminal termName outFd = do

203209 , assumedStateRef = newAssumedStateRef

204210 -- I think fix would help assure tActual is the only

205211 -- reference. I was having issues tho.

206− , mkDisplayContext = \tActual -> terminfoDisplayContext tActual terminfoCaps

212+ , mkDisplayContext = (`terminfoDisplayContext` terminfoCaps)

207213 }

208214 sendCap s = sendCapToTerminal t (s terminfoCaps)

209215 maybeSendCap s = when (isJust $ s terminfoCaps) . sendCap (fromJust . s)

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

235241 <*> probeCap ti "rmso"

236242 <*> probeCap ti "sitm"

237243 <*> probeCap ti "ritm"

244+ <*> probeCap ti "smxx"

245+ <*> probeCap ti "rmxx"

238246 <*> probeCap ti "smul"

239247 <*> probeCap ti "rmul"

240248 <*> probeCap ti "rev"

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

270278 , writeSetAttr = terminfoWriteSetAttr dc terminfoCaps

271279 , writeDefaultAttr = \urlsEnabled ->

272280 writeCapExpr (setDefaultAttr terminfoCaps) [] `mappend`

273− (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+ )

274286 , writeRowEnd = writeCapExpr (clearEol terminfoCaps) []

275287 , inlineHack = return ()

276288 }

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

348360 )

349361 (sgrArgsForState state)

350362 `mappend` setItalics

363+ `mappend` setStrikethrough

351364 `mappend` setColors

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

353366 -- between two non-default points.

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

375388 )

376389 (sgrArgsForState state)

377390 `mappend` setItalics

391+ `mappend` setStrikethrough

378392 `mappend` setColors

379393 where

380394 urlAttrs True = writeURLEscapes (urlDiff diffs)

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

392406 , Just sitm <- enterItalic (displayAttrCaps terminfoCaps)

393407 = writeCapExpr sitm []

394408 | otherwise = mempty

409+ setStrikethrough

410+ | hasStyle (fixedStyle attr) strikethrough

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

412+ = writeCapExpr smxx []

413+ | otherwise = mempty

395414 setColors =

396415 (case fixedForeColor attr of

397416 Just c -> writeCapExpr (setForeColor terminfoCaps)

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

460479 { applyStandout :: Bool

461480 , applyUnderline :: Bool

462481 , applyItalic :: Bool

482+ , applyStrikethrough :: Bool

463483 , applyReverseVideo :: Bool

464484 , applyBlink :: Bool

465485 , applyDim :: Bool

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

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

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

498518 where

519+ noEnterExitCap ApplyStrikethrough = isNothing $ enterStrikethrough caps

520+ noEnterExitCap RemoveStrikethrough = isNothing $ exitStrikethrough caps

499521 noEnterExitCap ApplyItalic = isNothing $ enterItalic caps

500522 noEnterExitCap RemoveItalic = isNothing $ exitItalic caps

501523 noEnterExitCap ApplyStandout = isNothing $ enterStandout caps

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

510532 noEnterExitCap RemoveDim = True

511533 noEnterExitCap ApplyBold = isNothing $ enterBoldMode caps

512534 noEnterExitCap RemoveBold = True

535+ enterExitCap ApplyStrikethrough = fromJust $ enterStrikethrough caps

536+ enterExitCap RemoveStrikethrough = fromJust $ exitStrikethrough caps

513537 enterExitCap ApplyItalic = fromJust $ enterItalic caps

514538 enterExitCap RemoveItalic = fromJust $ exitItalic caps

515539 enterExitCap ApplyStandout = fromJust $ enterStandout caps

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

526550 { applyStandout = isStyleSet standout

527551 , applyUnderline = isStyleSet underline

528552 , applyItalic = isStyleSet italic

553+ , applyStrikethrough = isStyleSet strikethrough

529554 , applyReverseVideo = isStyleSet reverseVideo

530555 , applyBlink = isStyleSet blink

531556 , applyDim = isStyleSet dim

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

538563 [ applyIfRequired ApplyStandout standout

539564 , applyIfRequired ApplyUnderline underline

540565 , applyIfRequired ApplyItalic italic

566+ , applyIfRequired ApplyStrikethrough strikethrough

541567 , applyIfRequired ApplyReverseVideo reverseVideo

542568 , applyIfRequired ApplyBlink blink

543569 , applyIfRequired ApplyDim dim

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

@@ -17,6 +17,7 @@ import Blaze.ByteString.Builder.Word (writeWord8)

1717

1818import Control.Monad (void, when)

1919import Control.Monad.Trans

20+import Data.Char (toLower)

2021import Data.IORef

2122

2223import System.Posix.IO (fdWrite)

@@ -92,9 +93,9 @@ reserveTerminal variant outFd = liftIO $ do

9293utf8Active :: IO Bool

9394utf8Active = do

9495 let vars = ["LC_ALL", "LANG", "LC_CTYPE"]

95− results <- catMaybes <$> mapM getEnv vars

96− let matches = filter ("UTF8" `isInfixOf`) results <>

97− filter ("UTF-8" `isInfixOf`) results

96+ results <- map (toLower <$>) . catMaybes <$> mapM getEnv vars

97+ let matches = filter ("utf8" `isInfixOf`) results <>

98+ filter ("utf-8" `isInfixOf`) results

9899 return $ not $ null matches

99100

100101-- | Enable bracketed paste mode:

src/Graphics/Vty/Picture.hs+8

@@ -82,6 +82,14 @@ data Cursor =

8282 NoCursor

8383 -- | Show the cursor at the given logical column accounting for

8484 -- character width in the presence of multi-column characters.

85+ | PositionOnly !Bool !Int !Int

86+ -- | Set the terminal's cursor position without displaying a cursor

87+ -- character. This is important for accessibility with screen

88+ -- readers where a cursor position needs to be reported but we may

89+ -- not want to show a block cursor in that location for cosmetic

90+ -- reasons. The boolean argument indicates whether the positioning

91+ -- should be absolute as with 'AbsoluteCursor' ('True') or logical

92+ -- as with 'Cursor' ('False').

8593 | Cursor !Int !Int

8694 -- | Show the cursor at the given absolute terminal column and row

8795 | AbsoluteCursor !Int !Int

src/Graphics/Vty/PictureToSpans.hs+1−1

@@ -81,7 +81,7 @@ combinedOpsForLayers :: Picture -> DisplayRegion -> ST s (MRowOps s)

8181combinedOpsForLayers pic r

8282 | regionWidth r == 0 || regionHeight r == 0 = MVector.new 0

8383 | otherwise = do

84− layerOps <- mapM (\layer -> buildSpans layer r) (picLayers pic)

84+ layerOps <- mapM (`buildSpans` layer) (picLayers pic)

8585 case layerOps of

8686 [] -> fail "empty picture"

8787 [ops] -> substituteSkips (picBackground pic) ops

vty.cabal+2−2

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

11name: vty

2−version: 5.30

2+version: 5.32

33license: BSD3

44license-file: LICENSE

55author: AUTHORS

@@ -45,7 +45,7 @@ library

4545 deepseq >= 1.1 && < 1.5,

4646 directory,

4747 filepath >= 1.0 && < 2.0,

48− microlens < 0.4.12,

48+ microlens < 0.4.13,

4949 microlens-mtl,

5050 microlens-th,

5151 hashable >= 1.2,