diff --git a/programs/AttrDemo.hs b/programs/AttrDemo.hs index 80acdb1..2e2d635 100644 --- a/programs/AttrDemo.hs +++ b/programs/AttrDemo.hs @@ -17,6 +17,7 @@ import Brick.Widgets.Core , vBox , str , hyperlink + , modifyDefAttr ) import Brick.Util (on, fg) import Brick.AttrMap (attrMap, AttrMap) @@ -45,6 +46,9 @@ ui = , str " " , hyperlink "http://www.google.com/" $ str "This text is also hyperlinked in terminals that support hyperlinking." + , str " " + , modifyDefAttr (`withURL` "http://www.google.com/") $ + str "This text is hyperlinked by modifying the default attribute." ] globalDefault :: Attr diff --git a/src/Brick/AttrMap.hs b/src/Brick/AttrMap.hs index d9e4d21..5e56fd5 100644 --- a/src/Brick/AttrMap.hs +++ b/src/Brick/AttrMap.hs @@ -32,7 +32,8 @@ module Brick.AttrMap -- * Finding attributes from names , attrMapLookup -- * Manipulating attribute maps - , setDefault + , setDefaultAttr + , getDefaultAttr , applyAttrMappings , mergeWithDefault , mapAttrName @@ -145,9 +146,14 @@ attrMapLookup (AttrName ns) (AttrMap theDefault m) = in foldl combineAttrs theDefault results -- | Set the default attribute value in an attribute map. -setDefault :: Attr -> AttrMap -> AttrMap -setDefault _ (ForceAttr a) = ForceAttr a -setDefault newDefault (AttrMap _ m) = AttrMap newDefault m +setDefaultAttr :: Attr -> AttrMap -> AttrMap +setDefaultAttr _ (ForceAttr a) = ForceAttr a +setDefaultAttr newDefault (AttrMap _ m) = AttrMap newDefault m + +-- | Get the default attribute value in an attribute map. +getDefaultAttr :: AttrMap -> Attr +getDefaultAttr (ForceAttr a) = a +getDefaultAttr (AttrMap d _) = d combineAttrs :: Attr -> Attr -> Attr combineAttrs (Attr s1 f1 b1 u1) (Attr s2 f2 b2 u2) = diff --git a/src/Brick/Widgets/Core.hs b/src/Brick/Widgets/Core.hs index 8c9484b..7cbc9af 100644 --- a/src/Brick/Widgets/Core.hs +++ b/src/Brick/Widgets/Core.hs @@ -42,6 +42,7 @@ module Brick.Widgets.Core -- * Attribute management , withDefAttr + , modifyDefAttr , withAttr , forceAttr , overrideAttr @@ -274,7 +275,7 @@ hyperlink url p = Widget (hSize p) (vSize p) $ do c <- getContext let attr = attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL) `V.withURL` url - withReaderT (& ctxAttrMapL %~ setDefault attr) (render p) + withReaderT (& ctxAttrMapL %~ setDefaultAttr attr) (render p) -- | Pad the specified widget on the left. If max padding is used, this -- grows greedily horizontally; otherwise it defers to the padded @@ -586,6 +587,16 @@ withAttr an p = Widget (hSize p) (vSize p) $ withReaderT (& ctxAttrNameL .~ an) (render p) +-- | Update the attribute map while rendering the specified widget: set +-- its new default attribute to the one that we get by looking up the +-- specified attribute name in the map and then modifying it with the +-- specified function. +modifyDefAttr :: (V.Attr -> V.Attr) -> Widget n -> Widget n +modifyDefAttr f p = + Widget (hSize p) (vSize p) $ do + c <- getContext + withReaderT (& ctxAttrMapL %~ (setDefaultAttr (f $ getDefaultAttr (c^.ctxAttrMapL)))) (render p) + -- | Update the attribute map while rendering the specified widget: set -- its new default attribute to the one that we get by looking up the -- specified attribute name in the map. @@ -593,7 +604,7 @@ withDefAttr :: AttrName -> Widget n -> Widget n withDefAttr an p = Widget (hSize p) (vSize p) $ do c <- getContext - withReaderT (& ctxAttrMapL %~ (setDefault (attrMapLookup an (c^.ctxAttrMapL)))) (render p) + withReaderT (& ctxAttrMapL %~ (setDefaultAttr (attrMapLookup an (c^.ctxAttrMapL)))) (render p) -- | When rendering the specified widget, update the attribute map with -- the specified transformation.