Add hyperlink combinator, update attribute demo

This commit is contained in:
Jonathan Daugherty 2017-10-06 13:27:41 -07:00
parent d4cb0fa63b
commit dbebb512e9
3 changed files with 34 additions and 19 deletions

View File

@ -81,7 +81,7 @@ library
Brick.Widgets.Internal
build-depends: base <= 5,
vty >= 5.15,
vty >= 5.18,
transformers,
data-clist >= 0.1,
dlist,
@ -133,7 +133,7 @@ executable brick-cache-demo
main-is: CacheDemo.hs
build-depends: base,
brick,
vty >= 5.15,
vty >= 5.18,
text,
microlens >= 0.3.0.0,
microlens-th
@ -147,7 +147,7 @@ executable brick-visibility-demo
main-is: VisibilityDemo.hs
build-depends: base,
brick,
vty >= 5.15,
vty >= 5.18,
text,
microlens >= 0.3.0.0,
microlens-th
@ -162,7 +162,7 @@ executable brick-viewport-scroll-demo
main-is: ViewportScrollDemo.hs
build-depends: base,
brick,
vty >= 5.15,
vty >= 5.18,
text,
microlens
@ -175,7 +175,7 @@ executable brick-dialog-demo
main-is: DialogDemo.hs
build-depends: base <= 5,
brick,
vty >= 5.15,
vty >= 5.18,
text,
microlens
@ -188,7 +188,7 @@ executable brick-mouse-demo
main-is: MouseDemo.hs
build-depends: base <= 5,
brick,
vty >= 5.15,
vty >= 5.18,
text,
microlens >= 0.3.0.0,
microlens-th,
@ -203,7 +203,7 @@ executable brick-layer-demo
main-is: LayerDemo.hs
build-depends: base <= 5,
brick,
vty >= 5.15,
vty >= 5.18,
text,
microlens >= 0.3.0.0,
microlens-th
@ -217,7 +217,7 @@ executable brick-suspend-resume-demo
main-is: SuspendAndResumeDemo.hs
build-depends: base <= 5,
brick,
vty >= 5.15,
vty >= 5.18,
text,
microlens >= 0.3.0.0,
microlens-th
@ -231,7 +231,7 @@ executable brick-padding-demo
main-is: PaddingDemo.hs
build-depends: base <= 5,
brick,
vty >= 5.15,
vty >= 5.18,
text,
microlens
@ -244,7 +244,7 @@ executable brick-attr-demo
main-is: AttrDemo.hs
build-depends: base <= 5,
brick,
vty >= 5.15,
vty >= 5.18,
text,
microlens
@ -257,7 +257,7 @@ executable brick-markup-demo
main-is: MarkupDemo.hs
build-depends: base <= 5,
brick,
vty >= 5.15,
vty >= 5.18,
text,
microlens
@ -270,7 +270,7 @@ executable brick-list-demo
main-is: ListDemo.hs
build-depends: base <= 5,
brick,
vty >= 5.15,
vty >= 5.18,
text,
microlens >= 0.3.0.0,
vector
@ -284,7 +284,7 @@ executable brick-list-vi-demo
main-is: ListViDemo.hs
build-depends: base <= 5,
brick,
vty >= 5.15,
vty >= 5.18,
text,
microlens >= 0.3.0.0,
vector
@ -298,7 +298,7 @@ executable brick-custom-event-demo
main-is: CustomEventDemo.hs
build-depends: base <= 5,
brick,
vty >= 5.15,
vty >= 5.18,
text,
microlens >= 0.3.0.0,
microlens-th
@ -312,7 +312,7 @@ executable brick-fill-demo
main-is: FillDemo.hs
build-depends: base <= 5,
brick,
vty >= 5.15,
vty >= 5.18,
text,
microlens
@ -325,7 +325,7 @@ executable brick-hello-world-demo
main-is: HelloWorldDemo.hs
build-depends: base <= 5,
brick,
vty >= 5.15,
vty >= 5.18,
text,
microlens
@ -338,7 +338,7 @@ executable brick-edit-demo
main-is: EditDemo.hs
build-depends: base <= 5,
brick,
vty >= 5.15,
vty >= 5.18,
text,
vector,
microlens >= 0.3.0.0,
@ -354,7 +354,7 @@ executable brick-border-demo
main-is: BorderDemo.hs
build-depends: base <= 5,
brick,
vty >= 5.15,
vty >= 5.18,
text,
microlens
@ -368,6 +368,6 @@ executable brick-progressbar-demo
main-is: ProgressBarDemo.hs
build-depends: base <= 5,
brick,
vty >= 5.15,
vty >= 5.18,
text,
microlens

View File

@ -16,6 +16,7 @@ import Brick.Widgets.Core
, withAttr
, vBox
, str
, hyperlink
)
import Brick.Util (on, fg)
import Brick.AttrMap (attrMap, AttrMap)
@ -41,6 +42,9 @@ ui =
, str " "
, withAttr "linked" $
str "This text is hyperlinked in terminals that support hyperlinking."
, str " "
, hyperlink "http://www.google.com/" $
str "This text is also hyperlinked in terminals that support hyperlinking."
]
globalDefault :: Attr

View File

@ -18,6 +18,7 @@ module Brick.Widgets.Core
, strWrap
, strWrapWith
, fill
, hyperlink
-- * Padding
, padLeft
@ -265,6 +266,16 @@ str s =
txt :: T.Text -> Widget n
txt = str . T.unpack
-- | Hyperlink the given widget to the specified URL. Not all terminal
-- emulators support this. In those that don't, this should have no
-- discernible effect.
hyperlink :: T.Text -> Widget n -> Widget n
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)
-- | Pad the specified widget on the left. If max padding is used, this
-- grows greedily horizontally; otherwise it defers to the padded
-- widget.