diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 --- /dev/null +++ b/CHANGES.md @@ -0,0 +1,46 @@ +# Change Log / Release Notes + +## 1.10.3 (2022-09-14) + + * Added `cWX`, `cWY`, `cWWidth`, `cWHeight` constants (`AttributeMask`) (#82) + + * Added `FocusChangeEvent` to `data Event` (#81) + + * Added `setWMNormalHints` (#83) + +## 1.10.2 (2021-10-24) + + * Restored compatibility with GHC 7.10 (and possibly even older) (#80) + +## 1.10.1 (2021-08-15) + + * Fixed possible high CPU usage of some blocking calls with the threaded RTS (#78) + +## 1.10 (2021-05-31) + + * Added `setClientMessageEvent'` (#71) + + * Fixed type of `xrrUpdateConfiguration` (#72) + + * Fixed bottom when deserializing XRRNotifyEvent in `getEvent` (#72) + + * Added `xrrGetMonitors` and `XRRMonitorInfo` (#42) + + * Added `setClassHint` (#76) + + * Added a few missing event mask fields to `WindowAttributes` (#77) + +## 1.9.2 (2020-08-25) + + * Make sure that X11 search paths determined by autoconf are actually passed + through to Cabal. The fix was contributed by Greg Steuck (#53, #69). + + * Locate the include statement for `HsAllKeysyms.h` above the relevant ifdefs + to avoid issues during cross compilation. The fix was contributed by + Vanessa McHale (#65) + +## 1.8 (February 9, 2017) + + * Added `deleteProperty` + + * Add SelectionClear event to xlib Extra diff --git a/Graphics/X11.hs b/Graphics/X11.hs --- a/Graphics/X11.hs +++ b/Graphics/X11.hs @@ -3,7 +3,7 @@ -- Module : Graphics.X11 -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable @@ -12,11 +12,11 @@ -- ----------------------------------------------------------------------------- -module Graphics.X11 +module Graphics.X11 ( module Graphics.X11.Xlib ) where -import Graphics.X11.Xlib +import Graphics.X11.Xlib ---------------------------------------------------------------- -- End diff --git a/Graphics/X11/ExtraTypes.hs b/Graphics/X11/ExtraTypes.hs --- a/Graphics/X11/ExtraTypes.hs +++ b/Graphics/X11/ExtraTypes.hs @@ -3,7 +3,7 @@ -- Module : Graphics.X11.ExtraTypes -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : unstable -- Portability : unportable @@ -13,24 +13,24 @@ ----------------------------------------------------------------------------- module Graphics.X11.ExtraTypes - ( - -- * Types - module Graphics.X11.ExtraTypes.AP, - module Graphics.X11.ExtraTypes.DEC, - module Graphics.X11.ExtraTypes.HP, - module Graphics.X11.ExtraTypes.Sun, - module Graphics.X11.ExtraTypes.XF86, - module Graphics.X11.ExtraTypes.XorgDefault, - - ) where + ( + -- * Types + module Graphics.X11.ExtraTypes.AP, + module Graphics.X11.ExtraTypes.DEC, + module Graphics.X11.ExtraTypes.HP, + module Graphics.X11.ExtraTypes.Sun, + module Graphics.X11.ExtraTypes.XF86, + module Graphics.X11.ExtraTypes.XorgDefault, + ) where + import Graphics.X11.ExtraTypes.AP import Graphics.X11.ExtraTypes.DEC import Graphics.X11.ExtraTypes.HP import Graphics.X11.ExtraTypes.Sun import Graphics.X11.ExtraTypes.XF86 import Graphics.X11.ExtraTypes.XorgDefault - + ---------------------------------------------------------------- -- End ---------------------------------------------------------------- diff --git a/Graphics/X11/ExtraTypes/HP.hsc b/Graphics/X11/ExtraTypes/HP.hsc --- a/Graphics/X11/ExtraTypes/HP.hsc +++ b/Graphics/X11/ExtraTypes/HP.hsc @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- +-- -- Module : Graphics.X11.ExtraTypes.HP -- Copyright : (c) Open Group 1987,1998, DEC 1987 -- License : X11 (see below) due to X headers diff --git a/Graphics/X11/Types.hsc b/Graphics/X11/Types.hsc --- a/Graphics/X11/Types.hsc +++ b/Graphics/X11/Types.hsc @@ -58,7 +58,7 @@ xK_Delete, xK_Multi_key, - -- SunOS does not define these. + -- SunOS does not define these. #ifdef XK_Codeinput xK_Codeinput, #endif @@ -647,6 +647,10 @@ cWDontPropagate, cWColormap, cWCursor, + cWX, + cWY, + cWWidth, + cWHeight, -- ** Close down modes CloseDownMode, @@ -1536,6 +1540,10 @@ , cWDontPropagate = CWDontPropagate , cWColormap = CWColormap , cWCursor = CWCursor + , cWX = CWX + , cWY = CWY + , cWWidth = CWWidth + , cWHeight = CWHeight } -- Used in ChangeCloseDownMode diff --git a/Graphics/X11/Xinerama.hsc b/Graphics/X11/Xinerama.hsc --- a/Graphics/X11/Xinerama.hsc +++ b/Graphics/X11/Xinerama.hsc @@ -104,10 +104,10 @@ go True major minor = Just (fromIntegral major, fromIntegral minor) xineramaQueryScreens :: Display -> IO (Maybe [XineramaScreenInfo]) -xineramaQueryScreens dpy = +xineramaQueryScreens dpy = withPool $ \pool -> do intp <- pooledMalloc pool p <- cXineramaQueryScreens dpy intp - if p == nullPtr + if p == nullPtr then return Nothing else do nscreens <- peek intp screens <- peekArray (fromIntegral nscreens) p diff --git a/Graphics/X11/Xlib.hs b/Graphics/X11/Xlib.hs --- a/Graphics/X11/Xlib.hs +++ b/Graphics/X11/Xlib.hs @@ -3,7 +3,7 @@ -- Module : Graphics.X11.Xlib -- Copyright : (c) Alastair Reid, 1999-2003 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable @@ -19,18 +19,18 @@ -- ----------------------------------------------------------------------------- -module Graphics.X11.Xlib - ( -- * Conventions - -- $conventions +module Graphics.X11.Xlib + ( -- * Conventions + -- $conventions - -- * Types - module Graphics.X11.Types, + -- * Types + module Graphics.X11.Types, -- module Graphics.X11.Xlib.Types, - Display(..), Screen, Visual, GC, SetWindowAttributes, VisualInfo(..), - Point(..), Rectangle(..), Arc(..), Segment(..), Color(..), - Pixel, Position, Dimension, Angle, ScreenNumber, Buffer, + Display(..), Screen, Visual, GC, SetWindowAttributes, VisualInfo(..), + Point(..), Rectangle(..), Arc(..), Segment(..), Color(..), + Pixel, Position, Dimension, Angle, ScreenNumber, Buffer, - -- * X11 library functions + -- * X11 library functions module Graphics.X11.Xlib.Event, module Graphics.X11.Xlib.Display, module Graphics.X11.Xlib.Screen, @@ -43,8 +43,8 @@ module Graphics.X11.Xlib.Region, module Graphics.X11.Xlib.Image, module Graphics.X11.Xlib.Misc, - - ) where + + ) where import Graphics.X11.Types import Graphics.X11.Xlib.Types diff --git a/Graphics/X11/Xlib/Event.hsc b/Graphics/X11/Xlib/Event.hsc --- a/Graphics/X11/Xlib/Event.hsc +++ b/Graphics/X11/Xlib/Event.hsc @@ -494,7 +494,7 @@ XEventPtr -> IO Status -- | interface to the X11 library function @XWindowEvent()@. -foreign import ccall unsafe "HsXlib.h XWindowEvent" +foreign import ccall safe "HsXlib.h XWindowEvent" windowEvent :: Display -> Window -> EventMask -> XEventPtr -> IO () -- | interface to the X11 library function @XCheckWindowEvent()@. @@ -503,7 +503,7 @@ XEventPtr -> IO Bool -- | interface to the X11 library function @XMaskEvent()@. -foreign import ccall unsafe "HsXlib.h XMaskEvent" +foreign import ccall safe "HsXlib.h XMaskEvent" maskEvent :: Display -> EventMask -> XEventPtr -> IO () -- | interface to the X11 library function @XCheckMaskEvent()@. @@ -524,7 +524,7 @@ putBackEvent :: Display -> XEventPtr -> IO () -- | interface to the X11 library function @XPeekEvent()@. -foreign import ccall unsafe "HsXlib.h XPeekEvent" +foreign import ccall safe "HsXlib.h XPeekEvent" peekEvent :: Display -> XEventPtr -> IO () -- XFilterEvent omitted (can't find documentation) diff --git a/Graphics/X11/Xlib/Extras.hsc b/Graphics/X11/Xlib/Extras.hsc --- a/Graphics/X11/Xlib/Extras.hsc +++ b/Graphics/X11/Xlib/Extras.hsc @@ -23,7 +23,7 @@ import Graphics.X11.Xlib import Graphics.X11.Xlib.Internal import Graphics.X11.Xlib.Types -import Foreign (Storable, Ptr, peek, poke, peekElemOff, pokeElemOff, peekByteOff, pokeByteOff, peekArray, throwIfNull, nullPtr, sizeOf, alignment, alloca, with, throwIf, Word8, Word16, #{type unsigned long}, Int32, plusPtr, castPtr, withArrayLen, setBit, testBit, allocaBytes, FunPtr) +import Foreign (Storable, Ptr, peek, poke, pokeArray, peekElemOff, peekByteOff, pokeByteOff, peekArray, throwIfNull, nullPtr, sizeOf, alignment, alloca, with, throwIf, Word8, Word16, #{type unsigned long}, Int32, plusPtr, castPtr, withArrayLen, setBit, testBit, allocaBytes, FunPtr) import Foreign.C.Types import Foreign.C.String import Control.Monad @@ -220,6 +220,15 @@ , ev_height :: !CInt , ev_count :: !CInt } + | FocusChangeEvent + { ev_event_type :: !EventType + , ev_serial :: !CULong + , ev_send_event :: !Bool + , ev_event_display :: Display + , ev_window :: !Window + , ev_mode :: !NotifyMode + , ev_detail :: !NotifyDetail + } | ClientMessageEvent { ev_event_type :: !EventType , ev_serial :: !CULong @@ -702,6 +711,23 @@ } ------------------------- + -- FocusChangeEvent + ------------------------- + | type_ == focusIn || type_ == focusOut -> do + window <- #{peek XFocusChangeEvent, window } p + mode <- #{peek XFocusChangeEvent, mode } p + detail <- #{peek XFocusChangeEvent, detail } p + return $ FocusChangeEvent + { ev_event_type = type_ + , ev_serial = serial + , ev_send_event = send_event + , ev_event_display = display + , ev_window = window + , ev_mode = mode + , ev_detail = detail + } + + ------------------------- -- ClientMessageEvent ------------------------- | type_ == clientMessage -> do @@ -768,7 +794,7 @@ type_ == rrEventBase + rrNotify -> do window <- #{peek XRRNotifyEvent, window } p subtype <- #{peek XRRNotifyEvent, subtype } p - let subtype_ = fromIntegral subtype_ + let subtype_ = fromIntegral subtype case () of _ | subtype_ == rrNotifyCrtcChange -> do crtc <- #{peek XRRCrtcChangeNotifyEvent, crtc } p @@ -957,6 +983,9 @@ , wa_colormap :: Colormap , wa_map_installed :: Bool , wa_map_state :: CInt + , wa_all_event_masks :: EventMask + , wa_your_event_mask :: EventMask + , wa_do_not_propagate_mask :: EventMask , wa_override_redirect :: Bool } @@ -981,6 +1010,9 @@ `ap` (#{peek XWindowAttributes, colormap } p) `ap` (#{peek XWindowAttributes, map_installed } p) `ap` (#{peek XWindowAttributes, map_state } p) + `ap` (#{peek XWindowAttributes, all_event_masks } p) + `ap` (#{peek XWindowAttributes, your_event_mask } p) + `ap` (#{peek XWindowAttributes, do_not_propagate_mask } p) `ap` (#{peek XWindowAttributes, override_redirect} p) poke p wa = do #{poke XWindowAttributes, x } p $ wa_x wa @@ -991,6 +1023,9 @@ #{poke XWindowAttributes, colormap } p $ wa_colormap wa #{poke XWindowAttributes, map_installed } p $ wa_map_installed wa #{poke XWindowAttributes, map_state } p $ wa_map_state wa + #{poke XWindowAttributes, all_event_masks } p $ wa_all_event_masks wa + #{poke XWindowAttributes, your_event_mask } p $ wa_your_event_mask wa + #{poke XWindowAttributes, do_not_propagate_mask } p $ wa_do_not_propagate_mask wa #{poke XWindowAttributes, override_redirect} p $ wa_override_redirect wa foreign import ccall unsafe "XlibExtras.h XGetWindowAttributes" @@ -1223,14 +1258,22 @@ -- Should have a Storable instance for XEvent/Event? setClientMessageEvent :: XEventPtr -> Window -> Atom -> CInt -> Atom -> Time -> IO () setClientMessageEvent p window message_type format l_0_ l_1_ = do + setClientMessageEvent' p window message_type format [fromIntegral l_0_, fromIntegral l_1_] + +-- slightly less hacky way to set up an XClientMessageEvent +setClientMessageEvent' :: XEventPtr -> Window -> Atom -> CInt -> [CInt] -> IO () +setClientMessageEvent' p window message_type format dat = do #{poke XClientMessageEvent, window} p window #{poke XClientMessageEvent, message_type} p message_type #{poke XClientMessageEvent, format} p format - let datap = #{ptr XClientMessageEvent, data} p :: Ptr CLong - poke datap (fromIntegral l_0_) -- does this work? - pokeElemOff datap 1 (fromIntegral l_1_) - - return () + case format of + 8 -> do let datap = #{ptr XClientMessageEvent, data} p :: Ptr Word8 + pokeArray datap $ take 20 $ map fromIntegral dat ++ repeat 0 + 16 -> do let datap = #{ptr XClientMessageEvent, data} p :: Ptr Word16 + pokeArray datap $ take 10 $ map fromIntegral dat ++ repeat 0 + 32 -> do let datap = #{ptr XClientMessageEvent, data} p :: Ptr CLong + pokeArray datap $ take 5 $ map fromIntegral dat ++ repeat 0 + _ -> error "X11.Extras.setClientMessageEvent': illegal format" setConfigureEvent :: XEventPtr -> Window -> Window -> CInt -> CInt -> CInt -> CInt -> CInt -> Window -> Bool -> IO () setConfigureEvent p ev win x y w h bw abv org = do @@ -1485,7 +1528,20 @@ 0 -> return (SizeHints Nothing Nothing Nothing Nothing Nothing Nothing) _ -> peek sh +foreign import ccall "XlibExtras.h XAllocSizeHints" + xAllocSizeHints :: IO (Ptr SizeHints) +foreign import ccall unsafe "XlibExtras.h XSetWMNormalHints" + xSetWMNormalHints :: Display -> Window -> Ptr SizeHints -> IO () + +setWMNormalHints :: Display -> Window -> SizeHints -> IO () +setWMNormalHints dpy win hints = do + ptr_hints <- throwIfNull "xAllocSizeHints" xAllocSizeHints + poke ptr_hints hints + xSetWMNormalHints dpy win ptr_hints + _ <- xFree ptr_hints + return () + data ClassHint = ClassHint { resName :: String , resClass :: String @@ -1506,6 +1562,18 @@ foreign import ccall unsafe "XlibExtras.h XGetClassHint" xGetClassHint :: Display -> Window -> Ptr ClassHint -> IO Status + +-- | Set the @WM_CLASS@ property for the given window. +setClassHint :: Display -> Window -> ClassHint -> IO () +setClassHint dpy win (ClassHint name cl) = + allocaBytes (#{size XClassHint}) $ \ptr -> do + withCString name $ \c_name -> withCString cl $ \c_cl -> do + #{poke XClassHint, res_name } ptr c_name + #{poke XClassHint, res_class} ptr c_cl + xSetClassHint dpy win ptr + +foreign import ccall unsafe "XlibExtras.h XSetClassHint" + xSetClassHint :: Display -> Window -> Ptr ClassHint -> IO () ------------------------------------------------------------------------ -- WM Hints diff --git a/Graphics/X11/Xlib/Font.hsc b/Graphics/X11/Xlib/Font.hsc --- a/Graphics/X11/Xlib/Font.hsc +++ b/Graphics/X11/Xlib/Font.hsc @@ -20,7 +20,7 @@ fontFromGC, loadQueryFont, freeFont, - FontStruct, + FontStruct, fontFromFontStruct, ascentFromFontStruct, descentFromFontStruct, @@ -55,9 +55,9 @@ -- | pointer to an X11 @XFontStruct@ structure newtype FontStruct = FontStruct (Ptr FontStruct) #if __GLASGOW_HASKELL__ - deriving (Eq, Ord, Show, Typeable, Data) + deriving (Eq, Ord, Show, Typeable, Data) #else - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show) #endif -- Disnae exist: %fun LoadFont :: Display -> String -> IO Font @@ -70,7 +70,7 @@ -- | interface to the X11 library function @XQueryFont()@. foreign import ccall unsafe "HsXlib.h XQueryFont" - queryFont :: Display -> Font -> IO FontStruct + queryFont :: Display -> Font -> IO FontStruct -- Note that this _WILL NOT WORK_ unless you have explicitly set the font. -- I'm slowly but surely coming to the conclusion that Xlib is a pile of @@ -79,40 +79,40 @@ -- | interface to the X11 library function @XGetGCValues()@. fontFromGC :: Display -> GC -> IO Font fontFromGC display gc = - allocaBytes #{size XGCValues} $ \ values -> do - throwIfZero "fontFromGC" $ - xGetGCValues display gc #{const GCFont} values - #{peek XGCValues,font} values + allocaBytes #{size XGCValues} $ \ values -> do + throwIfZero "fontFromGC" $ + xGetGCValues display gc #{const GCFont} values + #{peek XGCValues,font} values foreign import ccall unsafe "HsXlib.h XGetGCValues" - xGetGCValues :: Display -> GC -> ValueMask -> Ptr GCValues -> IO CInt + xGetGCValues :: Display -> GC -> ValueMask -> Ptr GCValues -> IO CInt type ValueMask = #{type unsigned long} -- | interface to the X11 library function @XLoadQueryFont()@. loadQueryFont :: Display -> String -> IO FontStruct loadQueryFont display name = - withCString name $ \ c_name -> do - fs <- throwIfNull "loadQueryFont" $ xLoadQueryFont display c_name - return (FontStruct fs) + withCString name $ \ c_name -> do + fs <- throwIfNull "loadQueryFont" $ xLoadQueryFont display c_name + return (FontStruct fs) foreign import ccall unsafe "HsXlib.h XLoadQueryFont" - xLoadQueryFont :: Display -> CString -> IO (Ptr FontStruct) + xLoadQueryFont :: Display -> CString -> IO (Ptr FontStruct) -- | interface to the X11 library function @XFreeFont()@. foreign import ccall unsafe "HsXlib.h XFreeFont" - freeFont :: Display -> FontStruct -> IO () + freeFont :: Display -> FontStruct -> IO () -- %fun XSetFontPath :: Display -> ListString -> IO () using XSetFontPath(arg1,arg2,arg2_size) fontFromFontStruct :: FontStruct -> Font fontFromFontStruct (FontStruct fs) = unsafePerformIO $ - #{peek XFontStruct,fid} fs + #{peek XFontStruct,fid} fs ascentFromFontStruct :: FontStruct -> Int32 ascentFromFontStruct (FontStruct fs) = unsafePerformIO $ - #{peek XFontStruct,ascent} fs + #{peek XFontStruct,ascent} fs descentFromFontStruct :: FontStruct -> Int32 descentFromFontStruct (FontStruct fs) = unsafePerformIO $ - #{peek XFontStruct,descent} fs + #{peek XFontStruct,descent} fs -- %prim XGetFontPath :: Display -> IO ListString --Int r_size; @@ -135,58 +135,58 @@ -- We marshall this across right away because it's usually one-off info type CharStruct = - ( CInt -- lbearing (origin to left edge of raster) - , CInt -- rbearing (origin to right edge of raster) - , CInt -- width (advance to next char's origin) - , CInt -- ascent (baseline to top edge of raster) - , CInt -- descent (baseline to bottom edge of raster) - -- attributes omitted - ) + ( CInt -- lbearing (origin to left edge of raster) + , CInt -- rbearing (origin to right edge of raster) + , CInt -- width (advance to next char's origin) + , CInt -- ascent (baseline to top edge of raster) + , CInt -- descent (baseline to bottom edge of raster) + -- attributes omitted + ) peekCharStruct :: Ptr CharStruct -> IO CharStruct peekCharStruct p = do - lbearing <- #{peek XCharStruct,lbearing} p - rbearing <- #{peek XCharStruct,rbearing} p - width <- #{peek XCharStruct,width} p - ascent <- #{peek XCharStruct,ascent} p - descent <- #{peek XCharStruct,descent} p - return (fromIntegral (lbearing::CShort), - fromIntegral (rbearing::CShort), - fromIntegral (width::CShort), - fromIntegral (ascent::CShort), - fromIntegral (descent::CShort)) + lbearing <- #{peek XCharStruct,lbearing} p + rbearing <- #{peek XCharStruct,rbearing} p + width <- #{peek XCharStruct,width} p + ascent <- #{peek XCharStruct,ascent} p + descent <- #{peek XCharStruct,descent} p + return (fromIntegral (lbearing::CShort), + fromIntegral (rbearing::CShort), + fromIntegral (width::CShort), + fromIntegral (ascent::CShort), + fromIntegral (descent::CShort)) -- No need to put this in the IO monad - this info is essentially constant -- | interface to the X11 library function @XTextExtents()@. textExtents :: FontStruct -> String -> (FontDirection, Int32, Int32, CharStruct) textExtents font_struct string = unsafePerformIO $ - withCStringLen string $ \ (c_string, nchars) -> - alloca $ \ direction_return -> - alloca $ \ font_ascent_return -> - alloca $ \ font_descent_return -> - allocaBytes #{size XCharStruct} $ \ overall_return -> do - _ <- xTextExtents font_struct c_string (fromIntegral nchars) direction_return - font_ascent_return font_descent_return overall_return - direction <- peek direction_return - ascent <- peek font_ascent_return - descent <- peek font_descent_return - cs <- peekCharStruct overall_return - return (direction, ascent, descent, cs) + withCStringLen string $ \ (c_string, nchars) -> + alloca $ \ direction_return -> + alloca $ \ font_ascent_return -> + alloca $ \ font_descent_return -> + allocaBytes #{size XCharStruct} $ \ overall_return -> do + _ <- xTextExtents font_struct c_string (fromIntegral nchars) direction_return + font_ascent_return font_descent_return overall_return + direction <- peek direction_return + ascent <- peek font_ascent_return + descent <- peek font_descent_return + cs <- peekCharStruct overall_return + return (direction, ascent, descent, cs) foreign import ccall unsafe "HsXlib.h XTextExtents" - xTextExtents :: FontStruct -> CString -> CInt -> - Ptr FontDirection -> Ptr Int32 -> Ptr Int32 -> - Ptr CharStruct -> IO CInt + xTextExtents :: FontStruct -> CString -> CInt -> + Ptr FontDirection -> Ptr Int32 -> Ptr Int32 -> + Ptr CharStruct -> IO CInt -- No need to put ths in the IO monad - this info is essentially constant -- | interface to the X11 library function @XTextWidth()@. textWidth :: FontStruct -> String -> Int32 textWidth font_struct string = unsafePerformIO $ - withCStringLen string $ \ (c_string, len) -> - xTextWidth font_struct c_string (fromIntegral len) + withCStringLen string $ \ (c_string, len) -> + xTextWidth font_struct c_string (fromIntegral len) foreign import ccall unsafe "HsXlib.h XTextWidth" - xTextWidth :: FontStruct -> CString -> CInt -> IO Int32 + xTextWidth :: FontStruct -> CString -> CInt -> IO Int32 -- XTextExtents16 omitted -- XTextWidth16 omitted diff --git a/Graphics/X11/Xlib/Types.hsc b/Graphics/X11/Xlib/Types.hsc --- a/Graphics/X11/Xlib/Types.hsc +++ b/Graphics/X11/Xlib/Types.hsc @@ -35,7 +35,7 @@ import Data.Data #endif -import Data.Default +import Data.Default.Class #include "HsXlib.h" diff --git a/Graphics/X11/Xrandr.hsc b/Graphics/X11/Xrandr.hsc --- a/Graphics/X11/Xrandr.hsc +++ b/Graphics/X11/Xrandr.hsc @@ -24,6 +24,7 @@ XRROutputInfo(..), XRRCrtcInfo(..), XRRPropertyInfo(..), + XRRMonitorInfo(..), compiledWithXrandr, Rotation, Reflection, @@ -59,7 +60,8 @@ xrrConfigureOutputProperty, xrrChangeOutputProperty, xrrGetOutputProperty, - xrrDeleteOutputProperty + xrrDeleteOutputProperty, + xrrGetMonitors, ) where import Foreign @@ -147,6 +149,20 @@ , xrr_pi_values :: [CLong] } deriving (Eq, Show) +-- | Representation of the XRRMonitorInfo struct +data XRRMonitorInfo = XRRMonitorInfo + { xrr_moninf_name :: !Atom + , xrr_moninf_primary :: !Bool + , xrr_moninf_automatic :: !Bool + , xrr_moninf_x :: !CInt + , xrr_moninf_y :: !CInt + , xrr_moninf_width :: !CInt + , xrr_moninf_height :: !CInt + , xrr_moninf_mwidth :: !CInt + , xrr_moninf_mheight :: !CInt + , xrr_moninf_outputs :: [RROutput] + } deriving (Eq, Show) + -- We have Xrandr, so the library will actually work compiledWithXrandr :: Bool compiledWithXrandr = True @@ -215,7 +231,39 @@ (#{peek XRRModeInfo, name } p) `ap` ( #{peek XRRModeInfo, modeFlags } p ) +instance Storable XRRMonitorInfo where + sizeOf _ = #{size XRRMonitorInfo} + -- FIXME: Is this right? + alignment _ = alignment (undefined :: CInt) + poke p xrr_moninf = do + #{poke XRRMonitorInfo, name } p $ xrr_moninf_name xrr_moninf + #{poke XRRMonitorInfo, primary } p $ xrr_moninf_primary xrr_moninf + #{poke XRRMonitorInfo, automatic } p $ xrr_moninf_automatic xrr_moninf + #{poke XRRMonitorInfo, x } p $ xrr_moninf_x xrr_moninf + #{poke XRRMonitorInfo, y } p $ xrr_moninf_y xrr_moninf + #{poke XRRMonitorInfo, width } p $ xrr_moninf_width xrr_moninf + #{poke XRRMonitorInfo, height } p $ xrr_moninf_height xrr_moninf + #{poke XRRMonitorInfo, mwidth } p $ xrr_moninf_mwidth xrr_moninf + #{poke XRRMonitorInfo, mheight } p $ xrr_moninf_mheight xrr_moninf + -- see comment in Storable XRRScreenResources about dynamic resource allocation + #{poke XRRMonitorInfo, noutput } p ( 0 :: CInt ) + #{poke XRRMonitorInfo, outputs } p ( nullPtr :: Ptr RROutput ) + + peek p = return XRRMonitorInfo + `ap` ( #{peek XRRMonitorInfo, name } p ) + `ap` ( #{peek XRRMonitorInfo, primary } p ) + `ap` ( #{peek XRRMonitorInfo, automatic } p ) + `ap` ( #{peek XRRMonitorInfo, x } p ) + `ap` ( #{peek XRRMonitorInfo, y } p ) + `ap` ( #{peek XRRMonitorInfo, width } p ) + `ap` ( #{peek XRRMonitorInfo, height } p ) + `ap` ( #{peek XRRMonitorInfo, mwidth } p ) + `ap` ( #{peek XRRMonitorInfo, mheight } p ) + `ap` peekCArrayIO (#{peek XRRMonitorInfo, noutput } p) + (#{peek XRRMonitorInfo, outputs } p) + + instance Storable XRRScreenResources where sizeOf _ = #{size XRRScreenResources} -- FIXME: Is this right? @@ -460,10 +508,10 @@ foreign import ccall "XRRSelectInput" cXRRSelectInput :: Display -> Window -> CInt -> IO () -xrrUpdateConfiguration :: XEvent -> IO CInt +xrrUpdateConfiguration :: XEventPtr -> IO CInt xrrUpdateConfiguration = cXRRUpdateConfiguration foreign import ccall "XRRUpdateConfiguration" - cXRRUpdateConfiguration :: XEvent -> IO CInt + cXRRUpdateConfiguration :: XEventPtr -> IO CInt xrrRotations :: Display -> CInt -> IO (Rotation, Rotation) xrrRotations dpy screen = @@ -692,6 +740,24 @@ xrrDeleteOutputProperty = cXRRDeleteOutputProperty foreign import ccall "XRRDeleteOutputProperty" cXRRDeleteOutputProperty :: Display -> RROutput -> Atom -> IO () + +xrrGetMonitors :: Display -> Drawable -> Bool -> IO (Maybe [XRRMonitorInfo]) +xrrGetMonitors dpy draw get_active = withPool $ \pool -> do + intp <- pooledMalloc pool + p <- cXRRGetMonitors dpy draw get_active intp + if p == nullPtr + then return Nothing + else do + nmonitors <- peek intp + res <- fmap Just $ peekCArray nmonitors p + cXRRFreeMonitors p + return res + +foreign import ccall "XRRGetMonitors" + cXRRGetMonitors :: Display -> Drawable -> Bool -> Ptr CInt -> IO (Ptr XRRMonitorInfo) + +foreign import ccall "XRRFreeMonitors" + cXRRFreeMonitors :: Ptr XRRMonitorInfo -> IO () wrapPtr2 :: (Storable a, Storable b) => (Ptr a -> Ptr b -> IO c) -> (c -> a -> b -> d) -> IO d wrapPtr2 cfun f = diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,33 @@ +# Haskell binding to the X11 graphics library [![Hackage](https://img.shields.io/hackage/v/X11.svg?style=flat)](https://hackage.haskell.org/package/X11) [![Build Status](https://img.shields.io/travis/xmonad/X11.svg?style=flat)](https://travis-ci.org/xmonad/X11) + +To build this package using Cabal directly from Git, you must run +`autoreconf` before the usual Cabal build steps (configure/build/install). +`autoreconf` is included in the GNU autoconf tools. There is no need to run +the `configure` script: the `cabal configure` step will do this for you. + +If you are building from a source tarball, you can just use the standard Cabal +installation stanza: + + cabal configure + cabal build + cabal install + +Xinerama support is enabled by default if Xinerama headers are detected. To +disable Xinerama support, add the `--without-xinerama` flag to +`configure-option`: + + cabal configure --configure-option="--without-xinerama" + +However, if you are building from Git, X11 uses `autoconf`, so you need +to have `autoconf` installed and run `autoconf`/`autoheader` before building: + + autoconf + autoheader + +or + + autoreconf + +You will need development versions of at least the X11, xrandr, and XScreenSaver +libraries installed for the build to succeed; having the development version of +the Xinerama library will enable some optional bindings. diff --git a/X11.cabal b/X11.cabal --- a/X11.cabal +++ b/X11.cabal @@ -1,5 +1,5 @@ name: X11 -version: 1.9.2 +version: 1.10.3 synopsis: A binding to the X11 graphics library description: A Haskell binding to the X11 graphics library. The binding is a direct translation of the C binding; for documentation of these calls, refer @@ -10,8 +10,7 @@ copyright: Alastair Reid, 1999-2003, libraries@haskell.org 2003-2007, Don Stewart 2007-2009, Spencer Janssen 2007-2009, Daniel Wagner 2009-2011. maintainer: Daniel Wagner -tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, - GHC == 8.4.3, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.2 +tested-with: GHC == 7.10.3 || == 8.0.2 || == 8.2.2 || == 8.4.4 || == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.2 category: Graphics homepage: https://github.com/xmonad/X11 bug-reports: https://github.com/xmonad/X11/issues @@ -23,7 +22,9 @@ X11.buildinfo include/HsX11Config.h include/X11_extras_config.h -extra-source-files: configure.ac +extra-source-files: CHANGES.md + README.md + configure.ac configure config.mk.in X11.buildinfo.in @@ -38,6 +39,11 @@ type: git location: https://github.com/xmonad/X11 +flag pedantic + description: Be pedantic (-Werror and the like) + default: False + manual: True + library exposed-modules: Graphics.X11 Graphics.X11.ExtraTypes @@ -67,7 +73,7 @@ Graphics.X11.Xlib.Window Graphics.X11.Xrandr other-modules: Graphics.X11.Xlib.Internal - build-depends: base == 4.*, data-default + build-depends: base == 4.*, data-default-class == 0.1.* default-language: Haskell98 default-extensions: CPP ForeignFunctionInterface @@ -78,5 +84,5 @@ include-dirs: include ghc-options: -funbox-strict-fields -Wall -fno-warn-unused-binds - if impl(ghc >= 7.10) - ghc-options: -fno-warn-tabs + if flag(pedantic) + ghc-options: -Werror diff --git a/configure b/configure --- a/configure +++ b/configure @@ -662,6 +662,7 @@ docdir oldincludedir includedir +runstatedir localstatedir sharedstatedir sysconfdir @@ -737,6 +738,7 @@ sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' +runstatedir='${localstatedir}/run' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' @@ -989,6 +991,15 @@ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; + -runstatedir | --runstatedir | --runstatedi | --runstated \ + | --runstate | --runstat | --runsta | --runst | --runs \ + | --run | --ru | --r) + ac_prev=runstatedir ;; + -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ + | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ + | --run=* | --ru=* | --r=*) + runstatedir=$ac_optarg ;; + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ @@ -1126,7 +1137,7 @@ for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ - libdir localedir mandir + libdir localedir mandir runstatedir do eval ac_val=\$$ac_var # Remove trailing slashes. @@ -1279,6 +1290,7 @@ --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] diff --git a/configure.ac b/configure.ac --- a/configure.ac +++ b/configure.ac @@ -9,7 +9,7 @@ # Safety check: Ensure that we are in the correct source directory. AC_CONFIG_SRCDIR([include/HsXlib.h]) -AC_CONFIG_HEADERS([include/HsX11Config.h include/X11_extras_config.h]) +AC_CONFIG_HEADERS([include/HsX11Config.h include/X11_extras_config.h]) # Check for X11 include paths and libraries AC_PATH_XTRA diff --git a/include/HsXlib.h b/include/HsXlib.h --- a/include/HsXlib.h +++ b/include/HsXlib.h @@ -24,7 +24,7 @@ /* Xutil.h overrides some functions with macros. * In recent versions of X this can be turned off with * - * #define XUTIL_DEFINE_FUNCTIONS + * #define XUTIL_DEFINE_FUNCTIONS * * before the #include, but this doesn't work with older versions. * As a workaround, we undef the macros here. Note that this is only