git.iko.soy/vty
on master help sign in
make sure to write all to terminal fd even if write ends early due to TTY buffer full
b797c48Corey O'Connor
src/Graphics/Vty/Output/TerminfoBased.hs+21−5
compare with master
unifiedsplit
@@ -32,9 +32,11 @@ import Data.Foldable (foldMap)
32import Data.IORef
32import Data.IORef
33import Data.Maybe (isJust, isNothing, fromJust)
33import Data.Maybe (isJust, isNothing, fromJust)
34import Data.Monoid
34import Data.Monoid
35+import Data.Word
35
36
36import Foreign.C.Types ( CInt(..), CLong(..) )
37import Foreign.C.Types ( CInt(..), CLong(..) )
37import Foreign.ForeignPtr (withForeignPtr)
38import Foreign.ForeignPtr (withForeignPtr)
39+import Foreign.Ptr (Ptr, plusPtr)
38
40
39import qualified System.Console.Terminfo as Terminfo
41import qualified System.Console.Terminfo as Terminfo
40import System.Posix.IO (fdWriteBuf)
42import System.Posix.IO (fdWriteBuf)
@@ -67,6 +69,19 @@ data DisplayAttrCaps = DisplayAttrCaps
67 , enterBoldMode :: Maybe CapExpression
69 , enterBoldMode :: Maybe CapExpression
68 }
70 }
69
71
72+-- kinda like: https://code.google.com/p/vim/source/browse/src/fileio.c#10422
73+-- fdWriteBuf will throw on error. Unless the error is EINTR. On EINTR the write will be retried.
74+fdWriteAll :: Fd -> Ptr Word8 -> Int -> Int -> IO Int
75+fdWriteAll outFd ptr len count
76+ | len < 0 = fail "fdWriteAll: len is less than 0"
77+ | len == 0 = return count
78+ | otherwise = do
79+ writeCount <- fromEnum <$> fdWriteBuf outFd ptr (toEnum len)
80+ let len' = len - writeCount
81+ ptr' = ptr `plusPtr` writeCount
82+ count' = count + writeCount
83+ fdWriteAll outFd ptr' len' count'
84+
70sendCapToTerminal :: Output -> CapExpression -> [CapParam] -> IO ()
85sendCapToTerminal :: Output -> CapExpression -> [CapParam] -> IO ()
71sendCapToTerminal t cap capParams = do
86sendCapToTerminal t cap capParams = do
72 outputByteBuffer t $ writeToByteString $ writeCapExpr cap capParams
87 outputByteBuffer t $ writeToByteString $ writeCapExpr cap capParams
@@ -137,11 +152,12 @@ reserveTerminal termName outFd = liftIO $ do
137 (w, h) | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show rawSize
152 (w, h) | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show rawSize
138 | otherwise -> return (w,h)
153 | otherwise -> return (w,h)
139 , outputByteBuffer = \outBytes -> do
154 , outputByteBuffer = \outBytes -> do
140− let (fptr, _offset, len) = toForeignPtr outBytes
155+ let (fptr, offset, len) = toForeignPtr outBytes
141− actualLen <- withForeignPtr fptr $ \ptr -> fdWriteBuf outFd ptr (toEnum len)
156+ actualLen <- withForeignPtr fptr
157+ $ \ptr -> fdWriteAll outFd (ptr `plusPtr` offset) len 0
142− when (toEnum len /= actualLen) $ fail $ "Graphics.Vty.Output: outputByteBuffer length "
158+ when (toEnum len /= actualLen) $ fail $ "Graphics.Vty.Output: outputByteBuffer "
143− ++ "mismatch. " ++ show len ++ " /= " ++ show actualLen
159+ ++ "length mismatch. " ++ show len ++ " /= " ++ show actualLen
144− ++ " Please report a bug to vty project."
160+ ++ " Please report this bug to vty project."
145 , contextColorCount
161 , contextColorCount
146 = case supportsNoColors terminfoCaps of
162 = case supportsNoColors terminfoCaps of
147 False -> case Terminfo.getCapability ti (Terminfo.tiGetNum "colors" ) of
163 False -> case Terminfo.getCapability ti (Terminfo.tiGetNum "colors" ) of