on master help sign in
clear to eol on row end when using terminfo based terminal
e5eaad5Corey O'Connor
src/Data/Terminfo/Eval.hs+1−1
@@ -162,7 +162,7 @@ serialize_cap_ops :: OutputBuffer -> CapOps -> EvalT IO OutputBuffer
162serialize_cap_ops out_ptr ops = foldM serialize_cap_op out_ptr ops
162serialize_cap_ops out_ptr ops = foldM serialize_cap_op out_ptr ops
163
163
164serialize_cap_op :: OutputBuffer -> CapOp -> EvalT IO OutputBuffer
164serialize_cap_op :: OutputBuffer -> CapOp -> EvalT IO OutputBuffer
165−serialize_cap_op !out_ptr ( Bytes !offset !byte_count !next_offset ) = do
165+serialize_cap_op !out_ptr (Bytes !offset !byte_count !next_offset) = do
166 !cap <- get >>= return . eval_expression
166 !cap <- get >>= return . eval_expression
167 let ( !start_ptr, _ ) = cap_bytes cap
167 let ( !start_ptr, _ ) = cap_bytes cap
168 !src_ptr = start_ptr `plusPtr` offset
168 !src_ptr = start_ptr `plusPtr` offset
src/Data/Terminfo/Parse.hs+14−3
@@ -21,6 +21,8 @@ import Foreign.C.Types
21import Foreign.Marshal.Array
21import Foreign.Marshal.Array
22import Foreign.Ptr
22import Foreign.Ptr
23
23
24+import Numeric (showHex)
25+
24import Text.ParserCombinators.Parsec
26import Text.ParserCombinators.Parsec
25
27
26type CapBytes = ( Ptr Word8, CSize )
28type CapBytes = ( Ptr Word8, CSize )
@@ -31,7 +33,16 @@ data CapExpression = CapExpression
31 , source_string :: !String
33 , source_string :: !String
32 , param_count :: !Word
34 , param_count :: !Word
33 , param_ops :: !ParamOps
35 , param_ops :: !ParamOps
34− }
36+ } deriving (Eq)
37+
38+instance Show CapExpression where
39+ show c
40+ = "CapExpression { " ++ show (cap_ops c) ++ " }"
41+ ++ " <- [" ++ hex_dump ( map ( toEnum . fromEnum ) $! source_string c ) ++ "]"
42+ ++ " <= " ++ show (source_string c)
43+ where
44+ hex_dump :: [Word8] -> String
45+ hex_dump = foldr (\b s -> showHex b s) ""
35
46
36instance NFData CapExpression where
47instance NFData CapExpression where
37 rnf (CapExpression ops !_bytes !str !c !p_ops)
48 rnf (CapExpression ops !_bytes !str !c !p_ops)
@@ -55,7 +66,7 @@ data CapOp =
55 | BitwiseOr | BitwiseXOr | BitwiseAnd
66 | BitwiseOr | BitwiseXOr | BitwiseAnd
56 | ArithPlus | ArithMinus
67 | ArithPlus | ArithMinus
57 | CompareEq | CompareLt | CompareGt
68 | CompareEq | CompareLt | CompareGt
58− deriving ( Show )
69+ deriving (Show, Eq)
59
70
60instance NFData CapOp where
71instance NFData CapOp where
61 rnf (Bytes offset _count next_offset) = rnf offset `seq` rnf next_offset
72 rnf (Bytes offset _count next_offset) = rnf offset `seq` rnf next_offset
@@ -76,7 +87,7 @@ instance NFData CapOp where
76type ParamOps = [ParamOp]
87type ParamOps = [ParamOp]
77data ParamOp =
88data ParamOp =
78 IncFirstTwo
89 IncFirstTwo
79− deriving ( Show )
90+ deriving (Show, Eq)
80
91
81instance NFData ParamOp where
92instance NFData ParamOp where
82 rnf IncFirstTwo = ()
93 rnf IncFirstTwo = ()
src/Graphics/Vty/Terminal/Interface.hs+10−2
@@ -88,6 +88,8 @@ display_context t r = liftIO $ do
88 , serialize_set_attr = serialize_set_attr self
88 , serialize_set_attr = serialize_set_attr self
89 , default_attr_required_bytes = default_attr_required_bytes self
89 , default_attr_required_bytes = default_attr_required_bytes self
90 , serialize_default_attr = serialize_default_attr self
90 , serialize_default_attr = serialize_default_attr self
91+ , row_end_required_bytes = row_end_required_bytes self
92+ , serialize_row_end = serialize_row_end self
91 , inline_hack = return ()
93 , inline_hack = return ()
92 }
94 }
93 mfix (mk_display_context t . def_context)
95 mfix (mk_display_context t . def_context)
@@ -120,6 +122,8 @@ data DisplayContext = DisplayContext
120 -- | Reset the display attributes to the default display attributes
122 -- | Reset the display attributes to the default display attributes
121 , default_attr_required_bytes :: Int
123 , default_attr_required_bytes :: Int
122 , serialize_default_attr :: OutputBuffer -> IO OutputBuffer
124 , serialize_default_attr :: OutputBuffer -> IO OutputBuffer
125+ , row_end_required_bytes :: Int
126+ , serialize_row_end :: OutputBuffer -> IO OutputBuffer
123 -- | See Graphics.Vty.Terminal.XTermColor.inline_hack
127 -- | See Graphics.Vty.Terminal.XTermColor.inline_hack
124 , inline_hack :: IO ()
128 , inline_hack :: IO ()
125 }
129 }
@@ -236,7 +240,7 @@ span_op_required_bytes dc fattr (AttributeChange attr) =
236 in (c, fattr')
240 in (c, fattr')
237span_op_required_bytes _dc fattr (TextSpan _ _ str) = (utf8_text_required_bytes str, fattr)
241span_op_required_bytes _dc fattr (TextSpan _ _ str) = (utf8_text_required_bytes str, fattr)
238span_op_required_bytes _dc _fattr (Skip _) = error "span_op_required_bytes for Skip."
242span_op_required_bytes _dc _fattr (Skip _) = error "span_op_required_bytes for Skip."
239−span_op_required_bytes _dc fattr (RowEnd _) = (0,fattr)
243+span_op_required_bytes dc fattr (RowEnd _) = (row_end_required_bytes dc, fattr)
240
244
241serialize_output_ops :: DisplayContext
245serialize_output_ops :: DisplayContext
242 -> OutputBuffer
246 -> OutputBuffer
@@ -272,6 +276,8 @@ serialize_span_ops dc y out_ptr in_fattr span_ops = do
272 (out_ptr', in_fattr)
276 (out_ptr', in_fattr)
273 span_ops
277 span_ops
274
278
279+-- |
280+-- TODO: move this into the terminal implementation?
275serialize_span_op :: DisplayContext
281serialize_span_op :: DisplayContext
276 -> SpanOp
282 -> SpanOp
277 -> OutputBuffer
283 -> OutputBuffer
@@ -287,7 +293,9 @@ serialize_span_op _dc (TextSpan _ _ str) out_ptr fattr = do
287 out_ptr' <- serialize_utf8_text str out_ptr
293 out_ptr' <- serialize_utf8_text str out_ptr
288 return (out_ptr', fattr)
294 return (out_ptr', fattr)
289serialize_span_op _dc (Skip _) _out_ptr _fattr = error "serialize_span_op for Skip"
295serialize_span_op _dc (Skip _) _out_ptr _fattr = error "serialize_span_op for Skip"
290−serialize_span_op _dc (RowEnd _) out_ptr fattr = return (out_ptr, fattr)
296+serialize_span_op dc (RowEnd _) out_ptr fattr = do
297+ out_ptr' <- serialize_row_end dc out_ptr
298+ return (out_ptr', fattr)
291
299
292send_to_terminal :: Terminal -> Int -> (Ptr Word8 -> IO (Ptr Word8)) -> IO ()
300send_to_terminal :: Terminal -> Int -> (Ptr Word8 -> IO (Ptr Word8)) -> IO ()
293send_to_terminal t c f = allocaBytes (fromEnum c) $ \start_ptr -> do
301send_to_terminal t c f = allocaBytes (fromEnum c) $ \start_ptr -> do
src/Graphics/Vty/Terminal/Mock.hs+5
@@ -79,6 +79,11 @@ mock_terminal r = liftIO $ do
79 , serialize_default_attr = \ptr -> do
79 , serialize_default_attr = \ptr -> do
80 poke ptr (toEnum $ fromEnum 'D')
80 poke ptr (toEnum $ fromEnum 'D')
81 return $ ptr `plusPtr` 1
81 return $ ptr `plusPtr` 1
82+ -- row end is always visualized as the single character 'E'
83+ , row_end_required_bytes = 1
84+ , serialize_row_end = \ptr -> do
85+ poke ptr (toEnum $ fromEnum 'E')
86+ return $ ptr `plusPtr` 1
82 }
87 }
83 }
88 }
84
89
src/Graphics/Vty/Terminal/TerminfoBased.hs+5−1
@@ -47,6 +47,7 @@ data TerminfoCaps = TerminfoCaps
47 , set_back_color :: CapExpression
47 , set_back_color :: CapExpression
48 , set_default_attr :: CapExpression
48 , set_default_attr :: CapExpression
49 , clear_screen :: CapExpression
49 , clear_screen :: CapExpression
50+ , clear_eol :: CapExpression
50 , display_attr_caps :: DisplayAttrCaps
51 , display_attr_caps :: DisplayAttrCaps
51 }
52 }
52
53
@@ -109,6 +110,7 @@ reserve_terminal in_ID out_handle = liftIO $ mfix $ \self -> do
109 <*> pure set_back_cap
110 <*> pure set_back_cap
110 <*> require_cap ti "sgr0"
111 <*> require_cap ti "sgr0"
111 <*> require_cap ti "clear"
112 <*> require_cap ti "clear"
113+ <*> require_cap ti "el"
112 <*> current_display_attr_caps ti
114 <*> current_display_attr_caps ti
113 let send_cap s = send_cap_to_terminal self (s terminfo_caps)
115 let send_cap s = send_cap_to_terminal self (s terminfo_caps)
114 maybe_send_cap s = when (isJust $ s terminfo_caps) . send_cap (fromJust . s)
116 maybe_send_cap s = when (isJust $ s terminfo_caps) . send_cap (fromJust . s)
@@ -212,7 +214,9 @@ mk_terminfo_display_context terminfo_caps self = do
212 , attr_required_bytes = \_prev_attr _req_attr _diffs -> assumed_attr_required_bytes
214 , attr_required_bytes = \_prev_attr _req_attr _diffs -> assumed_attr_required_bytes
213 , serialize_set_attr = terminfo_serialize_set_attr self terminfo_caps
215 , serialize_set_attr = terminfo_serialize_set_attr self terminfo_caps
214 , default_attr_required_bytes = cap_expression_required_bytes (set_default_attr terminfo_caps) []
216 , default_attr_required_bytes = cap_expression_required_bytes (set_default_attr terminfo_caps) []
215− , serialize_default_attr = \out_ptr -> serialize_cap_expression (set_default_attr terminfo_caps) [] out_ptr
217+ , serialize_default_attr = serialize_cap_expression (set_default_attr terminfo_caps) []
218+ , row_end_required_bytes = cap_expression_required_bytes (clear_eol terminfo_caps) []
219+ , serialize_row_end = serialize_cap_expression (clear_eol terminfo_caps) []
216 }
220 }
217
221
218-- | Instead of evaluating all the rules related to setting display attributes twice (once in
222-- | Instead of evaluating all the rules related to setting display attributes twice (once in
test/Verify/Data/Terminfo/Parse.hs−6
@@ -12,12 +12,6 @@ import Data.Word
12
12
13import Numeric
13import Numeric
14
14
15−instance Show CapExpression where
16− show c
17− = "CapExpression { " ++ show (cap_ops c) ++ " }"
18− ++ " <- [" ++ hex_dump ( map ( toEnum . fromEnum ) $! source_string c ) ++ "]"
19− ++ " <= " ++ show (source_string c)
20−
21hex_dump :: [Word8] -> String
15hex_dump :: [Word8] -> String
22hex_dump bytes = foldr (\b s -> showHex b s) "" bytes
16hex_dump bytes = foldr (\b s -> showHex b s) "" bytes
23
17