diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,17 @@ Brick changelog --------------- +0.26 +---- + +API changes: + * Added Brick.Widgets.List.handleListEventVi to add support for + vi-style movements to lists (thanks Richard Alex Hofer) + +Other changes: + * Added ListViDemo.hs to demonstrate the Vi-style handler for lists + (thanks Richard Alex Hofer) + 0.25 ---- diff --git a/brick.cabal b/brick.cabal --- a/brick.cabal +++ b/brick.cabal @@ -1,5 +1,5 @@ name: brick -version: 0.25 +version: 0.26 synopsis: A declarative terminal user interface library description: Write terminal applications painlessly with 'brick'! You write an @@ -268,6 +268,20 @@ ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-language: Haskell2010 main-is: ListDemo.hs + build-depends: base <= 5, + brick, + vty >= 5.15, + text, + microlens >= 0.3.0.0, + vector + +executable brick-list-vi-demo + if !flag(demos) + Buildable: False + hs-source-dirs: programs + ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 + default-language: Haskell2010 + main-is: ListViDemo.hs build-depends: base <= 5, brick, vty >= 5.15, diff --git a/programs/ListViDemo.hs b/programs/ListViDemo.hs new file mode 100644 --- /dev/null +++ b/programs/ListViDemo.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Control.Monad (void) +import Data.Maybe (fromMaybe) +import Data.Monoid +import qualified Graphics.Vty as V +import Lens.Micro ((^.)) + +import qualified Brick.AttrMap as A +import qualified Brick.Main as M +import Brick.Types (Widget) +import qualified Brick.Types as T +import Brick.Util (fg, on) +import qualified Brick.Widgets.Border as B +import qualified Brick.Widgets.Center as C +import Brick.Widgets.Core (hLimit, str, vBox, vLimit, withAttr, (<+>)) +import qualified Brick.Widgets.List as L +import qualified Data.Vector as Vec + +drawUI :: (Show a) => L.List () a -> [Widget ()] +drawUI l = [ui] + where + label = str "Item " <+> cur <+> str " of " <+> total + cur = case l^.(L.listSelectedL) of + Nothing -> str "-" + Just i -> str (show (i + 1)) + total = str $ show $ Vec.length $ l^.(L.listElementsL) + box = B.borderWithLabel label $ + hLimit 25 $ + vLimit 15 $ + L.renderList listDrawElement True l + ui = C.vCenter $ vBox [ C.hCenter box + , str " " + , C.hCenter $ str "Press +/- to add/remove list elements." + , C.hCenter $ str "Press Esc to exit." + ] + +appEvent :: L.List () Char -> T.BrickEvent () e -> T.EventM () (T.Next (L.List () Char)) +appEvent l (T.VtyEvent e) = + case e of + V.EvKey (V.KChar '+') [] -> + let el = nextElement (L.listElements l) + pos = Vec.length $ l^.(L.listElementsL) + in M.continue $ L.listInsert pos el l + + V.EvKey (V.KChar '-') [] -> + case l^.(L.listSelectedL) of + Nothing -> M.continue l + Just i -> M.continue $ L.listRemove i l + + V.EvKey V.KEsc [] -> M.halt l + + ev -> M.continue =<< (L.handleListEventVi L.handleListEvent) ev l + where + nextElement :: Vec.Vector Char -> Char + nextElement v = fromMaybe '?' $ Vec.find (flip Vec.notElem v) (Vec.fromList ['a' .. 'z']) +appEvent l _ = M.continue l + +listDrawElement :: (Show a) => Bool -> a -> Widget () +listDrawElement sel a = + let selStr s = if sel + then withAttr customAttr (str $ "<" <> s <> ">") + else str s + in C.hCenter $ str "Item " <+> (selStr $ show a) + +initialState :: L.List () Char +initialState = L.list () (Vec.fromList ['a','b','c']) 1 + +customAttr :: A.AttrName +customAttr = L.listSelectedAttr <> "custom" + +theMap :: A.AttrMap +theMap = A.attrMap V.defAttr + [ (L.listAttr, V.white `on` V.blue) + , (L.listSelectedAttr, V.blue `on` V.white) + , (customAttr, fg V.cyan) + ] + +theApp :: M.App (L.List () Char) e () +theApp = + M.App { M.appDraw = drawUI + , M.appChooseCursor = M.showFirstCursor + , M.appHandleEvent = appEvent + , M.appStartEvent = return + , M.appAttrMap = const theMap + } + +main :: IO () +main = void $ M.defaultMain theApp initialState diff --git a/src/Brick/Widgets/List.hs b/src/Brick/Widgets/List.hs --- a/src/Brick/Widgets/List.hs +++ b/src/Brick/Widgets/List.hs @@ -19,6 +19,7 @@ -- * Handling events , handleListEvent + , handleListEventVi -- * Lenses , listElementsL @@ -58,7 +59,7 @@ import Lens.Micro ((^.), (&), (.~), (%~), _2) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) -import Graphics.Vty (Event(..), Key(..)) +import Graphics.Vty (Event(..), Key(..), Modifier(..)) import qualified Data.Vector as V import Brick.Types @@ -97,6 +98,37 @@ EvKey KPageDown [] -> listMovePageDown theList EvKey KPageUp [] -> listMovePageUp theList _ -> return theList + +-- | Enable list movement with the vi keys with a fallback if none match. +-- Use (handleListEventVi handleListEvent) in place of handleListEvent to add +-- the vi keys bindings to the standard ones. +-- Movements handled: +-- * Up (k) +-- * Down (j) +-- * Page Up (Ctrl-b) +-- * Page Down (Ctrl-f) +-- * Half Page Up (Ctrl-u) +-- * Half Page Down (Ctrl-d) +-- * Top (g) +-- * Bottom (G) +handleListEventVi :: (Ord n) + => (Event -> List n e -> EventM n (List n e)) + -- ^ Fallback event handler to use if none of the vi keys + -- match. + -> Event + -> List n e + -> EventM n (List n e) +handleListEventVi fallback e theList = + case e of + EvKey (KChar 'k') [] -> return $ listMoveUp theList + EvKey (KChar 'j') [] -> return $ listMoveDown theList + EvKey (KChar 'g') [] -> return $ listMoveTo 0 theList + EvKey (KChar 'G') [] -> return $ listMoveTo (V.length $ listElements theList) theList + EvKey (KChar 'f') [MCtrl] -> listMovePageDown theList + EvKey (KChar 'b') [MCtrl] -> listMovePageUp theList + EvKey (KChar 'd') [MCtrl] -> listMoveByPages 0.5 theList + EvKey (KChar 'u') [MCtrl] -> listMoveByPages (-0.5) theList + _ -> fallback e theList -- | The top-level attribute used for the entire list. listAttr :: AttrName