@@ -1,3 +1,8 @@
1+{-# LANGUAGE RecordWildCards #-}
2+{-# LANGUAGE CPP #-}
3+{-# LANGUAGE FlexibleInstances #-}
4+{-# OPTIONS_GHC -D_XOPEN_SOURCE=500 #-}
5+{-# CFILES gwinsz.c #-}
16-- | Terminfo based terminal handling.
27--
38-- The color handling assumes tektronix like. No HP support provided. If the terminal is not one I
@@ -5,9 +10,6 @@
510-- assumptions mixed in.
611--
712-- Copyright Corey O'Connor (coreyoconnor@gmail.com)
8−{-# LANGUAGE FlexibleInstances #-}
9−{-# OPTIONS_GHC -D_XOPEN_SOURCE=500 #-}
10−{-# CFILES gwinsz.c #-}
1113module Graphics.Vty.Output.TerminfoBased ( reserve_terminal )
1214 where
1315
@@ -31,11 +33,31 @@ import Data.IORef
3133import Data.Maybe (isJust, isNothing, fromJust)
3234import Data.Monoid
3335
34−import Foreign.C.Types ( CLong(..) )
36+import Foreign.C.Types ( CInt(..), CLong(..) )
3537
3638import GHC.IO.Handle
39+#ifdef __GLASGOW_HASKELL__
40+#if __GLASGOW_HASKELL__ >= 611
41+import GHC.IO.Handle.Internals (withHandle_)
42+import GHC.IO.Handle.Types (Handle__(..))
43+import qualified GHC.IO.FD as FD
44+-- import qualified GHC.IO.Handle.FD as FD
45+import GHC.IO.Exception
46+import Data.Typeable (cast)
47+#else
48+import GHC.IOBase
49+import GHC.Handle hiding (fdToHandle)
50+import qualified GHC.Handle
51+#endif
52+#endif
3753
3854import qualified System.Console.Terminfo as Terminfo
55+#ifdef __GLASGOW_HASKELL__
56+#if __GLASGOW_HASKELL__ >= 611
57+import System.IO.Error
58+#endif
59+#endif
60+import System.Posix.Types (Fd(..))
3961
4062data TerminfoCaps = TerminfoCaps
4163 { smcup :: Maybe CapExpression
@@ -130,7 +152,7 @@ reserve_terminal in_ID out_handle = liftIO $ do
130152 maybe_send_cap rmcup []
131153 maybe_send_cap cnorm []
132154 , display_bounds = do
133− raw_size <- liftIO $ get_window_size
155+ raw_size <- liftIO $ withFd out_handle get_window_size
134156 case raw_size of
135157 (w, h) | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show raw_size
136158 | otherwise -> return (w,h)
@@ -185,11 +207,11 @@ current_display_attr_caps ti
185207 <*> probe_cap ti "dim"
186208 <*> probe_cap ti "bold"
187209
188−foreign import ccall "gwinsz.h vty_c_get_window_size" c_get_window_size :: IO CLong
210+foreign import ccall "gwinsz.h vty_c_get_window_size" c_get_window_size :: Fd -> IO CLong
189211
190−get_window_size :: IO (Int,Int)
191−get_window_size = do
192− (a,b) <- (`divMod` 65536) `fmap` c_get_window_size
212+get_window_size :: Fd -> IO (Int,Int)
213+get_window_size fd = do
214+ (a,b) <- (`divMod` 65536) `fmap` c_get_window_size fd
193215 return (fromIntegral b, fromIntegral a)
194216
195217terminfo_display_context :: Output -> TerminfoCaps -> DisplayRegion -> IO DisplayContext
@@ -433,3 +455,22 @@ style_to_apply_seq s = concat
433455 then []
434456 else [op]
435457
458+-- from https://patch-tag.com/r/mae/sendfile/snapshot/current/content/pretty/src/Network/Socket/SendFile/Internal.hs
459+-- The Fd should not be used after the action returns because the
460+-- Handler may be garbage collected and than will cause the finalizer
461+-- to close the fd.
462+withFd :: Handle -> (Fd -> IO a) -> IO a
463+#ifdef __GLASGOW_HASKELL__
464+#if __GLASGOW_HASKELL__ >= 611
465+withFd h f = withHandle_ "withFd" h $ \ Handle__{..} -> do
466+ case cast haDevice of
467+ Nothing -> ioError (ioeSetErrorString (mkIOError IllegalOperation
468+ "withFd" (Just h) Nothing)
469+ "handle is not a file descriptor")
470+ Just fd -> f (Fd (fromIntegral (FD.fdFD fd)))
471+#else
472+withFd h f =
473+ withHandle_ "withFd" h $ \ h_ ->
474+ f (Fd (fromIntegral (haFD h_)))
475+#endif
476+#endif