vty-ui 1.6.1 → 1.7

raw patch · 23 files changed

+390/−120 lines, 23 filesdep ~arraydep ~textdep ~unixnew-component:exe:vty-ui-collection-demo

Dependency ranges changed: array, text, unix

Files

• demos/CollectionDemo.hs +71/−0
• demos/ComplexDemo.hs +1/−1
• demos/ListDemo.hs +1/−1
• doc/ch1/api_notes.tex +2/−2
• doc/ch2/event_loop.tex +34/−1
• doc/ch2/focus_groups.tex +2/−2
• doc/ch3/deferring_to_children.tex +2/−3
• doc/ch3/implementing_event_handlers.tex +1/−1
• doc/ch3/new_widget_type.tex +2/−1
• doc/ch4/Fixed.tex +1/−1
• doc/ch4/List.tex +18/−21
• doc/macros.tex +1/−1
• doc/title_page.tex +2/−1
• doc/vty-ui-users-manual.tex +4/−0
• src/Graphics/Vty/Widgets/Core.hs +31/−7
• src/Graphics/Vty/Widgets/DirBrowser.hs +1/−1
• src/Graphics/Vty/Widgets/Edit.hs +60/−17
• src/Graphics/Vty/Widgets/Fills.hs +3/−2
• src/Graphics/Vty/Widgets/Fixed.hs +5/−5
• src/Graphics/Vty/Widgets/List.hs +77/−45
• src/Graphics/Vty/Widgets/Text.hs +44/−2
• src/Graphics/Vty/Widgets/TextZipper.hs +10/−1
• vty-ui.cabal +17/−4

@@ -0,0 +1,71 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-do-bind #-}+{-# LANGUAGE OverloadedStrings #-}+module Main where++import System.Exit+import qualified Data.Text as T+import Graphics.Vty hiding (Button)+import Graphics.Vty.Widgets.All++items :: [T.Text]+items = [ "Arrow keys change list items"+        , "Esc quits"+        , "Ctrl-n goes to the next interface"+        ]++mkFirstUI = do+  u <- plainText $ T.unlines items+  pe <- padded u (padLeftRight 2)+  (d, dFg) <- newDialog pe "This is a dialog"+  setNormalAttribute d (white `on` blue)+  c <- centered =<< withPadding (padLeftRight 10) (dialogWidget d)+  d `onDialogAccept` const shutdownUi+  d `onDialogCancel` const shutdownUi+  return (c, dFg)++mkSecondUI = do+  fg <- newFocusGroup+  lst <- newTextList (green `on` blue) items 1+  addToFocusGroup fg lst+  c <- centered =<< vLimit 10 =<< hLimit 50 =<< bordered lst+  return (c, fg)++mkThirdUI = do+  fg <- newFocusGroup+  cb1 <- newCheckbox $ items !! 0+  cb2 <- newCheckbox $ items !! 1+  cb3 <- newCheckbox $ items !! 2+  addToFocusGroup fg cb1+  addToFocusGroup fg cb2+  addToFocusGroup fg cb3++  c <- centered =<< vLimit 10 =<< hLimit 50 =<< bordered =<< (+         (return cb1) <--> (return cb2) <--> (return cb3)+       )++  return (c, fg)++main :: IO ()+main = do+  coll <- newCollection++  (ui1, fg1) <- mkFirstUI+  switchToFirst <- addToCollection coll ui1 fg1++  (ui2, fg2) <- mkSecondUI+  switchToSecond <- addToCollection coll ui2 fg2++  (ui3, fg3) <- mkThirdUI+  switchToThird <- addToCollection coll ui3 fg3++  let keyHandler nextUI = \_ k mods ->+        case (k, mods) of+            (KASCII 'n', [MCtrl]) -> nextUI >> return True+            (KEsc, []) -> exitSuccess+            _ -> return False++  fg1 `onKeyPressed` (keyHandler switchToSecond)+  fg2 `onKeyPressed` (keyHandler switchToThird)+  fg3 `onKeyPressed` (keyHandler switchToFirst)++  runUi coll $ defaultContext { focusAttr = black `on` yellow }

@@ -64,7 +64,7 @@   edit1Header <- textWidget wrap T.empty >>= withNormalAttribute headerAttr   edit2Header <- textWidget wrap T.empty >>= withNormalAttribute headerAttr -  lst <- newList (fgColor bright_green)+  lst <- newList (fgColor bright_green) 1    selector <- vLimit 3 lst   listHeader <- plainText T.empty

@@ -62,7 +62,7 @@ -- Construct the application statea using the message map. mkAppElements :: IO AppElements mkAppElements = do-  lw <- newTextList selAttr []+  lw <- newTextList selAttr [] 1   b <- textWidget wrap T.empty   ft <- plainText T.empty >>= withNormalAttribute titleAttr   ll <- vLimit 5 lw

@@ -2,10 +2,10 @@  \subsection{Widget Types} -When you create a widget in \vtyui, the result with almost always have+When you create a widget in \vtyui, the result will almost always have a type like \fw{Widget a}.  The type variable \fw{a} represents the specific type of state the widget can carry, and therefore which-operations can be performed on it.  For example, a text widget has+operations can be performed on it.  For example, a text widget has the type \fw{Widget FormattedText}.  Throughout this document, we'll refer frequently to widgets by their state type (e.g., ``\fw{Edit} widgets''). In most cases we are referring to a value whose type is,

@@ -72,7 +72,7 @@ they are not set, the widgets default to using those specified by the rendering context.  The only exception is the ``override'' attribute. Instead of ``falling back'' to this attribute, the presence of this-attribute reuqires widgets to use it.  For example, this attribute is+attribute requires widgets to use it.  For example, this attribute is used in the \fw{List} widget so that the currently-selected list item can be highlighted, which requires the \fw{List} to override the item's default attribute configuration.@@ -182,3 +182,36 @@ Some built-in widgets will almost always be used in this way; for an example, take a look at the \fw{ProgressBar} widget in the \fw{ProgressBar} module (see Section \ref{sec:progress_bars}).++\subsection{Handling Resize Events}++When \vtyui\ renders a widget, you can be notified if its size changes.  This+might be useful if, for example, you want to change the visual style or state+of a widget when its size crosses a threshold.  To do this, register a resize+event handler on the widget with \fw{onResize} as follows:++\begin{haskellcode}+ w <- someWidget+ w `onResize` \(oldSize, newSize) -> do+   ...+\end{haskellcode}++The resize handler will be given the old size before the change and the new+size after the change.  Initially every widget has size \fw{(0, 0)} so your+handler will always run at least once with an "old" size of \fw{(0, 0)} and a+"new" size of the widget's initial size.++The \fw{onResize} mechanism has a serious caveat.  Consider a resize handler+which results in another size change, such as a call to \fw{setText} which+makes a text widget larger.  Such a change would spur another size change and+would result in a non-terminating sequence of calls which would probably crash+your program or, if not, just use all of your CPU.  To avoid this, ensure that+any resize handlers don't result in size changes; you can change the visual+style, attributes, etc., of your widget, but if you change contents enough, a+resize handler loop will result.++Finally, since resize handlers run during the rendering process, any changes to+widgets which require a redraw to be visible on the screen will need to use the+\fw{schedule} function (see Section \ref{sec:concurrency}).  This will ensure+that visual changes to a widget made during rendering will force another+rendering.

@@ -107,9 +107,9 @@ You might wonder why this is useful.  Consider a situation in which you want to add some padding to an input widget, such as an \fw{Edit} widget, but when the \fw{Edit} widget is focused you want to highlight-the padding, too, to make them appear as a single widget.  Since+the padding too, to make them appear as a single widget.  Since padding widgets (see Section \ref{sec:padding}) relay events to their-children, you could focus the padding widget and the edit widget would+children, you could focus the padding widget, and the edit widget would automatically receive the focus as well as user input events.  This kind of focus and event ``inheritance'' makes it possible to create new, composite widgets in a flexible way, while getting the desired

@@ -28,12 +28,11 @@      w { growHorizontal_ = growHorizontal child        , growVertical_ = growVertical child        , setCurrentPosition_ =-           \_ pos = setCurrentPosition child pos+           \_ pos -> setCurrentPosition child pos        , getCursorPosition_ =            const $ getCursorPosition child        , render_ =-           \_ sz ctx = do-             render child sz ctx+         \_ sz ctx -> render child sz ctx        }     wRef `relayFocusEvents` child

@@ -97,7 +97,7 @@    -- Set the internal widget state.    -- ...    -- Then invoke the handlers:-   fireEvent wRef (tempChangeHandlers <~~) (TemperatureEvent newTemp)+   fireEvent wRef (tempChangeHandlers <~~) (Temp newTemp) \end{haskellcode}  Just as with \fw{addHandler}, we pass a handler list lookup function

@@ -16,6 +16,7 @@  \begin{haskellcode}  data Counter = Counter Int+                deriving (Show) \end{haskellcode}  The next step is to write a widget constructor function.  This@@ -27,7 +28,7 @@  newCounter :: Int -> IO (Widget Counter)  newCounter initialValue = do    let st = Counter initialValue-   wRef <- newWidget st $ \w ->+   newWidget st $ \w ->      w { render_ =          \this size ctx -> do            (Counter v) <- getState this

@@ -51,7 +51,7 @@ guarantee that the specified space is consumed.  \begin{haskellcode}- lst <- newList (green `on` black)+ lst <- newList (green `on` black) 1  ui <- vFixed 5 lst \end{haskellcode} 

@@ -36,16 +36,15 @@ Lists are created with the \fw{newList} function:  \begin{haskellcode}- lst <- newList attr+ lst <- newList attr 1 \end{haskellcode} -\fw{newList} takes one parameter: the attribute of the-currently-selected item to be used when the list is \textit{not}-focused.  The \fw{List} uses its own focus attribute (Section-\ref{sec:attributes}) as the attribute of the currently-selected item-when it has the focus.  The widget type of the list (\fw{b} above)-won't be chosen by the type system until you actually add something to-the list.+\fw{newList} takes two parameters: the attribute of the currently-selected item+to be used when the list is \textit{not} focused, and the height, in rows, of+each widget in the list.  The \fw{List} uses its own focus attribute (Section+\ref{sec:attributes}) as the attribute of the currently-selected item when it+has the focus.  The widget type of the list (\fw{b} above) won't be chosen by+the type system until you actually add something to the list.  Items may be added to a \fw{List} with the \fw{addToList} function, which takes an internal value (e.g., \fw{String}) and a widget of the@@ -59,21 +58,19 @@ In addition, items may be inserted into a \fw{List} at any position with the \fw{insertIntoList} function. -There are two restrictions on the widget type that can be used with-\fw{List}s:+When it comes to how \fw{List}s render item widgets, there are two behaviors to+know about:  \begin{itemize}-\item The \fw{Widget b} type \textit{must not grow vertically}.  This-  is because all \fw{List} item widgets must take up a fixed amount of-  vertical space so the \fw{List} can manage scrolling.  If the widget-  grows vertically, \fw{addToList} will throw a \fw{ListError}-  exception.-\item All widgets added to the \fw{List} \textit{must have the same-  height}.  This is because the list uses the item height to calculate-  how many items can be displayed, given the space available to the-  rendered \fw{List}.  If you specify a widget whose rendered size-  doesn't match that of the rest of the wigets of the list, layout-  problems are likely to ensue.+\item \textit{All widgets rendered by the list must have the same height}.+  This is because the list uses the item height to calculate how many+  items can be displayed, given the space available to the rendered \fw{List}.+  This is why the height of list items must be passed to \fw{newList}.+\item \textit{The item widgets will be height-restricted}.  This is because all+  \fw{List} item widgets must take up a fixed amount of vertical space so the+  \fw{List} can manage scrolling state.  Internally the \fw{List} widget uses+  \fw{vLimit} and \fw{vFixed} wrappers to render each item widget to guarantee+  that all items have the same height. \end{itemize}  Items may be removed from \fw{List}s with the \fw{removeFromList}

@@ -1,6 +1,6 @@ % Custom macros. -\newcommand{\vtyuiversion}{1.6.1}+\newcommand{\vtyuiversion}{1.7}  \newcommand{\fw}[1]{\texttt{#1}} \newcommand{\vtyui}{\fw{vty-ui}}

@@ -1,6 +1,7 @@ \title{\vtyui\ User's Manual} \author{   For \vtyui\ version \vtyuiversion\\-  Jonathan Daugherty (\href{mailto:cygnus@foobox.com}{cygnus@foobox.com})+  by Jonathan Daugherty (\href{mailto:cygnus@foobox.com}{cygnus@foobox.com})\\+  (and contributors!) } \maketitle

@@ -6,6 +6,10 @@ % For smarter references. \usepackage{varioref} +% For better control over itemize environments.+\usepackage{enumitem}+\setlist[itemize]{topsep=0pt}+ % For syntax highlighting! \usepackage{minted} 

@@ -53,6 +53,7 @@     , onKeyPressed     , onGainFocus     , onLoseFocus+    , onResize     , relayKeyEvents     , relayFocusEvents @@ -194,6 +195,8 @@     -- event.     , gainFocusHandlers :: Handlers (Widget a)     -- ^List of handlers to be invoked when the widget gains focus.+    , resizeHandlers :: Handlers (DisplayRegion, DisplayRegion)+    -- ^List of handlers to be invoked when the widget's size changes.     , loseFocusHandlers :: Handlers (Widget a)     -- ^List of handlers to be invoked when the widget loses focus.     , focused :: Bool@@ -310,12 +313,15 @@   setCurrentPosition wRef pos   return img --- |Set the current size of a widget.  Exported for internal use.+-- |Set the current size of a widget.  Exported for internal use.  When the+-- size changes from its previous value, resize event handlers will be invoked. setCurrentSize :: Widget a -> DisplayRegion -> IO ()-setCurrentSize wRef newSize =+setCurrentSize wRef newSize = do+    oldSize <- getCurrentSize wRef     modifyIORef wRef $ \w ->         let new =  w { currentSize = newSize }         in seq new new+    when (oldSize /= newSize) $ handleResizeEvent wRef (oldSize, newSize)  -- |Get the current size of the widget (its size after its most recent -- rendering).@@ -342,6 +348,7 @@ newWidget initState f = do   gfhs <- newHandlers   lfhs <- newHandlers+  rhs <- newHandlers    wRef <- newIORef $           WidgetImpl { state = initState@@ -354,6 +361,7 @@                      , focused = False                      , visible = True                      , gainFocusHandlers = gfhs+                     , resizeHandlers = rhs                      , loseFocusHandlers = lfhs                      , keyEventHandler = \_ _ _ -> return False                      , getCursorPosition_ = defaultCursorInfo@@ -381,6 +389,11 @@   act <- keyEventHandler <~ wRef   act wRef keyEvent mods +-- |Given a widget, invoke its resize event handlers with the old and new+-- sizes.+handleResizeEvent :: Widget a -> (DisplayRegion, DisplayRegion) -> IO ()+handleResizeEvent wRef szs = fireEvent wRef (resizeHandlers <~) szs+ -- |Given widgets A and B, causes any key events on widget A to be -- relayed to widget B.  Note that this does behavior constitutes an -- ordinary key event handler from A's perspective, so if B does not@@ -438,6 +451,17 @@ onGainFocus :: Widget a -> (Widget a -> IO ()) -> IO () onGainFocus = addHandler (gainFocusHandlers <~) +-- |Given a widget and a resize event handler, add the handler to the widget.+-- The handler will be invoked when the widget's size changes.  This includes+-- the first rendering, at which point its size changes from (0, 0).  Note that+-- if the resize handler needs to change the visual appearance of the widget+-- when its size changes, be sure to use 'schedule' to ensure that visual+-- changes are reflected immediately, and be absolutely sure that those changes+-- will not cause further size changes; that will cause a resize event handler+-- loop that will consume your CPU!+onResize :: Widget a -> ((DisplayRegion, DisplayRegion) -> IO ()) -> IO ()+onResize = addHandler (resizeHandlers <~)+ -- |Given a widget and a focus loss event handler, add the handler to -- the widget.  The handler will be invoked when the widget loses -- focus.@@ -522,7 +546,7 @@   let initSt = FocusGroup { entries = []                           , currentEntryNum = -1                           , nextKey = (KASCII '\t', [])-                          , prevKey = (KASCII '\t', [MShift])+                          , prevKey = (KBackTab, [])                           }    wRef <- newWidget initSt $ \w ->@@ -565,9 +589,9 @@     updateWidgetState fg $ \s -> s { prevKey = (k, mods) }  -- |Merge two focus groups.  Given two focus groups A and B, this--- returns a new focus group with all of the entries from A and B--- added to it, in that order.  Both A and B must be non-empty or--- 'FocusGroupEmpty' will be thrown.+-- returns a new focus group with all of the entries from A and B added to it,+-- in that order.  At least one A and B must be non-empty or 'FocusGroupEmpty'+-- will be thrown. mergeFocusGroups :: Widget FocusGroup -> Widget FocusGroup -> IO (Widget FocusGroup) mergeFocusGroups a b = do   c <- newFocusGroup@@ -575,7 +599,7 @@   aEntries <- entries <~~ a   bEntries <- entries <~~ b -  when (null aEntries || null bEntries) $+  when (null aEntries && null bEntries) $        throw FocusGroupEmpty    updateWidgetState c $ \s -> s { entries = aEntries ++ bEntries

@@ -137,7 +137,7 @@              <++> (return fileInfo) <++> (hFill ' ' 1) <++> (return errorText))             >>= withNormalAttribute (browserHeaderAttr bSkin) -  l <- newList (browserUnfocusedSelAttr bSkin)+  l <- newList (browserUnfocusedSelAttr bSkin) 1   ui <- vBox header =<< vBox l footer    r <- newIORef ""

@@ -45,6 +45,8 @@     , setEditCursorPosition     , setEditLineLimit     , getEditLineLimit+    , setEditMaxLength+    , getEditMaxLength     , applyEdit     , onActivate     , onChange@@ -58,6 +60,7 @@  import Control.Applicative ((<$>)) import Control.Monad+import Data.Maybe (isJust) import qualified Data.Text as T import Graphics.Vty import Graphics.Vty.Widgets.Core@@ -72,6 +75,7 @@                  , changeHandlers :: Handlers T.Text                  , cursorMoveHandlers :: Handlers (Int, Int)                  , lineLimit :: Maybe Int+                 , maxLength :: Maybe Int                  }  instance Show Edit where@@ -98,6 +102,7 @@                     , changeHandlers = chs                     , cursorMoveHandlers = cmhs                     , lineLimit = Nothing+                    , maxLength = Nothing                     }    wRef <- newWidget initSt $ \w ->@@ -205,6 +210,17 @@ getEditLineLimit :: Widget Edit -> IO (Maybe Int) getEditLineLimit = (lineLimit <~~) +-- |Set the maximum length of the contents of an edit widget.  Applies to every+-- line of text in the editor.  'Nothing' indicates no limit, while 'Just'+-- indicates a limit of the specified number of characters.+setEditMaxLength :: Widget Edit -> Maybe Int -> IO ()+setEditMaxLength _ (Just v) | v <= 0 = return ()+setEditMaxLength w v = updateWidgetState w $ \st -> st { maxLength = v }++-- |Get the current maximum length, if any, for the edit widget.+getEditMaxLength :: Widget Edit -> IO (Maybe Int)+getEditMaxLength = (maxLength <~~)+ resize :: Widget Edit -> (Phys, Phys) -> IO () resize e (newHeight, newWidth) = do   updateWidgetState e $ \st ->@@ -277,14 +293,19 @@  -- |Set the contents of the edit widget.  Newlines will be used to -- break up the text in multiline widgets.  If the edit widget has a--- line limit, only those lines within the limit will be set.+-- line limit, only those lines within the limit will be set.  If the edit+-- widget has a line length limit, lines will be truncated. setEditText :: Widget Edit -> T.Text -> IO () setEditText wRef str = do   lim <- lineLimit <~~ wRef-  let ls = case lim of+  maxL <- maxLength <~~ wRef+  let ls1 = case lim of              Nothing -> T.lines str              Just l -> take l $ T.lines str-  updateWidgetState wRef $ \st -> st { contents = Z.textZipper ls+      ls2 = case maxL of+             Nothing -> ls1+             Just l -> ((T.take l) <$>) $ T.lines str+  updateWidgetState wRef $ \st -> st { contents = Z.textZipper ls2                                      }   notifyChangeHandlers wRef @@ -315,23 +336,32 @@           -> Widget Edit           -> IO () applyEdit f this = do-  oldC <- contents <~~ this-  updateWidgetState this $ \s ->-      let newSt = s { contents = f (contents s) }-      in case lineLimit s of-           Nothing -> newSt-           Just l -> if length (Z.getText $ contents newSt) > l-                     then s-                     else newSt+  old <- contents <~~ this+  llim <- lineLimit <~~ this+  maxL <- maxLength <~~ this -  newC <- contents <~~ this+  let checkLines tz = case llim of+                        Nothing -> Just tz+                        Just l -> if length (Z.getText tz) > l+                                  then Nothing+                                  else Just tz+      checkLength tz = case maxL of+                         Nothing -> Just tz+                         Just l -> if or ((> l) <$> (Z.lineLengths tz))+                                   then Nothing+                                   else Just tz+      newContents = checkLength =<< checkLines (f old) -  when (Z.getText oldC /= Z.getText newC) $-       notifyChangeHandlers this+  when (isJust newContents) $ do+    let Just new = newContents+    updateWidgetState this $ \s -> s { contents = new } -  when (Z.cursorPosition oldC /= Z.cursorPosition newC) $-       notifyCursorMoveHandlers this+    when (Z.getText old /= Z.getText new) $+         notifyChangeHandlers this +    when (Z.cursorPosition old /= Z.cursorPosition new) $+         notifyCursorMoveHandlers this+ editKeyEvent :: Widget Edit -> Key -> [Modifier] -> IO Bool editKeyEvent this k mods = do   let run f = applyEdit f this >> return True@@ -344,7 +374,20 @@     (KRight, []) -> run Z.moveRight     (KUp, []) -> run Z.moveUp     (KDown, []) -> run Z.moveDown-    (KBS, []) -> run Z.deletePrevChar+    (KBS, []) -> do+        v <- run Z.deletePrevChar+        when (v) $ do+            -- We want deletions to cause content earlier on the line(s) to+            -- slide in from the left rather than letting the cursor reach the+            -- beginning of the edit widget, preventing the user from seeing+            -- characters being deleted.  To do this, after deletion (if we+            -- can) we slide the clipping window one column to the left.+            updateWidgetState this $ \st ->+                let r = clipRect st+                in if clipLeft r > 0+                   then st { clipRect = r { clipLeft = clipLeft r - Phys 1 } }+                   else st+        return v     (KDel, []) -> run Z.deleteChar     (KASCII ch, []) -> run (Z.insertChar ch)     (KHome, []) -> run Z.gotoBOL

@@ -37,8 +37,9 @@ data HFill = HFill Char Int              deriving (Show) --- |A horizontal fill widget.  Fills the available horizontal space,--- one row high, using the specified character and attribute.+-- |A horizontal fill widget.  Fills the available horizontal space using the+-- specified character. The integer parameter specifies the height, in rows, of+-- the fill. hFill :: Char -> Int -> IO (Widget HFill) hFill c h = do   wRef <- newWidget (HFill c h) $ \w ->

@@ -41,7 +41,7 @@                    let img' = if image_width img < region_width region                               then img <|> (char_fill (getNormalAttr ctx) ' '                                             (toEnum width - image_width img)-                                            (image_height img))+                                            1)                               else img                    return img' @@ -77,7 +77,7 @@                    -- Pad the image if it's smaller than the region.                    let img' = if image_height img < region_height region                               then img <-> (char_fill (getNormalAttr ctx) ' '-                                            (image_width img)+                                            1                                             (toEnum height - image_height img))                               else img                    return img'@@ -131,10 +131,10 @@   (HFixed lim _) <- state <~ wRef   return lim --- |Impose a maximum horizontal and vertical size on a widget.+-- |Impose a fixed horizontal and vertical size on a widget. boxFixed :: (Show a) =>-            Int -- ^Maximum width in columns-         -> Int -- ^Maximum height in rows+            Int -- ^Width in columns+         -> Int -- ^Height in rows          -> Widget a          -> IO (Widget (VFixed (HFixed a))) boxFixed maxWidth maxHeight w = do

@@ -23,6 +23,8 @@     , scrollBy     , scrollUp     , scrollDown+    , scrollToEnd+    , scrollToBeginning     , pageUp     , pageDown     , onSelectionChange@@ -33,6 +35,8 @@     , clearList     , setSelected     -- ** List inspection+    , listFindFirst+    , listFindAll     , getListSize     , getSelected     , getListItem@@ -47,6 +51,8 @@ import Graphics.Vty import Graphics.Vty.Widgets.Core import Graphics.Vty.Widgets.Text+import Graphics.Vty.Widgets.Fixed+import Graphics.Vty.Widgets.Limits import Graphics.Vty.Widgets.Events import Graphics.Vty.Widgets.Util @@ -54,9 +60,6 @@                -- ^The specified position could not be used to remove                -- an item from the list.                | ResizeError-               | BadListWidgetSizePolicy-               -- ^The type of widgets added to the list grow-               -- vertically, which is not permitted.                  deriving (Show, Typeable)  instance Exception ListError@@ -118,8 +121,9 @@                       ]  newListData :: Attr -- ^The attribute of the selected item+            -> Int -- ^Item widget height in rows             -> IO (List a b)-newListData selAttr = do+newListData selAttr h = do   schs <- newHandlers   iahs <- newHandlers   irhs <- newHandlers@@ -134,7 +138,7 @@                 , itemAddHandlers = iahs                 , itemRemoveHandlers = irhs                 , itemActivateHandlers = iacths-                , itemHeight = 0+                , itemHeight = h                 }  -- |Get the length of the list in elements.@@ -223,22 +227,6 @@ insertIntoList list key w pos = do   numItems <- (V.length . listItems) <~~ list -  v <- growVertical w-  when (v) $ throw BadListWidgetSizePolicy--  h <- case numItems of-         0 -> do-           -- We're adding the first element to the list, so we need-           -- to compute the item height based on this widget.  We-           -- just render it in an unreasonably large space (since,-           -- really, list items should never be THAT big) and measure-           -- the result, assuming that all list widgets will have the-           -- same size.  If you violate this, you'll have interesting-           -- results!-           img <- render w (DisplayRegion 100 100) defaultContext-           return $ max 1 $ fromEnum $ image_height img-         _ -> itemHeight <~~ list-   -- Calculate the new selected index.   oldSel <- selectedIndex <~~ list   oldScr <- scrollTopIndex <~~ list@@ -263,8 +251,7 @@                    then V.snoc (listItems s) (key, w)                    else vInject pos (key, w) (listItems s) -  updateWidgetState list $ \s -> s { itemHeight = h-                                   , listItems = V.force $ newItems s+  updateWidgetState list $ \s -> s { listItems = V.force $ newItems s                                    , selectedIndex = newSelIndex                                    , scrollTopIndex = newScrollTop                                    }@@ -318,9 +305,10 @@ -- currently-selected element when the list does NOT have focus. newList :: (Show b) =>            Attr -- ^The attribute of the selected item+        -> Int -- ^Height of list item widgets in rows         -> IO (Widget (List a b))-newList selAttr = do-  list <- newListData selAttr+newList selAttr ht = do+  list <- newListData selAttr ht   wRef <- newWidget list $ \w ->       w { keyEventHandler = listKeyEvent @@ -395,15 +383,21 @@        renderVisible [] = return []       renderVisible ((w, sel):ws) = do+        na <- normalAttribute <~ w         let att = if sel                   then if foc                        then focusAttr ctx                        else mergeAttrs [ selectedUnfocusedAttr list                                        , defaultAttr                                        ]-                  else defaultAttr-        img <- render w s $ ctx { overrideAttr = att }+                  else mergeAttrs [ na+                                  , defaultAttr+                                  ]+        -- Height-limit the widget by wrapping it with a VFixed/VLimit+        limited <- vLimit (itemHeight list) =<< vFixed (itemHeight list) w +        img <- render limited s $ ctx { overrideAttr = att }+         let actualHeight = min (region_height s) (toEnum $ itemHeight list)             img' = img <|> char_fill att ' '                    (region_width s - image_width img)@@ -425,9 +419,10 @@ -- strings. newTextList :: Attr -- ^The attribute of the selected item             -> [T.Text] -- ^The list items+            -> Int -- ^Maximum number of rows of text to show per list item             -> IO (Widget (List T.Text FormattedText))-newTextList selAttr labels = do-  list <- newList selAttr+newTextList selAttr labels h = do+  list <- newList selAttr h   forM_ labels $ \l ->       (addToList list l =<< plainText l)   return list@@ -468,6 +463,23 @@     (-1) -> return ()     curPos -> scrollBy wRef (newPos - curPos) +-- |Find the first index of the specified key in the list.  If the key does not+-- exist, return Nothing.+listFindFirst :: (Eq a) => Widget (List a b) -> a -> IO (Maybe Int)+listFindFirst wRef item = do+  list <- state <~ wRef+  return $ V.findIndex matcher (listItems list)+  where+    matcher = \(match, _) -> item == match++-- |Find all indicies of the specified key in the list.+listFindAll :: (Eq a) => Widget (List a b) -> a -> IO [Int]+listFindAll wRef item = do+  list <- state <~ wRef+  return $ V.toList $ V.findIndices matcher (listItems list)+  where+    matcher = \(match, _) -> item == match+ resize :: Widget (List a b) -> Int -> IO () resize wRef newSize = do   when (newSize == 0) $ throw ResizeError@@ -523,19 +535,21 @@   notifySelectionHandler wRef  scrollBy' :: Int -> List a b -> List a b-scrollBy' amount list =-  let sel = selectedIndex list-      lastPos = (V.length $ listItems list) - 1-      validPositions = [0..lastPos]-      newPosition = sel + amount--      newSelected = if newPosition `elem` validPositions-                    then newPosition-                    else if newPosition > lastPos-                         then lastPos-                         else 0+scrollBy' amt list =+    case selectedIndex list of+        (-1) -> list+        i -> let dest = i + amt+                 sz = V.length $ listItems list+                 newDest = if dest < 0+                           then 0+                           else if dest >= sz+                                then sz - 1+                                else dest+             in scrollTo newDest list -      bottomPosition = min (scrollTopIndex list + scrollWindowSize list - 1)+scrollTo :: Int -> List a b -> List a b+scrollTo newSelected list =+  let bottomPosition = min (scrollTopIndex list + scrollWindowSize list - 1)                        ((V.length $ listItems list) - 1)       topPosition = scrollTopIndex list       windowPositions = [topPosition..bottomPosition]@@ -546,11 +560,12 @@                          then newSelected - scrollWindowSize list + 1                          else newSelected -  in if scrollWindowSize list == 0-     then list-     else list { scrollTopIndex = adjustedTop-               , selectedIndex = newSelected }+  in list { scrollTopIndex = adjustedTop+          , selectedIndex = newSelected+          } ++ notifySelectionHandler :: Widget (List a b) -> IO () notifySelectionHandler wRef = do   sel <- getSelected wRef@@ -567,6 +582,23 @@ notifyItemAddHandler :: Widget (List a b) -> Int -> a -> Widget b -> IO () notifyItemAddHandler wRef pos k w =     fireEvent wRef (itemAddHandlers <~~) $ NewItemEvent pos k w++-- |Scroll to the last list position.+scrollToEnd :: Widget (List a b) -> IO ()+scrollToEnd wRef = do+    cur <- getSelected wRef+    sz <- getListSize wRef+    case cur of+        Nothing -> return ()+        Just (pos, _) -> scrollBy wRef (sz - pos)++-- |Scroll to the first list position.+scrollToBeginning :: Widget (List a b) -> IO ()+scrollToBeginning wRef = do+    cur <- getSelected wRef+    case cur of+        Nothing -> return ()+        Just (pos, _) -> scrollBy wRef (-1 * pos)  -- |Scroll a list down by one position. scrollDown :: Widget (List a b) -> IO ()

@@ -11,7 +11,11 @@     , textWidget     -- *Setting Widget Contents     , setText+    , appendText+    , prependText     , setTextWithAttrs+    , appendTextWithAttrs+    , prependTextWithAttrs     , setTextFormatter     , setTextAppearFocused     -- *Formatting@@ -133,18 +137,56 @@ setText :: Widget FormattedText -> T.Text -> IO () setText wRef s = setTextWithAttrs wRef [(s, def_attr)] +-- |Append the text value to the text contained in a 'FormattedText' widget.+-- The specified string will be 'tokenize'd.+appendText :: Widget FormattedText -> T.Text -> IO ()+appendText wRef s = appendTextWithAttrs wRef [(s, def_attr)]++-- |Prepend the text value to the text contained in a 'FormattedText' widget.+-- The specified string will be 'tokenize'd.+prependText :: Widget FormattedText -> T.Text -> IO ()+prependText wRef s = prependTextWithAttrs wRef [(s, def_attr)]++-- |Prepend text to the text value of a 'FormattedText' widget directly, in+-- case you have done formatting elsewhere and already have text with+-- attributes.  The specified strings will each be 'tokenize'd, and tokens+-- resulting from each 'tokenize' operation will be given the specified+-- attribute in the tuple.+prependTextWithAttrs :: Widget FormattedText -> [(T.Text, Attr)] -> IO ()+prependTextWithAttrs wRef pairs = _setTextWithAttrs wRef pairs f+    where+      f st new = let TS old = text st+                 in new ++ old++-- |Append text to the text value of a 'FormattedText' widget directly, in case+-- you have done formatting elsewhere and already have text with attributes.+-- The specified strings will each be 'tokenize'd, and tokens resulting from+-- each 'tokenize' operation will be given the specified attribute in the+-- tuple.+appendTextWithAttrs :: Widget FormattedText -> [(T.Text, Attr)] -> IO ()+appendTextWithAttrs wRef pairs = _setTextWithAttrs wRef pairs f+    where+      f st new = let TS old = text st+                 in old ++ new+ -- |Set the text value of a 'FormattedText' widget directly, in case -- you have done formatting elsewhere and already have text with -- attributes.  The specified strings will each be 'tokenize'd, and -- tokens resulting from each 'tokenize' operation will be given the -- specified attribute in the tuple. setTextWithAttrs :: Widget FormattedText -> [(T.Text, Attr)] -> IO ()-setTextWithAttrs wRef pairs = do+setTextWithAttrs wRef pairs = _setTextWithAttrs wRef pairs (\_ new -> new)++_setTextWithAttrs :: Widget FormattedText+                  -> [(T.Text, Attr)]+                  -> (FormattedText -> [TextStreamEntity Attr] -> [TextStreamEntity Attr])+                  -> IO ()+_setTextWithAttrs wRef pairs f = do   let streams = map (\(s, a) -> tokenize s a) pairs       ts = concat $ map streamEntities streams    updateWidgetState wRef $ \st ->-      st { text = TS ts }+      st { text = TS $ f st ts }  -- |Low-level text-rendering routine. renderText :: TextStream Attr

@@ -20,6 +20,7 @@     , getText     , currentLine     , cursorPosition+    , lineLengths      -- *Navigation functions     , moveCursor@@ -37,6 +38,7 @@     ) where +import Control.Applicative ((<$>)) import Data.Monoid import qualified Data.Text as T @@ -108,6 +110,13 @@                     , below tz                     ] +-- |Return the lengths of the lines in the zipper.+lineLengths :: (Monoid a) => TextZipper a -> [Int]+lineLengths tz = (length_ tz) <$> concat [ above tz+                                         , [currentLine tz]+                                         , below tz+                                         ]+ -- |Get the cursor position of the zipper; returns @(row, col)@. -- @row@ ranges from @[0..num_rows-1]@ inclusive; @col@ ranges from -- @[0..length of current line]@ inclusive.  Column values equal to@@ -123,7 +132,7 @@ moveCursor (row, col) tz =     let t = getText tz     in if row < 0-           || row > length t+           || row >= length t            || col < 0            || col > length_ tz (t !! row)        then tz

@@ -1,12 +1,12 @@ Name:                vty-ui-Version:             1.6.1+Version:             1.7 Synopsis:   An interactive terminal user interface library for Vty  Description:   An extensible library of user interface widgets for composing and   laying out Vty user interfaces.  This library provides a collection-  of widgets for building and composing interactive interactive,+  of widgets for building and composing interactive,   event-driven terminal interfaces.  This library is intended to make   non-trivial user interfaces easy to express and modify without   having to worry about terminal size.@@ -94,10 +94,10 @@     regex-base >= 0.93 && < 0.94,     directory >= 1.0 && < 1.3,     filepath >= 1.1 && < 1.4,-    unix >= 2.4 && < 2.7,+    unix >= 2.4 && < 2.8,     mtl >= 2.0 && < 2.2,     stm >= 2.1 && < 2.5,-    array >= 0.3.0.0 && < 0.5.0.0,+    array >= 0.3.0.0 && < 0.6.0.0,     text >= 0.11,     vector >= 0.9 @@ -159,6 +159,19 @@         Tests.Tokenize         Tests.TextClip         Tests.TextZipper++Executable vty-ui-collection-demo+  Hs-Source-Dirs:  demos+  GHC-Options:     -Wall+  Main-is:         CollectionDemo.hs+  Build-Depends:+    base >= 4 && < 5,+    mtl >= 2.0 && < 2.2,+    vty >= 4.7.0.18,+    text,+    vty-ui+  if !flag(demos)+    Buildable: False  Executable vty-ui-list-demo   Hs-Source-Dirs:  demos