git.iko.soy/reflex-vty
on develop help sign in
Add PageUp and PageDown
d37db9aAli Abrar
src/Data/Text/Zipper.hs+12
compare with develop
unifiedsplit
@@ -81,6 +81,18 @@ down z@(TextZipper lb b a la) = case la of
81 let (b', a') = T.splitAt (T.length b) l
81 let (b', a') = T.splitAt (T.length b) l
82 in TextZipper ((b <> a) : lb) b' a' ls
82 in TextZipper ((b <> a) : lb) b' a' ls
83
83
84+-- | Move the cursor up by the given number of lines
85+pageUp :: Int -> TextZipper -> TextZipper
86+pageUp pageSize z = if pageSize <= 0
87+ then z
88+ else pageUp (pageSize - 1) $ up z
89+
90+-- | Move the cursor down by the given number of lines
91+pageDown :: Int -> TextZipper -> TextZipper
92+pageDown pageSize z = if pageSize <= 0
93+ then z
94+ else pageDown (pageSize - 1) $ down z
95+
84-- | Move the cursor to the beginning of the current logical line
96-- | Move the cursor to the beginning of the current logical line
85home :: TextZipper -> TextZipper
97home :: TextZipper -> TextZipper
86home (TextZipper lb b a la) = TextZipper lb "" (b <> a) la
98home (TextZipper lb b a la) = TextZipper lb "" (b <> a) la
src/Reflex/Vty/Widget/Input/Text.hs+14−6
@@ -39,15 +39,15 @@ textInput
39textInput cfg = do
39textInput cfg = do
40 i <- input
40 i <- input
41 f <- focus
41 f <- focus
42+ dh <- displayHeight
43+ dw <- displayWidth
42 rec v <- foldDyn ($) (_textInputConfig_initialValue cfg) $ mergeWith (.)
44 rec v <- foldDyn ($) (_textInputConfig_initialValue cfg) $ mergeWith (.)
43− [ updateTextZipper (_textInputConfig_tabWidth cfg) <$> i
45+ [ uncurry (updateTextZipper (_textInputConfig_tabWidth cfg)) <$> attach (current dh) i
44 , _textInputConfig_modify cfg
46 , _textInputConfig_modify cfg
45 , let displayInfo = (,) <$> rows <*> scrollTop
47 , let displayInfo = (,) <$> rows <*> scrollTop
46 in ffor (attach (current displayInfo) click) $ \((dl, st), MouseDown _ (mx, my) _) ->
48 in ffor (attach (current displayInfo) click) $ \((dl, st), MouseDown _ (mx, my) _) ->
47 goToDisplayLinePosition mx (st + my) dl
49 goToDisplayLinePosition mx (st + my) dl
48 ]
50 ]
49− dw <- displayWidth
50− dh <- displayHeight
51 click <- mouseDown V.BLeft
51 click <- mouseDown V.BLeft
52 let cursorAttrs = ffor f $ \x -> if x then cursorAttributes else V.defAttr
52 let cursorAttrs = ffor f $ \x -> if x then cursorAttributes else V.defAttr
53 let rows = (\w s c -> displayLines w V.defAttr c s) <$> dw <*> v <*> cursorAttrs
53 let rows = (\w s c -> displayLines w V.defAttr c s) <$> dw <*> v <*> cursorAttrs
@@ -96,10 +96,16 @@ spanToImage :: Span V.Attr -> V.Image
96spanToImage (Span attrs t) = V.text' attrs t
96spanToImage (Span attrs t) = V.text' attrs t
97
97
98-- | Default vty event handler for text inputs
98-- | Default vty event handler for text inputs
99−updateTextZipper :: Int -> V.Event -> TextZipper -> TextZipper
99+updateTextZipper
100+ :: Int -- ^ Tab width
101+ -> Int -- ^ Page size
102+ -> V.Event -- ^ The vty event to handle
103+ -> TextZipper -- ^ The zipper to modify
104+ -> TextZipper
100−updateTextZipper tabWidth ev = case ev of
105+updateTextZipper tabWidth pageSize ev = case ev of
101− -- Regular characters
106+ -- Special characters
102 V.EvKey (V.KChar '\t') [] -> tab tabWidth
107 V.EvKey (V.KChar '\t') [] -> tab tabWidth
108+ -- Regular characters
103 V.EvKey (V.KChar k) [] -> insertChar k
109 V.EvKey (V.KChar k) [] -> insertChar k
104 -- Deletion buttons
110 -- Deletion buttons
105 V.EvKey V.KBS [] -> deleteLeft
111 V.EvKey V.KBS [] -> deleteLeft
@@ -114,4 +120,6 @@ updateTextZipper tabWidth ev = case ev of
114 V.EvKey V.KDown [] -> down
120 V.EvKey V.KDown [] -> down
115 V.EvKey V.KHome [] -> home
121 V.EvKey V.KHome [] -> home
116 V.EvKey V.KEnd [] -> end
122 V.EvKey V.KEnd [] -> end
123+ V.EvKey V.KPageUp [] -> pageUp pageSize
124+ V.EvKey V.KPageDown [] -> pageDown pageSize
117 _ -> id
125 _ -> id