vty 5.17.1 → 5.18

raw patch · 7 files changed

+79/−10 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• src/Graphics/Vty/Attributes.hs +20/−3
• src/Graphics/Vty/DisplayAttributes.hs +30/−2
• src/Graphics/Vty/Inline.hs +1/−1
• src/Graphics/Vty/Output/Interface.hs +1/−1
• src/Graphics/Vty/Output/TerminfoBased.hs +20/−2
• vty.cabal +1/−1

@@ -1,3 +1,9 @@+5.18+API changes:+ - Added support for hyperlinking attributes (thanks Getty Ritter). This+   change adds a new Attr field for containing the hyperlink to apply,+   as per https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda+ 5.17.1  - withStyle now ignores zero arguments, leaving attribute styles    untouched if the input style is the null style

@@ -50,6 +50,9 @@   , withForeColor   , withBackColor +  -- * Setting hyperlinks+  , withURL+   -- * Colors   , module Graphics.Vty.Attributes.Color   , module Graphics.Vty.Attributes.Color240@@ -57,6 +60,7 @@ where  import Data.Bits+import Data.Text (Text) import Data.Word  import Graphics.Vty.Attributes.Color@@ -73,6 +77,7 @@     { attrStyle :: !(MaybeDefault Style)     , attrForeColor :: !(MaybeDefault Color)     , attrBackColor :: !(MaybeDefault Color)+    , attrURL :: !(MaybeDefault Text)     } deriving ( Eq, Show, Read )  -- This could be encoded into a single 32 bit word. The 32 bit word is@@ -107,11 +112,12 @@ --  Then the background color encoded into 8 bits.  instance Monoid Attr where-    mempty = Attr mempty mempty mempty+    mempty = Attr mempty mempty mempty mempty     mappend attr0 attr1 =         Attr ( attrStyle attr0     `mappend` attrStyle attr1 )              ( attrForeColor attr0 `mappend` attrForeColor attr1 )              ( attrBackColor attr0 `mappend` attrBackColor attr1 )+             ( attrURL attr0       `mappend` attrURL attr1 )  -- | Specifies the display attributes such that the final style and -- color values do not depend on the previously applied display@@ -121,6 +127,7 @@     { fixedStyle :: !Style     , fixedForeColor :: !(Maybe Color)     , fixedBackColor :: !(Maybe Color)+    , fixedURL       :: !(Maybe Text)     } deriving ( Eq, Show )  -- | The style and color attributes can either be the terminal defaults.@@ -203,11 +210,21 @@ withStyle attr 0 = attr withStyle attr styleFlag = attr { attrStyle = SetTo $ styleMask attr .|. styleFlag } +-- | Add a hyperlinked URL using the proposed [escape sequences for+-- hyperlinked+-- URLs](https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda).+-- These escape sequences are comparatively new and aren't widely+-- supported in terminal emulators yet, but most terminal emulators+-- that don't know about these sequences will ignore these+-- sequences, and therefore this should fall back sensibly.+withURL :: Attr -> Text -> Attr+withURL attr url = attr { attrURL = SetTo url }+ -- | Sets the style, background color and foreground color to the -- default values for the terminal. There is no easy way to determine -- what the default background and foreground colors are. defAttr :: Attr-defAttr = Attr Default Default Default+defAttr = Attr Default Default Default Default  -- | Keeps the style, background color and foreground color that was -- previously set. Used to override some part of the previous style.@@ -217,4 +234,4 @@ -- Would be the currently applied style (be it underline, bold, etc) but -- with the foreground color set to brightMagenta. currentAttr :: Attr-currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent+currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent KeepCurrent

@@ -6,6 +6,9 @@ import Graphics.Vty.Attributes  import Data.Bits ((.&.))+import Data.ByteString (ByteString)+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)  -- | Given the previously applied display attributes as a FixedAttr and -- the current display attributes as an Attr produces a FixedAttr that@@ -17,6 +20,7 @@     = FixedAttr (fixStyle (fixedStyle fattr)     (attrStyle attr))                 (fixColor (fixedForeColor fattr) (attrForeColor attr))                 (fixColor (fixedBackColor fattr) (attrBackColor attr))+                (fixURL   (fixedURL fattr)       (attrURL attr))     where         fixStyle _s Default           = defaultStyleMask         fixStyle s KeepCurrent        = s@@ -24,6 +28,9 @@         fixColor _c Default           = Nothing         fixColor c KeepCurrent        = c         fixColor _c (SetTo c)         = Just c+        fixURL c KeepCurrent          = c+        fixURL _c (SetTo n)           = Just n+        fixURL _c Default             = Nothing  -- | difference between two display attributes. Used in the calculation -- of the operations required to go from one display attribute to the@@ -36,16 +43,18 @@     { styleDiffs    :: [StyleStateChange]     , foreColorDiff :: DisplayColorDiff     , backColorDiff :: DisplayColorDiff+    , urlDiff       :: URLDiff     }     deriving (Show)  instance Monoid DisplayAttrDiff where-    mempty = DisplayAttrDiff [] NoColorChange NoColorChange+    mempty = DisplayAttrDiff [] NoColorChange NoColorChange NoLinkChange     mappend d0 d1 =         let ds  = simplifyStyleDiffs (styleDiffs d0)    (styleDiffs d1)             fcd = simplifyColorDiffs (foreColorDiff d0) (foreColorDiff d1)             bcd = simplifyColorDiffs (backColorDiff d0) (backColorDiff d1)-        in DisplayAttrDiff ds fcd bcd+            ud  = simplifyUrlDiffs (urlDiff d0) (urlDiff d1)+        in DisplayAttrDiff ds fcd bcd ud  -- | Used in the computation of a final style attribute change. simplifyStyleDiffs :: [StyleStateChange] -> [StyleStateChange] -> [StyleStateChange]@@ -58,6 +67,12 @@ simplifyColorDiffs cd              NoColorChange  = cd simplifyColorDiffs _cd             (SetColor !c)  = SetColor c +-- | Consider two URL changes, which are mostly going to be the latter+-- unless the latter specifies no change.+simplifyUrlDiffs :: URLDiff -> URLDiff -> URLDiff+simplifyUrlDiffs ud NoLinkChange = ud+simplifyUrlDiffs _ ud = ud+ -- | Difference between two display color attribute changes. data DisplayColorDiff     = ColorToDefault@@ -82,6 +97,13 @@     | RemoveBold     deriving (Show, Eq) +-- Setting and unsetting hyperlinks+data URLDiff+    = LinkTo !ByteString+    | NoLinkChange+    | EndLink+    deriving (Show, Eq)+ -- | Determines the diff between two display&color attributes. This diff -- determines the operations that actually get output to the terminal. displayAttrDiffs :: FixedAttr -> FixedAttr -> DisplayAttrDiff@@ -89,7 +111,13 @@     { styleDiffs    = diffStyles (fixedStyle attr)      (fixedStyle attr')     , foreColorDiff = diffColor  (fixedForeColor attr) (fixedForeColor attr')     , backColorDiff = diffColor  (fixedBackColor attr) (fixedBackColor attr')+    , urlDiff       = diffURL    (fixedURL attr)       (fixedURL attr')     }++diffURL :: Maybe Text -> Maybe Text -> URLDiff+diffURL Nothing Nothing = NoLinkChange+diffURL (Just _) Nothing = EndLink+diffURL _ (Just url) = LinkTo (encodeUtf8 url)  diffColor :: Maybe Color -> Maybe Color -> DisplayColorDiff diffColor Nothing  (Just c') = SetColor c'

@@ -94,7 +94,7 @@     fattr <- case mfattr of                 Nothing -> do                     liftIO $ outputByteBuffer out $ writeToByteString $ writeDefaultAttr dc-                    return $ FixedAttr defaultStyleMask Nothing Nothing+                    return $ FixedAttr defaultStyleMask Nothing Nothing Nothing                 Just v -> return v     let attr = execState c currentAttr         attr' = limitAttrForDisplay out attr

@@ -163,7 +163,7 @@     let manipCursor = supportsCursorVisibility (contextDevice dc)         r = contextRegion dc         ops = displayOpsForPic pic r-        initialAttr = FixedAttr defaultStyleMask Nothing Nothing+        initialAttr = FixedAttr defaultStyleMask Nothing Nothing Nothing         -- Diff the previous output against the requested output.         -- Differences are currently on a per-row basis.         diffs :: [Bool] = case prevOutputOps as of

@@ -1,5 +1,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -D_XOPEN_SOURCE=500 -fno-warn-warnings-deprecations #-} {-# CFILES gwinsz.c #-} @@ -12,6 +13,7 @@ where  import Control.Monad (when)+import qualified Data.ByteString as BS import Data.ByteString.Internal (toForeignPtr) import Data.Terminfo.Parse import Data.Terminfo.Eval@@ -21,11 +23,12 @@ import Graphics.Vty.DisplayAttributes import Graphics.Vty.Output.Interface -import Blaze.ByteString.Builder (Write, writeToByteString)+import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable)  import Control.Monad.Trans  import Data.Bits ((.&.))+import Data.Foldable (foldMap) import Data.IORef import Data.Maybe (isJust, isNothing, fromJust) import Data.Word@@ -237,6 +240,20 @@             , inlineHack = return ()             } +-- | Write the escape sequences that are used in some terminals to+-- include embedded hyperlinks. As of yet, this information isn't+-- included in termcap or terminfo, so this writes them directly+-- instead of looking up the appropriate capabilities.+writeURLEscapes :: URLDiff -> Write+writeURLEscapes (LinkTo url) =+    foldMap writeStorable (BS.unpack "\x1b]8;;") `mappend`+    foldMap writeStorable (BS.unpack url) `mappend`+    writeStorable (0x07 :: Word8)+writeURLEscapes EndLink =+    foldMap writeStorable (BS.unpack "\x1b]8;;\a")+writeURLEscapes NoLinkChange =+    mempty+ -- | Portably setting the display attributes is a giant pain in the ass. -- -- If the terminal supports the sgr capability (which sets the on/off@@ -275,7 +292,7 @@ -- bytes. terminfoWriteSetAttr :: DisplayContext -> TerminfoCaps -> FixedAttr -> Attr -> DisplayAttrDiff -> Write terminfoWriteSetAttr dc terminfoCaps prevAttr reqAttr diffs = do-    case (foreColorDiff diffs == ColorToDefault) || (backColorDiff diffs == ColorToDefault) of+    urlAttrs `mappend` case (foreColorDiff diffs == ColorToDefault) || (backColorDiff diffs == ColorToDefault) of         -- The only way to reset either color, portably, to the default         -- is to use either the set state capability or the set default         -- capability.@@ -324,6 +341,7 @@                                                (sgrArgsForState state)                                   `mappend` setColors     where+        urlAttrs = writeURLEscapes (urlDiff diffs)         colorMap = case useAltColorMap terminfoCaps of                         False -> ansiColorIndex                         True -> altColorIndex

@@ -1,5 +1,5 @@ name:                vty-version:             5.17.1+version:             5.18 license:             BSD3 license-file:        LICENSE author:              AUTHORS