packages feed

vty 5.18.1 → 5.19

raw patch · 22 files changed

+168/−45 lines, 22 files

Files

CHANGELOG.md view
@@ -1,3 +1,11 @@+5.19+API changes:+ - URL hyperlinking (via 'withURL') is now optional and disabled by+   default due to poor support on some common terminals. A new 'Mode'+   constructor, 'Hyperlink', has been added to enable this feature. To+   change the hyperlinking mode, use 'setMode' on the 'outputIface' of a+   Vty handle.+ 5.18.1 Bug fixes:  - Reset the hyperlink state on line endings to avoid run-on hyperlinks
+ dist/build/verify-attribute-opsStub/verify-attribute-opsStub-tmp/verify-attribute-opsStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyAttributeOps ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-crop-span-generationStub/verify-crop-span-generationStub-tmp/verify-crop-span-generationStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyCropSpanGeneration ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-display-attributesStub/verify-display-attributesStub-tmp/verify-display-attributesStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyDisplayAttributes ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-empty-image-propsStub/verify-empty-image-propsStub-tmp/verify-empty-image-propsStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyEmptyImageProps ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-eval-terminfo-capsStub/verify-eval-terminfo-capsStub-tmp/verify-eval-terminfo-capsStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyEvalTerminfoCaps ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-image-opsStub/verify-image-opsStub-tmp/verify-image-opsStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyImageOps ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-image-transStub/verify-image-transStub-tmp/verify-image-transStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyImageTrans ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-inlineStub/verify-inlineStub-tmp/verify-inlineStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyInline ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-layers-span-generationStub/verify-layers-span-generationStub-tmp/verify-layers-span-generationStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyLayersSpanGeneration ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-parse-terminfo-capsStub/verify-parse-terminfo-capsStub-tmp/verify-parse-terminfo-capsStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyParseTerminfoCaps ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-simple-span-generationStub/verify-simple-span-generationStub-tmp/verify-simple-span-generationStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifySimpleSpanGeneration ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-terminalStub/verify-terminalStub-tmp/verify-terminalStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyOutput ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-using-mock-terminalStub/verify-using-mock-terminalStub-tmp/verify-using-mock-terminalStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyUsingMockTerminal ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/verify-utf8-widthStub/verify-utf8-widthStub-tmp/verify-utf8-widthStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import VerifyUtf8Width ( tests )+main :: IO ()+main = stubMain tests
src/Graphics/Vty/Attributes.hs view
@@ -215,8 +215,12 @@ -- 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.+-- that don't know about these sequences will ignore these sequences,+-- and therefore this should fall back sensibly. In some cases they+-- won't and this will result in garbage, so this is why hyperlinking is+-- disabled by default, in which case this combinator has no observable+-- effect. To enable it, enable 'Hyperlink' mode on your Vty output+-- interface. withURL :: Attr -> Text -> Attr withURL attr url = attr { attrURL = SetTo url }
src/Graphics/Vty/Inline.hs view
@@ -48,22 +48,33 @@  import System.IO -type InlineM v = State Attr v+type InlineM v = State InlineState v +data InlineState =+    InlineState { inlineAttr :: Attr+                , inlineUrlsEnabled :: Bool+                }+ -- | Set the background color to the provided 'Color'. backColor :: Color -> InlineM ()-backColor c = modify $ flip mappend ( currentAttr `withBackColor` c )+backColor c = modify $ \s ->+    s { inlineAttr = inlineAttr s `mappend` (currentAttr `withBackColor` c)+      }  -- | Set the foreground color to the provided 'Color'. foreColor :: Color -> InlineM ()-foreColor c = modify $ flip mappend ( currentAttr `withForeColor` c )+foreColor c = modify $ \s ->+    s { inlineAttr = inlineAttr s `mappend` (currentAttr `withForeColor` c)+      }  -- | Attempt to change the 'Style' of the following text.. -- -- If the terminal does not support the style change then no error is -- produced. The style can still be removed. applyStyle :: Style -> InlineM ()-applyStyle s = modify $ flip mappend ( currentAttr `withStyle` s )+applyStyle st = modify $ \s ->+    s { inlineAttr = inlineAttr s `mappend` (currentAttr `withStyle` st)+      }  -- | Attempt to remove the specified 'Style' from the display of the -- following text.@@ -71,16 +82,18 @@ -- This will fail if 'applyStyle' for the given style has not been -- previously called. removeStyle :: Style -> InlineM ()-removeStyle sMask = modify $ \attr ->-    let style' = case attrStyle attr of-                    Default -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."-                    KeepCurrent -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."-                    SetTo s -> s .&. complement sMask-    in attr { attrStyle = SetTo style' }+removeStyle sMask = modify $ \s ->+    s { inlineAttr =+          let style' = case attrStyle (inlineAttr s) of+                Default -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."+                KeepCurrent -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."+                SetTo st -> st .&. complement sMask+          in (inlineAttr s) { attrStyle = SetTo style' }+      }  -- | Reset the display attributes. defaultAll :: InlineM ()-defaultAll = put defAttr+defaultAll = modify $ \s -> s { inlineAttr = defAttr }  -- | Apply the provided display attribute changes to the given terminal -- output device.@@ -93,14 +106,14 @@     mfattr <- prevFattr <$> readIORef (assumedStateRef out)     fattr <- case mfattr of                 Nothing -> do-                    liftIO $ outputByteBuffer out $ writeToByteString $ writeDefaultAttr dc+                    liftIO $ outputByteBuffer out $ writeToByteString $ writeDefaultAttr dc False                     return $ FixedAttr defaultStyleMask Nothing Nothing Nothing                 Just v -> return v-    let attr = execState c currentAttr+    let InlineState attr urlsEnabled = execState c (InlineState currentAttr False)         attr' = limitAttrForDisplay out attr         fattr' = fixDisplayAttr fattr attr'         diffs = displayAttrDiffs fattr fattr'-    outputByteBuffer out $ writeToByteString $ writeSetAttr dc fattr attr' diffs+    outputByteBuffer out $ writeToByteString $ writeSetAttr dc urlsEnabled fattr attr' diffs     modifyIORef (assumedStateRef out) $ \s -> s { prevFattr = Just fattr' }     inlineHack dc
src/Graphics/Vty/Output/Interface.hs view
@@ -47,6 +47,12 @@           | Focus           -- ^ Focus-in/focus-out events (whether the terminal is           -- configured to provide events on focus change)+          | Hyperlink+          -- ^ Hyperlink mode via the 'withURL' attribute modifier (see+          -- https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda).+          -- Note that this may not work gracefully in all terminal+          -- emulators so be sure to test this mode with the terminals+          -- you intend to support. It is off by default.           deriving (Eq, Read, Show)  -- | The Vty terminal output interface.@@ -133,9 +139,9 @@     -- to support this the currently applied display attributes are     -- required. In addition it may be possible to optimize the state     -- changes based off the currently applied display attributes.-    , writeSetAttr :: FixedAttr -> Attr -> DisplayAttrDiff -> Write+    , writeSetAttr :: Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write     -- | Reset the display attributes to the default display attributes.-    , writeDefaultAttr :: Write+    , writeDefaultAttr :: Bool -> Write     , writeRowEnd :: Write     -- | See `Graphics.Vty.Output.XTermColor.inlineHack`     , inlineHack :: IO ()@@ -159,6 +165,7 @@ --      5. The cursor is then shown and positioned or kept hidden. outputPicture :: MonadIO m => DisplayContext -> Picture -> m () outputPicture dc pic = liftIO $ do+    urlsEnabled <- getModeStatus (contextDevice dc) Hyperlink     as <- readIORef (assumedStateRef $ contextDevice dc)     let manipCursor = supportsCursorVisibility (contextDevice dc)         r = contextRegion dc@@ -174,7 +181,7 @@                                   (Vector.toList ops)         -- build the Write corresponding to the output image         out = (if manipCursor then writeHideCursor dc else mempty)-              `mappend` writeOutputOps dc initialAttr diffs ops+              `mappend` writeOutputOps urlsEnabled dc initialAttr diffs ops               `mappend`                 (let (w,h) = contextRegion dc                      clampX = max 0 . min (w-1)@@ -197,15 +204,15 @@     let as' = as { prevOutputOps = Just ops }     writeIORef (assumedStateRef $ contextDevice dc) as' -writeOutputOps :: DisplayContext -> FixedAttr -> [Bool] -> DisplayOps -> Write-writeOutputOps dc initialAttr diffs ops =+writeOutputOps :: Bool -> DisplayContext -> FixedAttr -> [Bool] -> DisplayOps -> Write+writeOutputOps urlsEnabled dc initialAttr diffs ops =     let (_, out, _) = Vector.foldl' writeOutputOps'                                        (0, mempty, diffs)                                        ops     in out     where         writeOutputOps' (y, out, True : diffs') spanOps-            = let spanOut = writeSpanOps dc y initialAttr spanOps+            = let spanOut = writeSpanOps urlsEnabled dc y initialAttr spanOps                   out' = out `mappend` spanOut               in (y+1, out', diffs')         writeOutputOps' (y, out, False : diffs') _spanOps@@ -213,27 +220,27 @@         writeOutputOps' (_y, _out, []) _spanOps             = error "vty - output spans without a corresponding diff." -writeSpanOps :: DisplayContext -> Int -> FixedAttr -> SpanOps -> Write-writeSpanOps dc y initialAttr spanOps =+writeSpanOps :: Bool -> DisplayContext -> Int -> FixedAttr -> SpanOps -> Write+writeSpanOps urlsEnabled dc y initialAttr spanOps =     -- The first operation is to set the cursor to the start of the row-    let start = writeMoveCursor dc 0 y `mappend` writeDefaultAttr dc+    let start = writeMoveCursor dc 0 y `mappend` writeDefaultAttr dc urlsEnabled     -- then the span ops are serialized in the order specified-    in fst $ Vector.foldl' (\(out, fattr) op -> case writeSpanOp dc op fattr of+    in fst $ Vector.foldl' (\(out, fattr) op -> case writeSpanOp urlsEnabled dc op fattr of                               (opOut, fattr') -> (out `mappend` opOut, fattr')                            )                            (start, initialAttr)                            spanOps -writeSpanOp :: DisplayContext -> SpanOp -> FixedAttr -> (Write, FixedAttr)-writeSpanOp dc (TextSpan attr _ _ str) fattr =+writeSpanOp :: Bool -> DisplayContext -> SpanOp -> FixedAttr -> (Write, FixedAttr)+writeSpanOp urlsEnabled dc (TextSpan attr _ _ str) fattr =     let attr' = limitAttrForDisplay (contextDevice dc) attr         fattr' = fixDisplayAttr fattr attr'         diffs = displayAttrDiffs fattr fattr'-        out =  writeSetAttr dc fattr attr' diffs+        out =  writeSetAttr dc urlsEnabled fattr attr' diffs                `mappend` writeUtf8Text (T.encodeUtf8 $ TL.toStrict str)     in (out, fattr')-writeSpanOp _dc (Skip _) _fattr = error "writeSpanOp for Skip"-writeSpanOp dc (RowEnd _) fattr = (writeDefaultAttr dc `mappend` writeRowEnd dc, fattr)+writeSpanOp _ _ (Skip _) _fattr = error "writeSpanOp for Skip"+writeSpanOp urlsEnabled dc (RowEnd _) fattr = (writeDefaultAttr dc urlsEnabled `mappend` writeRowEnd dc, fattr)  -- | The cursor position is given in X,Y character offsets. Due to -- multi-column characters this needs to be translated to column, row
src/Graphics/Vty/Output/Mock.hs view
@@ -72,10 +72,10 @@                 , writeHideCursor = writeWord8 $ toEnum $ fromEnum 'H'                 -- An attr change is always visualized as the single                 -- character 'A'-                , writeSetAttr = \_fattr _diffs _attr -> writeWord8 $ toEnum $ fromEnum 'A'+                , writeSetAttr = \_ _fattr _diffs _attr -> writeWord8 $ toEnum $ fromEnum 'A'                 -- default attr is always visualized as the single                 -- character 'D'-                , writeDefaultAttr = writeWord8 $ toEnum $ fromEnum 'D'+                , writeDefaultAttr = const $ writeWord8 $ toEnum $ fromEnum 'D'                 -- row end is always visualized as the single character                 -- 'E'                 , writeRowEnd = writeWord8 $ toEnum $ fromEnum 'E'
src/Graphics/Vty/Output/TerminfoBased.hs view
@@ -120,6 +120,25 @@                     Just setb -> setb                     Nothing -> error $ "no back color support for terminal " ++ termName                 Just setab -> setab++    hyperlinkModeStatus <- newIORef False+    newAssumedStateRef <- newIORef initialAssumedState++    let terminfoSetMode m newStatus = do+          curStatus <- terminfoModeStatus m+          when (newStatus /= curStatus) $+              case m of+                  Hyperlink -> liftIO $ do+                      writeIORef hyperlinkModeStatus newStatus+                      writeIORef newAssumedStateRef initialAssumedState+                  _ -> return ()+        terminfoModeStatus m =+            case m of+                Hyperlink -> liftIO $ readIORef hyperlinkModeStatus+                _ -> return False+        terminfoModeSupported Hyperlink = True+        terminfoModeSupported _ = False+     terminfoCaps <- pure TerminfoCaps         <*> probeCap ti "smcup"         <*> probeCap ti "rmcup"@@ -135,7 +154,6 @@         <*> requireCap ti "el"         <*> currentDisplayAttrCaps ti         <*> probeCap ti "bel"-    newAssumedStateRef <- newIORef initialAssumedState     let t = Output             { terminalID = termName             , releaseTerminal = liftIO $ do@@ -171,9 +189,9 @@                         Just v -> toEnum v                     True -> 1             , supportsCursorVisibility = isJust $ civis terminfoCaps-            , supportsMode = const False-            , setMode = const $ const $ return ()-            , getModeStatus = const $ return False+            , supportsMode = terminfoModeSupported+            , setMode = terminfoSetMode+            , getModeStatus = terminfoModeStatus             , assumedStateRef = newAssumedStateRef             -- I think fix would help assure tActual is the only             -- reference. I was having issues tho.@@ -235,9 +253,9 @@                 Nothing -> error "this terminal does not support hide cursor"                 Just c -> writeCapExpr c []             , writeSetAttr = terminfoWriteSetAttr dc terminfoCaps-            , writeDefaultAttr =+            , writeDefaultAttr = \urlsEnabled ->                 writeCapExpr (setDefaultAttr terminfoCaps) [] `mappend`-                writeURLEscapes EndLink+                (if urlsEnabled then writeURLEscapes EndLink else mempty)             , writeRowEnd = writeCapExpr (clearEol terminfoCaps) []             , inlineHack = return ()             }@@ -292,9 +310,9 @@ -- -- Note that this optimizes for fewer state changes followed by fewer -- bytes.-terminfoWriteSetAttr :: DisplayContext -> TerminfoCaps -> FixedAttr -> Attr -> DisplayAttrDiff -> Write-terminfoWriteSetAttr dc terminfoCaps prevAttr reqAttr diffs = do-    urlAttrs `mappend` case (foreColorDiff diffs == ColorToDefault) || (backColorDiff diffs == ColorToDefault) of+terminfoWriteSetAttr :: DisplayContext -> TerminfoCaps -> Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write+terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs = do+    urlAttrs urlsEnabled `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.@@ -303,7 +321,7 @@                                      (fixedStyle attr )                                      (styleToApplySeq $ fixedStyle attr) of                 -- only way to reset a color to the defaults-                EnterExitSeq caps -> writeDefaultAttr dc+                EnterExitSeq caps -> writeDefaultAttr dc urlsEnabled                                      `mappend`                                      foldMap (\cap -> writeCapExpr cap []) caps                                      `mappend`@@ -343,7 +361,8 @@                                                (sgrArgsForState state)                                   `mappend` setColors     where-        urlAttrs = writeURLEscapes (urlDiff diffs)+        urlAttrs True = writeURLEscapes (urlDiff diffs)+        urlAttrs False = mempty         colorMap = case useAltColorMap terminfoCaps of                         False -> ansiColorIndex                         True -> altColorIndex
src/Graphics/Vty/Output/XTermColor.hs view
@@ -61,10 +61,12 @@                           True -> flushedPut enableBracketedPastes                           False -> flushedPut disableBracketedPastes                       writeIORef pasteModeStatus newStatus+                  Hyperlink -> setMode t Hyperlink newStatus          xtermGetMode Mouse = liftIO $ readIORef mouseModeStatus         xtermGetMode Focus = liftIO $ readIORef focusModeStatus         xtermGetMode BracketedPaste = liftIO $ readIORef pasteModeStatus+        xtermGetMode Hyperlink = getModeStatus t Hyperlink      let t' = t              { terminalID = terminalID t ++ " (xterm-color)"
vty.cabal view
@@ -1,5 +1,5 @@ name:                vty-version:             5.18.1+version:             5.19 license:             BSD3 license-file:        LICENSE author:              AUTHORS