Garmelon/forest
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Allow multiline editing

Browse source 
Also adds editor key bindings for the home and end keys
This commit is contained in:
Joscha 2020-02-09 21:49:01 +00:00
parent 817b0a34c4
commit e0e23367c8
2 changed files with 20 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

5
client/Main.hs
View file

@ -8,6 +8,7 @@ import Brick.Widgets.Border.Style
import Control.Concurrent.Chan
import Control.Exception
import Control.Monad
import Data.Maybe
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Graphics.Vty as Vty
@ -132,8 +133,8 @@ onKeyWithEditor ed cs ev = do
clientDraw :: ClientState -> [Widget ResourceName]
clientDraw cs = [joinBorders $ withBorderStyle unicode $ tree <+> debug]
where
tree = borderWithLabel (txt "Tree") $ hLimit 50 $ renderTree boxDrawingBranching (csEditor cs) (csTree cs) <=> fill ' '
debug = borderWithLabel (txt "Debug") $ txtWrap (T.pack $ show $ csTree cs) <=> fill ' '
tree = borderWithLabel (txt "Tree") $ renderTree boxDrawingBranching (csEditor cs) (csTree cs)
debug = borderWithLabel (txt "Debug") $ maybe (txt "No editor") (vBox . map txt . getCurrentText) (csEditor cs)
clientHandleEvent :: ClientState -> BrickEvent ResourceName () -> EventM ResourceName (Next ClientState)
clientHandleEvent cs (VtyEvent ev) = case csEditor cs of

24
src/Forest/Client/NodeEditor.hs
View file

@ -2,6 +2,7 @@
module Forest.Client.NodeEditor
( NodeEditor
, getCurrentText
, asReply
, editNode
, replyToNode
@ -22,28 +23,37 @@ data NodeEditor = NodeEditor
, neReply :: Bool
} deriving (Show)
getCurrentText :: NodeEditor -> [T.Text]
getCurrentText = getEditContents . neEditor
asReply :: NodeEditor -> Bool
asReply = neReply
editNode :: T.Text -> NodeEditor
editNode text = NodeEditor
{ neEditor = applyEdit gotoEOL $ editorText RnEditor (Just 1) text
{ neEditor = applyEdit gotoEOL $ editorText RnEditor Nothing text
, neReply = False
}
replyToNode :: NodeEditor
replyToNode = NodeEditor
{ neEditor = editorText RnEditor (Just 1) ""
{ neEditor = editorText RnEditor Nothing ""
, neReply = True
}
edit :: (TextZipper T.Text -> TextZipper T.Text) -> NodeEditor -> EventM ResourceName NodeEditor
edit z ne = pure $ ne{neEditor = applyEdit z $ neEditor ne}
handleNodeEditorEvent :: Vty.Event -> NodeEditor -> EventM ResourceName NodeEditor
handleNodeEditorEvent event es = do
newEditor <- handleEditorEvent event $ neEditor es
pure es{neEditor = newEditor}
handleNodeEditorEvent (Vty.EvKey Vty.KHome _) ne = edit gotoBOL ne
handleNodeEditorEvent (Vty.EvKey Vty.KEnd _) ne = edit gotoEOL ne
handleNodeEditorEvent event ne = do
newEditor <- handleEditorEvent event $ neEditor ne
pure ne{neEditor = newEditor}
renderNodeEditor :: NodeEditor -> Widget ResourceName
renderNodeEditor es = renderEditor renderFunc True $ neEditor es
renderNodeEditor ne = vLimit height $ renderEditor renderFunc True $ neEditor ne
where
height = length $ getCurrentText ne
renderFunc :: [T.Text] -> Widget ResourceName
renderFunc = vBox . map txt
renderFunc = vBox . map (\t -> if T.null t then txt " " else txt t)