@@ -32,9 +32,11 @@ import Data.Foldable (foldMap)
3232import Data.IORef
3333import Data.Maybe (isJust, isNothing, fromJust)
3434import Data.Monoid
35+import Data.Word
3536
3637import Foreign.C.Types ( CInt(..), CLong(..) )
3738import Foreign.ForeignPtr (withForeignPtr)
39+import Foreign.Ptr (Ptr, plusPtr)
3840
3941import qualified System.Console.Terminfo as Terminfo
4042import System.Posix.IO (fdWriteBuf)
@@ -67,6 +69,19 @@ data DisplayAttrCaps = DisplayAttrCaps
6769 , enterBoldMode :: Maybe CapExpression
6870 }
6971
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+
7085sendCapToTerminal :: Output -> CapExpression -> [CapParam] -> IO ()
7186sendCapToTerminal t cap capParams = do
7287 outputByteBuffer t $ writeToByteString $ writeCapExpr cap capParams
@@ -137,11 +152,12 @@ reserveTerminal termName outFd = liftIO $ do
137152 (w, h) | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show rawSize
138153 | otherwise -> return (w,h)
139154 , outputByteBuffer = \outBytes -> do
140− let (fptr, _offset, len) = toForeignPtr outBytes
141− actualLen <- withForeignPtr fptr $ \ptr -> fdWriteBuf outFd ptr (toEnum len)
142− when (toEnum len /= actualLen) $ fail $ "Graphics.Vty.Output: outputByteBuffer length "
143− ++ "mismatch. " ++ show len ++ " /= " ++ show actualLen
144− ++ " Please report a bug to vty project."
155+ let (fptr, offset, len) = toForeignPtr outBytes
156+ actualLen <- withForeignPtr fptr
157+ $ \ptr -> fdWriteAll outFd (ptr `plusPtr` offset) len 0
158+ when (toEnum len /= actualLen) $ fail $ "Graphics.Vty.Output: outputByteBuffer "
159+ ++ "length mismatch. " ++ show len ++ " /= " ++ show actualLen
160+ ++ " Please report this bug to vty project."
145161 , contextColorCount
146162 = case supportsNoColors terminfoCaps of
147163 False -> case Terminfo.getCapability ti (Terminfo.tiGetNum "colors" ) of