diff --git a/Graphics/X11/Types.hsc b/Graphics/X11/Types.hsc --- a/Graphics/X11/Types.hsc +++ b/Graphics/X11/Types.hsc @@ -35,6 +35,7 @@ RROutput, RRCrtc, RRMode, + XRRModeFlags, -- * Enumeration types -- | These types were introduced to make function types clearer. @@ -434,6 +435,10 @@ rrCrtcChangeNotifyMask, rrOutputChangeNotifyMask, rrOutputPropertyNotifyMask, +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H + screenSaverCycleMask, + screenSaverNotifyMask, +#endif -- ** Event types EventType, @@ -476,6 +481,9 @@ rrNotifyOutputChange, rrNotifyOutputProperty, lASTEvent, +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H + screenSaverNotify, +#endif -- ** Modifiers Modifier, @@ -826,7 +834,10 @@ xRR_Rotate_180, xRR_Rotate_270, xRR_Reflect_X, - xRR_Reflect_Y + xRR_Reflect_Y, + xRR_Connected, + xRR_Disconnected, + xRR_UnknownConnection ) where -- import Data.Int @@ -1285,6 +1296,10 @@ , rrCrtcChangeNotifyMask = RRCrtcChangeNotifyMask , rrOutputChangeNotifyMask = RROutputChangeNotifyMask , rrOutputPropertyNotifyMask = RROutputPropertyNotifyMask +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H + , screenSaverCycleMask = ScreenSaverCycleMask + , screenSaverNotifyMask = ScreenSaverNotifyMask +#endif } type EventType = Word32 @@ -1328,6 +1343,9 @@ , rrNotifyOutputChange = RRNotify_OutputChange , rrNotifyOutputProperty=RRNotify_OutputProperty , lASTEvent = LASTEvent +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H + , screenSaverNotify = ScreenSaverNotify +#endif } type Modifier = CUInt @@ -1765,6 +1783,7 @@ type RROutput = #{type RROutput} type RRCrtc = #{type RRCrtc} type RRMode = #{type RRMode} +type XRRModeFlags = #{type XRRModeFlags} #{enum Rotation, , xRR_Rotate_0 = RR_Rotate_0 @@ -1778,3 +1797,8 @@ , xRR_Reflect_Y = RR_Reflect_Y } +#{enum Connection, + , xRR_Connected = RR_Connected + , xRR_Disconnected = RR_Disconnected + , xRR_UnknownConnection = RR_UnknownConnection + } diff --git a/Graphics/X11/XScreenSaver.hsc b/Graphics/X11/XScreenSaver.hsc new file mode 100644 --- /dev/null +++ b/Graphics/X11/XScreenSaver.hsc @@ -0,0 +1,434 @@ +{-# LANGUAGE DeriveDataTypeable, ForeignFunctionInterface #-} +-------------------------------------------------------------------- +-- | +-- Module : Graphics.X11.XScreenSaver +-- Copyright : (c) Joachim Breitner +-- (c) Jochen Keil +-- License : GPL2 +-- +-- Maintainer: Jochen Keil +-- Stability : provisional +-- Portability: portable +-- +-------------------------------------------------------------------- +-- +-- Interface to XScreenSaver API +-- + +#include + +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H + +module Graphics.X11.XScreenSaver ( + getXIdleTime, + XScreenSaverState(..), + XScreenSaverKind(..), + XScreenSaverInfo(..), + XScreenSaverNotifyEvent, + xScreenSaverQueryExtension, + xScreenSaverQueryVersion, + xScreenSaverQueryInfo, + xScreenSaverSelectInput, + xScreenSaverSetAttributes, + xScreenSaverUnsetAttributes, + xScreenSaverSaverRegister, + xScreenSaverUnregister, + xScreenSaverGetRegistered, + xScreenSaverSuspend, + get_XScreenSaverNotifyEvent, + compiledWithXScreenSaver + ) where + +import Graphics.X11.Types +import Graphics.X11.Xlib.Types + +import Foreign +import Foreign.C.Types +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Internal + +import Control.Monad + +-- | XScreenSaverState is for use in both XScreenSaverNotifyEvent and +-- XScreenSaverInfo +-- ScreenSaverCycle is not a valid value for use in XScreenSaverInfo +-- ScreenSaverDisabled will not occur in an XScreenSaverNotifyEvent +data XScreenSaverState + -- | The screen is not currently being saved; til-or-since specifies the + -- number of milliseconds until the screen saver is expected to activate. + = ScreenSaverOff + -- | The screen is currently being saved; til-or-since specifies the number + -- of milliseconds since the screen saver activated. + | ScreenSaverOn + -- | If this bit is set, ScreenSaverNotify events are generated + -- whenever the screen saver cycle interval passes. + | ScreenSaverCycle + -- | The screen saver is currently disabled; til-or-since is zero. + | ScreenSaverDisabled + deriving Show + +-- | Data type for use in a XScreenSaverInfo struct +data XScreenSaverKind + -- | The video signal to the display monitor was disabled. + = ScreenSaverBlanked + -- | A server-dependent, built-in screen saver image was displayed; either + -- no client had set the screen saver window attributes or a different + -- client had the server grabbed when the screen saver activated. + | ScreenSaverInternal + -- | The screen saver window was mapped with attributes set by a client + -- using the ScreenSaverSetAttributes request. + | ScreenSaverExternal + deriving Show + +-- | Representation of the XScreenSaverInfo struct. +data XScreenSaverInfo = XScreenSaverInfo + { xssi_window :: !Window + -- | The state field specified whether or not the screen saver is + -- currently active and how the til-or-since value should be interpreted + , xssi_state :: !XScreenSaverState + -- | The kind field specifies the mechanism that either is currently + -- being used or would have been were the screen being saved + , xssi_kind :: !XScreenSaverKind + , xssi_til_or_since :: !CULong + -- | The idle field specifies the number of milliseconds since the last + -- input was received from the user on any of the input devices. + , xssi_idle :: !CULong + -- | The event-mask field specifies which, if any, screen saver events + -- this client has requested using ScreenSaverSelectInput. + , xssi_event_mask :: !CULong + } deriving (Show) + + +-- | Simple wrapper around 'xScreenSaverQueryInfo' if you are only interested in +-- the idle time, in milliseconds. Returns 0 if the XScreenSaver extension is +-- not available +getXIdleTime :: Display -> IO Int +getXIdleTime dpy = + maybe 0 (fromIntegral . xssi_idle) `fmap` xScreenSaverQueryInfo dpy + +-- We have XScreenSaver, so the library will actually work +compiledWithXScreenSaver :: Bool +compiledWithXScreenSaver = True + +-- for XFree() (already included from scrnsaver.h, but I don't know if I can +-- count on that.) +#include +#include + +xScreenSaverState2CInt :: XScreenSaverState -> CInt +xScreenSaverState2CInt ScreenSaverOn = #const ScreenSaverOn +xScreenSaverState2CInt ScreenSaverOff = #const ScreenSaverOff +xScreenSaverState2CInt ScreenSaverCycle = #const ScreenSaverCycle +xScreenSaverState2CInt ScreenSaverDisabled = #const ScreenSaverDisabled + +cInt2XScreenSaverState :: CInt -> XScreenSaverState +cInt2XScreenSaverState (#const ScreenSaverOn) = ScreenSaverOn +cInt2XScreenSaverState (#const ScreenSaverOff) = ScreenSaverOff +cInt2XScreenSaverState (#const ScreenSaverCycle) = ScreenSaverCycle +cInt2XScreenSaverState (#const ScreenSaverDisabled) = ScreenSaverDisabled +cInt2XScreenSaverState s = error $ + "Unknown state in xScreenSaverQueryInfo for XScreenSaverState: " ++ show s + +instance Storable XScreenSaverState where + sizeOf _ = sizeOf (undefined :: CInt) + alignment _ = alignment (undefined :: CInt) + poke p xsss = poke (castPtr p) (xScreenSaverState2CInt xsss) + peek p = cInt2XScreenSaverState `fmap` peek (castPtr p) + + +xScreenSaverKind2CInt :: XScreenSaverKind -> CInt +xScreenSaverKind2CInt ScreenSaverBlanked = #const ScreenSaverBlanked +xScreenSaverKind2CInt ScreenSaverInternal = #const ScreenSaverInternal +xScreenSaverKind2CInt ScreenSaverExternal = #const ScreenSaverExternal + +cInt2XScreenSaverKind :: CInt -> XScreenSaverKind +cInt2XScreenSaverKind (#const ScreenSaverBlanked) = ScreenSaverBlanked +cInt2XScreenSaverKind (#const ScreenSaverInternal) = ScreenSaverInternal +cInt2XScreenSaverKind (#const ScreenSaverExternal) = ScreenSaverExternal +cInt2XScreenSaverKind s = error $ + "Unknown kind in xScreenSaverQueryInfo for XScreenSaverKind: " ++ show s + +instance Storable XScreenSaverKind where + sizeOf _ = sizeOf (undefined :: CInt) + alignment _ = alignment (undefined :: CInt) + poke p xsss = poke (castPtr p) (xScreenSaverKind2CInt xsss) + peek p = cInt2XScreenSaverKind `fmap` peek (castPtr p) + + +instance Storable XScreenSaverInfo where + sizeOf _ = #{size XScreenSaverInfo} + -- FIXME: Is this right? + alignment _ = alignment (undefined :: CInt) + + poke p xssi = do + #{poke XScreenSaverInfo, window } p $ xssi_window xssi + #{poke XScreenSaverInfo, state } p $ xssi_state xssi + #{poke XScreenSaverInfo, kind } p $ xssi_kind xssi + #{poke XScreenSaverInfo, til_or_since } p $ xssi_til_or_since xssi + #{poke XScreenSaverInfo, idle } p $ xssi_idle xssi + #{poke XScreenSaverInfo, eventMask } p $ xssi_event_mask xssi + + peek p = return XScreenSaverInfo + `ap` (#{peek XScreenSaverInfo, window} p) + `ap` (#{peek XScreenSaverInfo, state} p) + `ap` (#{peek XScreenSaverInfo, kind} p) + `ap` (#{peek XScreenSaverInfo, til_or_since} p) + `ap` (#{peek XScreenSaverInfo, idle} p) + `ap` (#{peek XScreenSaverInfo, eventMask} p) + +type XScreenSaverNotifyEvent = + ( Window -- screen saver window + , Window -- root window of event screen + , CInt -- State: ScreenSaver{Off,On,Cycle} + , CInt -- Kind: ScreenSaver{Blanked,Internal,External} + , Bool -- extents of new region + , Time -- event timestamp + ) + +pokeXScreenSaverNotifyEvent :: Ptr XScreenSaverNotifyEvent + -> XScreenSaverNotifyEvent -> IO () +pokeXScreenSaverNotifyEvent p (window, root, state, kind, forced, time) = do + #{poke XScreenSaverNotifyEvent, window } p window + #{poke XScreenSaverNotifyEvent, root } p root + #{poke XScreenSaverNotifyEvent, state } p state + #{poke XScreenSaverNotifyEvent, kind } p kind + #{poke XScreenSaverNotifyEvent, forced } p forced + #{poke XScreenSaverNotifyEvent, time } p time + +peekXScreenSaverNotifyEvent :: Ptr XScreenSaverNotifyEvent + -> IO XScreenSaverNotifyEvent +peekXScreenSaverNotifyEvent p = do + window <- (#{peek XScreenSaverNotifyEvent, window } p ) + root <- (#{peek XScreenSaverNotifyEvent, root } p ) + state <- (#{peek XScreenSaverNotifyEvent, state } p ) + kind <- (#{peek XScreenSaverNotifyEvent, kind } p ) + forced <- (#{peek XScreenSaverNotifyEvent, forced } p ) + time <- (#{peek XScreenSaverNotifyEvent, time } p ) + return (window, root, state, kind, forced, time) + +get_XScreenSaverNotifyEvent :: XEventPtr -> IO XScreenSaverNotifyEvent +get_XScreenSaverNotifyEvent p = peekXScreenSaverNotifyEvent (castPtr p) + +xScreenSaverQueryExtension :: Display -> IO (Maybe (CInt, CInt)) +xScreenSaverQueryExtension dpy = wrapPtr2 (cXScreenSaverQueryExtension dpy) go + where go False _ _ = Nothing + go True eventbase errorbase = Just ( fromIntegral eventbase + , fromIntegral errorbase + ) + +xScreenSaverQueryVersion :: Display -> IO (Maybe (CInt, CInt)) +xScreenSaverQueryVersion dpy = wrapPtr2 (cXScreenSaverQueryVersion dpy) go + where go False _ _ = Nothing + go True major minor = Just (fromIntegral major, fromIntegral minor) + +wrapPtr2 :: (Storable a, Storable b) + => (Ptr a -> Ptr b -> IO c) -> (c -> a -> b -> d) -> IO d +wrapPtr2 cfun f = withPool $ \pool -> do aptr <- pooledMalloc pool + bptr <- pooledMalloc pool + ret <- cfun aptr bptr + a <- peek aptr + b <- peek bptr + return (f ret a b) + +-- | xScreenSaverQueryInfo returns information about the current state of the +-- screen server. If the xScreenSaver extension is not available, it returns +-- Nothing +xScreenSaverQueryInfo :: Display -> IO (Maybe XScreenSaverInfo) +xScreenSaverQueryInfo dpy = do + p <- cXScreenSaverAllocInfo + if p == nullPtr then return Nothing else do + s <- cXScreenSaverQueryInfo dpy (defaultRootWindow dpy) p + if s == 0 then return Nothing else do + xssi <- peek p + _ <- xFree p + return (Just xssi) + +-- | xScreenSaverSelectInput asks that events related to the screen saver be +-- generated for this client. If no bits are set in event-mask, then no events +-- will be generated. +xScreenSaverSelectInput :: Display -> EventMask -> IO () +xScreenSaverSelectInput dpy xssem = do + p <- cXScreenSaverAllocInfo + if p == nullPtr then return () else do + cXScreenSaverSelectInput dpy (defaultRootWindow dpy) xssem + +-- | XScreenSaverSetAttributes sets the attributes to be used the next time +-- the external screen saver is activated. If another client currently +-- has the attributes set, a BadAccess error is generated and the request +-- is ignored. +-- +-- Otherwise, the specified window attributes are checked as if they were +-- used in a core CreateWindow request whose parent is the root. The +-- override-redirect field is ignored as it is implicitly set to True. If +-- the window attributes result in an error according to the rules for +-- CreateWindow, the request is ignored. +-- +-- Otherwise, the attributes are stored and will take effect on the next +-- activation that occurs when the server is not grabbed by another +-- client. Any resources specified for the background-pixmap or cursor +-- attributes may be freed immediately. The server is free to copy the +-- background-pixmap or cursor resources or to use them in place; therefore, +-- the effect of changing the contents of those resources is undefined. +-- If the specified colormap no longer exists when the screen +-- saver activates, the parent's colormap is used instead. If no errors +-- are generated by this request, any previous screen saver window +-- attributes set by this client are released. +-- +-- When the screen saver next activates and the server is not grabbed by +-- another client, the screen saver window is created, if necessary, and +-- set to the specified attributes and events are generated as usual. The +-- colormap associated with the screen saver window is installed. +-- Finally, the screen saver window is mapped. +-- +-- The window remains mapped and at the top of the stacking order until +-- the screen saver is deactivated in response to activity on any of the +-- user input devices, a ForceScreenSaver request with a value of Reset, +-- or any request that would cause the window to be unmapped. +-- +-- If the screen saver activates while the server is grabbed by another +-- client, the internal saver mechanism is used. The ForceScreenSaver +-- request may be used with a value of Active to deactivate the internal +-- saver and activate the external saver. +-- +-- If the screen saver client's connection to the server is broken while +-- the screen saver is activated and the client's close down mode has not +-- been RetainPermanent or RetainTemporary, the current screen saver is +-- deactivated and the internal screen saver is immediately activated. +-- +-- When the screen saver deactivates, the screen saver window's colormap +-- is uninstalled and the window is unmapped (except as described below). +-- The screen saver XID is disassociated with the window and the server +-- may, but is not required to, destroy the window along with any children. +-- +-- When the screen saver is being deactivated and then immediately reactivated +-- (such as when switching screen savers), the server may leave the +-- screen saver window mapped (typically to avoid generating exposures). + +xScreenSaverSetAttributes :: Display + -> Position -- ^ x + -> Position -- ^ y + -> Dimension -- ^ width + -> Dimension -- ^ height + -> Dimension -- ^ border width + -> CInt -- ^ depth ('defaultDepthOfScreen') + -> WindowClass -- ^ class + -> Visual -- ^ visual ('defaultVisualOfScreen') + -> AttributeMask -- ^ valuemask + -> Ptr SetWindowAttributes + -> IO () +xScreenSaverSetAttributes dpy x y w h bw d wc v am pswa = do + cXScreenSaverSetAttributes dpy (defaultRootWindow dpy) + x y w h bw d wc v am pswa + +-- | XScreenSaverUnsetAttributes instructs the server to discard any previ‐ +-- ous screen saver window attributes set by this client. + +xScreenSaverUnsetAttributes :: Display -> IO () +xScreenSaverUnsetAttributes dpy = + cXScreenSaverUnsetAttributes dpy (defaultRootWindow dpy) + +-- | XScreenSaverRegister stores the given XID in the _SCREEN_SAVER_ID prop‐ +-- erty (of the given type) on the root window of the specified screen. +-- It returns zero if an error is encountered and the property is not +-- changed, otherwise it returns non-zero. + +xScreenSaverSaverRegister :: Display -> ScreenNumber -> XID -> Atom -> IO () +xScreenSaverSaverRegister = cXScreenSaverSaverRegister + +-- | XScreenSaverUnregister removes any _SCREEN_SAVER_ID from the root win‐ +-- dow of the specified screen. It returns zero if an error is encoun‐ +-- tered and the property is changed, otherwise it returns non-zero. + +xScreenSaverUnregister :: Display -> ScreenNumber -> IO Status +xScreenSaverUnregister = cXScreenSaverUnregister + +-- | XScreenSaverGetRegistered returns the XID and type stored in the +-- _SCREEN_SAVER_ID property on the root window of the specified screen. +-- It returns zero if an error is encountered or if the property does not +-- exist or is not of the correct format; otherwise it returns non-zero. + +xScreenSaverGetRegistered :: Display -> ScreenNumber -> XID -> Atom -> IO Status +xScreenSaverGetRegistered = cXScreenSaverGetRegistered + +-- | XScreenSaverSuspend temporarily suspends the screensaver and DPMS timer +-- if suspend is 'True', and restarts the timer if suspend is 'False'. +-- This function should be used by applications that don't want the +-- screensaver or DPMS to become activated while they're for example in +-- the process of playing a media sequence, or are otherwise continuously +-- presenting visual information to the user while in a non-interactive +-- state. This function is not intended to be called by an external +-- screensaver application. +-- +-- If XScreenSaverSuspend is called multiple times with suspend set to +-- 'True', it must be called an equal number of times with suspend set to +-- 'False' in order for the screensaver timer to be restarted. This +-- request has no affect if a client tries to resume the screensaver with‐ +-- out first having suspended it. XScreenSaverSuspend can thus not be +-- used by one client to resume the screensaver if it's been suspended by +-- another client. +-- +-- If a client that has suspended the screensaver becomes disconnected +-- from the X server, the screensaver timer will automatically be +-- restarted, unless it's still suspended by another client. Suspending +-- the screensaver timer doesn't prevent the screensaver from being forceably +-- activated with the ForceScreenSaver request, or a DPMS mode from +-- being set with the DPMSForceLevel request. +-- +-- XScreenSaverSuspend also doesn't deactivate the screensaver or DPMS if +-- either is active at the time the request to suspend them is received by +-- the X server. But once they've been deactivated, they won't automatically +-- be activated again, until the client has canceled the suspension. + +xScreenSaverSuspend :: Display -> Bool -> IO () +xScreenSaverSuspend = cXScreenSaverSuspend + + +foreign import ccall "XScreenSaverQueryExtension" + cXScreenSaverQueryExtension :: Display -> Ptr CInt -> Ptr CInt -> IO Bool + +foreign import ccall "XScreenSaverQueryVersion" + cXScreenSaverQueryVersion :: Display -> Ptr CInt -> Ptr CInt -> IO Bool + +foreign import ccall "XScreenSaverAllocInfo" + cXScreenSaverAllocInfo :: IO (Ptr XScreenSaverInfo) + +foreign import ccall "XScreenSaverQueryInfo" + cXScreenSaverQueryInfo :: Display -> Drawable -> Ptr XScreenSaverInfo + -> IO Status + +foreign import ccall "XScreenSaverSelectInput" + cXScreenSaverSelectInput :: Display -> Drawable -> EventMask -> IO () + +foreign import ccall "XScreenSaverSetAttributes" + cXScreenSaverSetAttributes :: Display -> Drawable -> Position -> Position + -> Dimension -> Dimension -> Dimension + -> CInt + -> WindowClass + -> Visual + -> AttributeMask + -> Ptr SetWindowAttributes + -> IO () + +foreign import ccall "XScreenSaverUnsetAttributes" + cXScreenSaverUnsetAttributes :: Display -> Drawable -> IO () + +foreign import ccall "XScreenSaverRegister" + cXScreenSaverSaverRegister :: Display -> ScreenNumber -> XID -> Atom + -> IO () + +foreign import ccall "XScreenSaverUnregister" + cXScreenSaverUnregister :: Display -> ScreenNumber -> IO Status + +foreign import ccall "XScreenSaverGetRegistered" + cXScreenSaverGetRegistered :: Display -> ScreenNumber -> XID -> Atom + -> IO Status + +foreign import ccall "XScreenSaverSuspend" + cXScreenSaverSuspend :: Display -> Bool -> IO () + +#else +module Graphics.X11.XScreenSaver where + +compiledWithXScreenSaver :: Bool +compiledWithXScreenSaver = False +#endif diff --git a/Graphics/X11/Xinerama.hsc b/Graphics/X11/Xinerama.hsc --- a/Graphics/X11/Xinerama.hsc +++ b/Graphics/X11/Xinerama.hsc @@ -29,6 +29,7 @@ import Foreign.C.Types import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras (WindowAttributes(..), getWindowAttributes) +import Graphics.X11.Xlib.Internal import Control.Monad -- | Representation of the XineramaScreenInfo struct @@ -68,9 +69,6 @@ compiledWithXinerama :: Bool compiledWithXinerama = True --- for XFree() (already included from Xinerama.h, but I don't know if I can count on that.) -#include - #include instance Storable XineramaScreenInfo where @@ -113,7 +111,7 @@ then return Nothing else do nscreens <- peek intp screens <- peekArray (fromIntegral nscreens) p - _ <- cXFree p + _ <- xFree p return (Just screens) foreign import ccall "XineramaQueryExtension" @@ -124,9 +122,6 @@ foreign import ccall "XineramaQueryScreens" cXineramaQueryScreens :: Display -> Ptr CInt -> IO (Ptr XineramaScreenInfo) - -foreign import ccall "XFree" - cXFree :: Ptr a -> IO CInt wrapPtr2 :: (Storable a, Storable b) => (Ptr a -> Ptr b -> IO c) -> (c -> a -> b -> d) -> IO d wrapPtr2 cfun f = diff --git a/Graphics/X11/Xlib.hs b/Graphics/X11/Xlib.hs --- a/Graphics/X11/Xlib.hs +++ b/Graphics/X11/Xlib.hs @@ -26,7 +26,7 @@ -- * Types module Graphics.X11.Types, -- module Graphics.X11.Xlib.Types, - Display(..), Screen, Visual, GC, SetWindowAttributes, + Display(..), Screen, Visual, GC, SetWindowAttributes, VisualInfo(..), Point(..), Rectangle(..), Arc(..), Segment(..), Color(..), Pixel, Position, Dimension, Angle, ScreenNumber, Buffer, diff --git a/Graphics/X11/Xlib/Atom.hsc b/Graphics/X11/Xlib/Atom.hsc --- a/Graphics/X11/Xlib/Atom.hsc +++ b/Graphics/X11/Xlib/Atom.hsc @@ -14,6 +14,8 @@ module Graphics.X11.Xlib.Atom( internAtom, + getAtomName, + getAtomNames, pRIMARY, sECONDARY, @@ -87,9 +89,14 @@ ) where +import Control.Monad ( void ) + import Graphics.X11.Types +import Graphics.X11.Xlib.Internal import Graphics.X11.Xlib.Types +import Foreign hiding ( void ) +import Foreign.C.Types import Foreign.C.String #include "HsXlib.h" @@ -108,9 +115,37 @@ foreign import ccall unsafe "XInternAtom" xInternAtom :: Display -> CString -> Bool -> IO Atom --- XInternAtoms omitted --- XGetAtomName omitted --- XGetAtomNames omitted +-- jrk, 22.11.2012: getAtomName{,s} + +getAtomName :: Display -> Atom -> IO (Maybe String) +getAtomName dpy atom = do + p <- cXGetAtomName dpy atom + if p == nullPtr + then return Nothing + else do + res <- peekCString p + _ <- xFree p + return $ Just res + +foreign import ccall "XGetAtomName" + cXGetAtomName :: Display -> Atom -> IO (Ptr CChar) + +getAtomNames :: Display -> [Atom] -> IO [String] +getAtomNames dpy atoms = withPool $ \pool -> do + atomsp <- (pooledMallocArray pool $ length atoms) :: IO (Ptr Atom) + ccharp <- (pooledMallocArray pool $ length atoms) :: IO (Ptr (Ptr CChar)) + + pokeArray atomsp atoms + void $ cXGetAtomNames dpy atomsp (fromIntegral $ length atoms :: CInt) ccharp + + res <- peekArray (length atoms) ccharp >>= mapM peekCString + peekArray (length atoms) ccharp >>= mapM_ xFree + + return res + +foreign import ccall "XGetAtomNames" + cXGetAtomNames :: Display -> Ptr Atom -> CInt -> Ptr (Ptr CChar) -> IO Status + -- XConvertSelection omitted -- XListProperties omitted -- XChangeProperty omitted 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 @@ -16,7 +16,11 @@ import Data.Maybe import Data.Typeable ( Typeable ) import Graphics.X11.Xrandr +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H +import Graphics.X11.XScreenSaver +#endif 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.C.Types @@ -281,7 +285,20 @@ , ev_timestamp :: !Time , ev_rr_state :: !CInt } - +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H + | ScreenSaverNotifyEvent + { ev_event_type :: !EventType + , ev_serial :: !CULong + , ev_send_event :: !Bool + , ev_event_display :: Display + , ev_window :: !Window + , ev_root :: !Window + , ev_ss_state :: !XScreenSaverState + , ev_ss_kind :: !XScreenSaverKind + , ev_forced :: !Bool + , ev_time :: !Time + } +#endif deriving ( Show, Typeable ) eventTable :: [(EventType, String)] @@ -320,6 +337,9 @@ , (clientMessage , "ClientMessage") , (mappingNotify , "MappingNotify") , (lASTEvent , "LASTEvent") +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H + , (screenSaverNotify , "ScreenSaverNotify") +#endif ] eventName :: Event -> String @@ -804,6 +824,20 @@ , ev_subtype = subtype } +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H + ----------------- + -- ScreenSaverNotifyEvent: + ----------------- + | type_ == screenSaverNotify -> do + return (ScreenSaverNotifyEvent type_ serial send_event display) + `ap` (#{peek XScreenSaverNotifyEvent, window } p ) + `ap` (#{peek XScreenSaverNotifyEvent, root } p ) + `ap` (#{peek XScreenSaverNotifyEvent, state } p ) + `ap` (#{peek XScreenSaverNotifyEvent, kind } p ) + `ap` (#{peek XScreenSaverNotifyEvent, forced } p ) + `ap` (#{peek XScreenSaverNotifyEvent, time } p ) +#endif + -- We don't handle this event specifically, so return the generic -- AnyEvent. | otherwise -> do @@ -880,9 +914,6 @@ configureWindow d w m c = do _ <- with c (xConfigureWindow d w m) return () - -foreign import ccall unsafe "XlibExtras.h XFree" - xFree :: Ptr a -> IO CInt foreign import ccall unsafe "XlibExtras.h XQueryTree" xQueryTree :: Display -> Window -> Ptr Window -> Ptr Window -> Ptr (Ptr Window) -> Ptr CInt -> IO Status diff --git a/Graphics/X11/Xlib/Internal.hsc b/Graphics/X11/Xlib/Internal.hsc new file mode 100644 --- /dev/null +++ b/Graphics/X11/Xlib/Internal.hsc @@ -0,0 +1,20 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.X11.Xlib.Internal +-- Copyright : (c) Daniel Wagner, 2013 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : provisional +-- Portability : portable +-- +-- Functions used often elsewhere in the X11 bindings. +-- +----------------------------------------------------------------------------- + +module Graphics.X11.Xlib.Internal (xFree) where + +import Foreign +import Foreign.C.Types + +foreign import ccall unsafe "XFree" xFree :: Ptr a -> IO CInt diff --git a/Graphics/X11/Xlib/Misc.hsc b/Graphics/X11/Xlib/Misc.hsc --- a/Graphics/X11/Xlib/Misc.hsc +++ b/Graphics/X11/Xlib/Misc.hsc @@ -73,6 +73,23 @@ getPointerControl, warpPointer, + -- * Visuals + visualIDFromVisual, + VisualInfoMask, + visualNoMask, + visualIDMask, + visualScreenMask, + visualDepthMask, + visualClassMask, + visualRedMaskMask, + visualGreenMaskMask, + visualBlueMaskMask, + visualColormapSizeMask, + visualBitsPerRGBMask, + visualAllMask, + getVisualInfo, + matchVisualInfo, + -- * Threads initThreads, lockDisplay, @@ -84,6 +101,7 @@ bitmapBitOrder, bitmapUnit, bitmapPad, + readBitmapFile, -- * Keycodes displayKeycodes, @@ -166,10 +184,12 @@ import Graphics.X11.Xlib.Atom import Graphics.X11.Xlib.Event import Graphics.X11.Xlib.Font +import Graphics.X11.Xlib.Internal -import Foreign (Storable, Ptr, alloca, peek, throwIfNull, with, withArrayLen, allocaBytes, pokeByteOff, withArray, FunPtr, nullPtr, Word32) +import Foreign (Storable, Ptr, alloca, peek, throwIfNull, with, withArrayLen, allocaBytes, pokeByteOff, withArray, FunPtr, nullPtr, Word32, peekArray) import Foreign.C +import Data.Default import System.IO.Unsafe #if __GLASGOW_HASKELL__ @@ -273,9 +293,6 @@ -- XChangeActivePointerGrab omitted --- | interface to the X11 library function @XFree()@. -foreign import ccall unsafe "HsXlib.h XFree" xFree :: Ptr a -> IO () - -- XFreeStringList omitted -- | interface to the X11 library function @XQueryBestTile()@. @@ -675,13 +692,72 @@ ---------------------------------------------------------------- -- | see @XVisualIDFromVisual()@ ---foreign import ccall unsafe "HsXlib.h XVisualIDFromVisual" --- visualIDFromVisual :: Visual -> IO VisualID +foreign import ccall unsafe "HsXlib.h XVisualIDFromVisual" + visualIDFromVisual :: Visual -> IO VisualID --- XGetVisualInfo omitted --- XMatchVisualInfo omitted +instance Default VisualInfo where + def = VisualInfo { + visualInfo_visual = Visual nullPtr, + visualInfo_visualID = 0, + visualInfo_screen = 0, + visualInfo_depth = 0, + visualInfo_class = 0, + visualInfo_redMask = 0, + visualInfo_greenMask = 0, + visualInfo_blueMask = 0, + visualInfo_colormapSize = 0, + visualInfo_bitsPerRGB = 0 + } +type VisualInfoMask = CLong +#{enum VisualInfoMask, + , visualNoMask = VisualNoMask + , visualIDMask = VisualIDMask + , visualScreenMask = VisualScreenMask + , visualDepthMask = VisualDepthMask + , visualClassMask = VisualClassMask + , visualRedMaskMask = VisualRedMaskMask + , visualGreenMaskMask = VisualGreenMaskMask + , visualBlueMaskMask = VisualBlueMaskMask + , visualColormapSizeMask = VisualColormapSizeMask + , visualBitsPerRGBMask = VisualBitsPerRGBMask + , visualAllMask = VisualAllMask + } +-- | interface to the X11 library function @XGetVisualInfo()@ +getVisualInfo :: Display -> VisualInfoMask -> VisualInfo -> IO [VisualInfo] +getVisualInfo dpy mask template = + alloca $ \nItemsPtr -> + with template $ \templatePtr -> do + itemsPtr <- xGetVisualInfo dpy mask templatePtr nItemsPtr + if itemsPtr == nullPtr + then return [] + else do + nItems <- peek nItemsPtr + items <- peekArray (fromIntegral nItems) itemsPtr + _ <- xFree itemsPtr + return items + +foreign import ccall unsafe "XGetVisualInfo" + xGetVisualInfo :: Display -> VisualInfoMask -> Ptr VisualInfo -> + Ptr CInt -> IO (Ptr VisualInfo) + +-- | interface to the X11 library function @XMatchVisualInfo()@ +matchVisualInfo + :: Display -> ScreenNumber -> CInt -> CInt -> IO (Maybe VisualInfo) +matchVisualInfo dpy screen depth class_ = + alloca $ \infoPtr -> do + status <- xMatchVisualInfo dpy screen depth class_ infoPtr + if status == 0 + then return Nothing + else do + info <- peek infoPtr + return $ Just info + +foreign import ccall unsafe "XMatchVisualInfo" + xMatchVisualInfo :: Display -> ScreenNumber -> CInt -> CInt -> + Ptr VisualInfo -> IO Status + ---------------------------------------------------------------- -- Threads ---------------------------------------------------------------- @@ -744,7 +820,7 @@ -- IN Maybe Int y_hot = -1 -- POST: RETVAL == BitmapSuccess --- omitted +-- added: unstable -- IMPURE void XReadBitmapFile(display, d, filename, bitmap, width, height, x_hot, y_hot) RAISES Either -- RETURNTYPE BitmapFileStatus -- GLOBAL ERROR BitmapFileStatus RETVAL @@ -758,6 +834,37 @@ -- OUT Int y_hot RAISES Maybe IF x_hot == -1 -- POST: RETVAL == BitmapSuccess +-- | interface to the X11 library function @XReadBitmapFile@. +readBitmapFile :: Display -> Drawable -> String + -> IO (Either String (Dimension, Dimension, Pixmap, Maybe CInt, Maybe CInt)) +readBitmapFile display d filename = + withCString filename $ \ c_filename -> + alloca $ \ width_return -> + alloca $ \ height_return -> + alloca $ \ bitmap_return -> + alloca $ \ x_hot_return -> + alloca $ \ y_hot_return -> do + rv <- xReadBitmapFile display d c_filename width_return height_return + bitmap_return x_hot_return y_hot_return + width <- peek width_return + height <- peek height_return + bitmap <- peek bitmap_return + x_hot <- peek x_hot_return + y_hot <- peek y_hot_return + let m_x_hot | x_hot == -1 = Nothing + | otherwise = Just x_hot + m_y_hot | y_hot == -1 = Nothing + | otherwise = Just y_hot + case rv of + 0 -> return $ Right (width, height, bitmap, m_x_hot, m_y_hot) + 1 -> return $ Left "readBitmapFile: BitmapOpenFailed" + 2 -> return $ Left "readBitmapFile: BitmapFileInvalid" + 3 -> return $ Left "readBitmapFile: BitmapNoMemory" + _ -> return $ Left "readBitmapFile: BitmapUnknownError" +foreign import ccall unsafe "X11/Xlib.h XReadBitmapFile" + xReadBitmapFile :: Display -> Drawable -> CString -> Ptr Dimension -> Ptr Dimension + -> Ptr Pixmap -> Ptr CInt -> Ptr CInt -> IO CInt + -- XCreateBitmapFromData omitted (awkward looking type) -- XReadBitmapFileData omitted (awkward looking type) @@ -1149,7 +1256,7 @@ xFetchBuffer display nbytes_return buffer nbytes <- peek nbytes_return bytes <- peekCStringLen (c_bytes, (fromIntegral nbytes)) - xFree c_bytes + _ <- xFree c_bytes return bytes foreign import ccall unsafe "HsXlib.h XFetchBuffer" xFetchBuffer :: Display -> Ptr CInt -> CInt -> IO CString @@ -1162,7 +1269,7 @@ xFetchBytes display nbytes_return nbytes <- peek nbytes_return bytes <- peekCStringLen (c_bytes, (fromIntegral nbytes)) - xFree c_bytes + _ <- xFree c_bytes return bytes foreign import ccall unsafe "HsXlib.h XFetchBytes" xFetchBytes :: Display -> Ptr CInt -> IO CString 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 @@ -16,10 +16,13 @@ -- #hide module Graphics.X11.Xlib.Types( Display(..), Screen(..), Visual(..), GC(..), GCValues, SetWindowAttributes, + VisualInfo(..), Image(..), Point(..), Rectangle(..), Arc(..), Segment(..), Color(..), Pixel, Position, Dimension, Angle, ScreenNumber, Buffer ) where +import Graphics.X11.Types + -- import Control.Monad( zipWithM_ ) import Data.Int import Data.Word @@ -85,6 +88,67 @@ #else deriving (Eq, Ord, Show) #endif + +-- | counterpart of an X11 @XVisualInfo@ structure +data VisualInfo = VisualInfo { + visualInfo_visual :: Visual, + visualInfo_visualID :: VisualID, + visualInfo_screen :: ScreenNumber, + visualInfo_depth :: CInt, + visualInfo_class :: CInt, + visualInfo_redMask :: CULong, + visualInfo_greenMask :: CULong, + visualInfo_blueMask :: CULong, + visualInfo_colormapSize :: CInt, + visualInfo_bitsPerRGB :: CInt + } +#if __GLASGOW_HASKELL__ + deriving (Eq, Show, Typeable) +#else + deriving (Eq, Show) +#endif + +instance Storable VisualInfo where + sizeOf _ = #size XVisualInfo + alignment _ = alignment (undefined::CInt) + peek p = do + visual <- Visual `fmap` #{peek XVisualInfo, visual} p + visualID <- #{peek XVisualInfo, visualid} p + screen <- #{peek XVisualInfo, screen} p + depth <- #{peek XVisualInfo, depth} p + class_ <- #{peek XVisualInfo, class} p + redMask <- #{peek XVisualInfo, red_mask} p + greenMask <- #{peek XVisualInfo, green_mask} p + blueMask <- #{peek XVisualInfo, blue_mask} p + colormapSize <- #{peek XVisualInfo, colormap_size} p + bitsPerRGB <- #{peek XVisualInfo, bits_per_rgb} p + return $ VisualInfo { + visualInfo_visual = visual, + visualInfo_visualID = visualID, + visualInfo_screen = screen, + visualInfo_depth = depth, + visualInfo_class = class_, + visualInfo_redMask = redMask, + visualInfo_greenMask = greenMask, + visualInfo_blueMask = blueMask, + visualInfo_colormapSize = colormapSize, + visualInfo_bitsPerRGB = bitsPerRGB + } + poke p info = do + #{poke XVisualInfo, visual} p visualPtr + #{poke XVisualInfo, visualid} p $ visualInfo_visualID info + #{poke XVisualInfo, screen} p $ visualInfo_screen info + #{poke XVisualInfo, depth} p $ visualInfo_depth info + #{poke XVisualInfo, class} p $ visualInfo_class info + #{poke XVisualInfo, red_mask} p $ visualInfo_redMask info + #{poke XVisualInfo, green_mask} p $ visualInfo_greenMask info + #{poke XVisualInfo, blue_mask} p $ visualInfo_blueMask info + #{poke XVisualInfo, colormap_size} p $ + visualInfo_colormapSize info + #{poke XVisualInfo, bits_per_rgb} p $ + visualInfo_bitsPerRGB info + where + ~(Visual visualPtr) = visualInfo_visual info -- | pointer to an X11 @XImage@ structure newtype Image = Image (Ptr Image) diff --git a/Graphics/X11/Xrandr.hsc b/Graphics/X11/Xrandr.hsc --- a/Graphics/X11/Xrandr.hsc +++ b/Graphics/X11/Xrandr.hsc @@ -3,9 +3,12 @@ -- | -- Module : Graphics.X11.Xrandr -- Copyright : (c) Haskell.org, 2012 +-- (c) Jochen Keil, 2012 -- License : BSD3 -- -- Maintainer: Ben Boeckel +-- , Jochen Keil +-- -- Stability : provisional -- Portability: portable -- @@ -16,6 +19,10 @@ module Graphics.X11.Xrandr ( XRRScreenSize(..), + XRRModeInfo(..), + XRRScreenResources(..), + XRROutputInfo(..), + XRRCrtcInfo(..), compiledWithXrandr, Rotation, Reflection, @@ -39,14 +46,23 @@ xrrRotations, xrrSizes, xrrRates, - xrrTimes - ) where + xrrTimes, + xrrGetScreenResources, + xrrGetOutputInfo, + xrrGetCrtcInfo, + xrrGetScreenResourcesCurrent, + xrrSetOutputPrimary, + xrrGetOutputPrimary, + xrrListOutputProperties + ) where import Foreign import Foreign.C.Types +import Foreign.C.String import Control.Monad import Graphics.X11.Xlib.Event +import Graphics.X11.Xlib.Internal import Graphics.X11.Xlib.Types import Graphics.X11.Types @@ -62,7 +78,62 @@ xrr_ss_mheight :: !CInt } deriving (Show) --- We have Xinerama, so the library will actually work +-- | Representation of the XRRModeInfo struct +data XRRModeInfo = XRRModeInfo + { xrr_mi_id :: !RRMode + , xrr_mi_width :: !CUInt + , xrr_mi_height :: !CUInt + , xrr_mi_dotClock :: !CUInt + , xrr_mi_hSyncStart :: !CUInt + , xrr_mi_hSyncEnd :: !CUInt + , xrr_mi_hTotal :: !CUInt + , xrr_mi_hSkew :: !CUInt + , xrr_mi_vSyncStart :: !CUInt + , xrr_mi_vSyncEnd :: !CUInt + , xrr_mi_vTotal :: !CUInt + , xrr_mi_name :: !String + , xrr_mi_modeFlags :: !XRRModeFlags + } deriving (Eq, Show) + +-- | Representation of the XRRScreenResources struct +data XRRScreenResources = XRRScreenResources + { xrr_sr_timestamp :: !Time + , xrr_sr_configTimestamp :: !Time + , xrr_sr_crtcs :: [RRCrtc] + , xrr_sr_outputs :: [RROutput] + , xrr_sr_modes :: [XRRModeInfo] + } deriving (Eq, Show) + +-- | Representation of the XRROutputInfo struct +data XRROutputInfo = XRROutputInfo + { xrr_oi_timestamp :: !Time + , xrr_oi_crtc :: !RRCrtc + , xrr_oi_name :: !String + , xrr_oi_mm_width :: !CULong + , xrr_oi_mm_height :: !CULong + , xrr_oi_connection :: !Connection + , xrr_oi_subpixel_order :: !SubpixelOrder + , xrr_oi_crtcs :: [RRCrtc] + , xrr_oi_clones :: [RROutput] + , xrr_oi_npreferred :: !CInt + , xrr_oi_modes :: [RRMode] + } deriving (Eq, Show) + +-- | Representation of the XRRCrtcInfo struct +data XRRCrtcInfo = XRRCrtcInfo + { xrr_ci_timestamp :: !Time + , xrr_ci_x :: !CInt + , xrr_ci_y :: !CInt + , xrr_ci_width :: !CUInt + , xrr_ci_height :: !CUInt + , xrr_ci_mode :: !RRMode + , xrr_ci_rotation :: !Rotation + , xrr_ci_outputs :: [RROutput] + , xrr_ci_rotations :: !Rotation + , xrr_ci_possible :: [RROutput] + } deriving (Eq, Show) + +-- We have Xrandr, so the library will actually work compiledWithXrandr :: Bool compiledWithXrandr = True @@ -76,22 +147,176 @@ #endif instance Storable XRRScreenSize where - sizeOf _ = #{size XRRScreenSize} - -- FIXME: Is this right? - alignment _ = alignment (undefined :: CInt) + sizeOf _ = #{size XRRScreenSize} + -- FIXME: Is this right? + alignment _ = alignment (undefined :: CInt) - poke p xrr_ss = do - #{poke XRRScreenSize, width } p $ xrr_ss_width xrr_ss - #{poke XRRScreenSize, height } p $ xrr_ss_height xrr_ss - #{poke XRRScreenSize, mwidth } p $ xrr_ss_mwidth xrr_ss - #{poke XRRScreenSize, mheight } p $ xrr_ss_mheight xrr_ss + poke p xrr_ss = do + #{poke XRRScreenSize, width } p $ xrr_ss_width xrr_ss + #{poke XRRScreenSize, height } p $ xrr_ss_height xrr_ss + #{poke XRRScreenSize, mwidth } p $ xrr_ss_mwidth xrr_ss + #{poke XRRScreenSize, mheight } p $ xrr_ss_mheight xrr_ss - peek p = return XRRScreenSize - `ap` (#{peek XRRScreenSize, width} p) - `ap` (#{peek XRRScreenSize, height} p) - `ap` (#{peek XRRScreenSize, mwidth} p) - `ap` (#{peek XRRScreenSize, mheight} p) + peek p = return XRRScreenSize + `ap` (#{peek XRRScreenSize, width} p) + `ap` (#{peek XRRScreenSize, height} p) + `ap` (#{peek XRRScreenSize, mwidth} p) + `ap` (#{peek XRRScreenSize, mheight} p) +instance Storable XRRModeInfo where + sizeOf _ = #{size XRRModeInfo} + -- FIXME: Is this right? + alignment _ = alignment (undefined :: CInt) + + poke p xrr_mi = do + #{poke XRRModeInfo, id } p $ xrr_mi_id xrr_mi + #{poke XRRModeInfo, width } p $ xrr_mi_width xrr_mi + #{poke XRRModeInfo, height } p $ xrr_mi_height xrr_mi + #{poke XRRModeInfo, dotClock } p $ xrr_mi_dotClock xrr_mi + #{poke XRRModeInfo, hSyncStart } p $ xrr_mi_hSyncStart xrr_mi + #{poke XRRModeInfo, hSyncEnd } p $ xrr_mi_hSyncEnd xrr_mi + #{poke XRRModeInfo, hTotal } p $ xrr_mi_hTotal xrr_mi + #{poke XRRModeInfo, hSkew } p $ xrr_mi_hSkew xrr_mi + #{poke XRRModeInfo, vSyncStart } p $ xrr_mi_vSyncStart xrr_mi + #{poke XRRModeInfo, vSyncEnd } p $ xrr_mi_vSyncEnd xrr_mi + #{poke XRRModeInfo, vTotal } p $ xrr_mi_vTotal xrr_mi + #{poke XRRModeInfo, modeFlags } p $ xrr_mi_modeFlags xrr_mi + -- see comment in Storable XRRScreenResources about dynamic resource allocation + #{poke XRRModeInfo, nameLength } p ( 0 :: CInt ) + #{poke XRRModeInfo, name } p ( nullPtr :: Ptr CChar ) + + peek p = return XRRModeInfo + `ap` ( #{peek XRRModeInfo, id } p ) + `ap` ( #{peek XRRModeInfo, width } p ) + `ap` ( #{peek XRRModeInfo, height } p ) + `ap` ( #{peek XRRModeInfo, dotClock } p ) + `ap` ( #{peek XRRModeInfo, hSyncStart } p ) + `ap` ( #{peek XRRModeInfo, hSyncEnd } p ) + `ap` ( #{peek XRRModeInfo, hTotal } p ) + `ap` ( #{peek XRRModeInfo, hSkew } p ) + `ap` ( #{peek XRRModeInfo, vSyncStart } p ) + `ap` ( #{peek XRRModeInfo, vSyncEnd } p ) + `ap` ( #{peek XRRModeInfo, vTotal } p ) + `ap` peekCStringLenIO (#{peek XRRModeInfo, nameLength } p) + (#{peek XRRModeInfo, name } p) + `ap` ( #{peek XRRModeInfo, modeFlags } p ) + + +instance Storable XRRScreenResources where + sizeOf _ = #{size XRRScreenResources} + -- FIXME: Is this right? + alignment _ = alignment (undefined :: CInt) + + poke p xrr_sr = do + #{poke XRRScreenResources, timestamp } p $ xrr_sr_timestamp xrr_sr + #{poke XRRScreenResources, configTimestamp } p $ xrr_sr_configTimestamp xrr_sr + -- there is no simple way to handle ptrs to arrays or struct through ffi + -- Using plain malloc will result in a memory leak, unless the poking + -- function will free the memory manually + -- Unfortunately a ForeignPtr with a Finalizer is not going to work + -- either, because the Finalizer will be run after poke returns, making + -- the allocated memory unusable. + -- The safest option is therefore probably to have the calling function + -- handle this issue for itself + -- e.g. + -- #{poke XRRScreenResources, ncrtc} p ( fromIntegral $ length $ xrr_sr_crtcs xrr_sr :: CInt ) + -- crtcp <- mallocArray $ length $ xrr_sr_crtcs xrr_sr + -- pokeArray crtcp $ xrr_sr_crtcs xrr_sr + -- #{poke XRRScreenResources, crtcs} p crtcp + #{poke XRRScreenResources, ncrtc } p ( 0 :: CInt ) + #{poke XRRScreenResources, noutput } p ( 0 :: CInt ) + #{poke XRRScreenResources, nmode } p ( 0 :: CInt ) + #{poke XRRScreenResources, crtcs } p ( nullPtr :: Ptr RRCrtc ) + #{poke XRRScreenResources, outputs } p ( nullPtr :: Ptr RROutput ) + #{poke XRRScreenResources, modes } p ( nullPtr :: Ptr XRRModeInfo ) + + peek p = return XRRScreenResources + `ap` ( #{peek XRRScreenResources, timestamp } p ) + `ap` ( #{peek XRRScreenResources, configTimestamp } p ) + `ap` peekCArrayIO (#{peek XRRScreenResources, ncrtc } p) + (#{peek XRRScreenResources, crtcs } p) + `ap` peekCArrayIO (#{peek XRRScreenResources, noutput } p) + (#{peek XRRScreenResources, outputs } p) + `ap` peekCArrayIO (#{peek XRRScreenResources, nmode } p) + (#{peek XRRScreenResources, modes } p) + + +instance Storable XRROutputInfo where + sizeOf _ = #{size XRROutputInfo} + -- FIXME: Is this right? + alignment _ = alignment (undefined :: CInt) + + poke p xrr_oi = do + #{poke XRROutputInfo, timestamp } p $ xrr_oi_timestamp xrr_oi + #{poke XRROutputInfo, crtc } p $ xrr_oi_crtc xrr_oi + #{poke XRROutputInfo, mm_width } p $ xrr_oi_mm_width xrr_oi + #{poke XRROutputInfo, mm_height } p $ xrr_oi_mm_height xrr_oi + #{poke XRROutputInfo, connection } p $ xrr_oi_connection xrr_oi + #{poke XRROutputInfo, subpixel_order } p $ xrr_oi_subpixel_order xrr_oi + #{poke XRROutputInfo, npreferred } p $ xrr_oi_npreferred xrr_oi + -- see comment in Storable XRRScreenResources about dynamic resource allocation + #{poke XRROutputInfo, nameLen } p ( 0 :: CInt ) + #{poke XRROutputInfo, ncrtc } p ( 0 :: CInt ) + #{poke XRROutputInfo, nclone } p ( 0 :: CInt ) + #{poke XRROutputInfo, nmode } p ( 0 :: CInt ) + #{poke XRROutputInfo, name } p ( nullPtr :: Ptr CChar ) + #{poke XRROutputInfo, crtcs } p ( nullPtr :: Ptr RRCrtc ) + #{poke XRROutputInfo, clones } p ( nullPtr :: Ptr RROutput ) + #{poke XRROutputInfo, modes } p ( nullPtr :: Ptr RRMode ) + + peek p = return XRROutputInfo + `ap` ( #{peek XRROutputInfo, timestamp } p ) + `ap` ( #{peek XRROutputInfo, crtc } p ) + `ap` peekCStringLenIO (#{peek XRROutputInfo, nameLen } p) + (#{peek XRROutputInfo, name } p) + `ap` ( #{peek XRROutputInfo, mm_width } p ) + `ap` ( #{peek XRROutputInfo, mm_height } p ) + `ap` ( #{peek XRROutputInfo, connection } p ) + `ap` ( #{peek XRROutputInfo, subpixel_order } p ) + `ap` peekCArrayIO (#{peek XRROutputInfo, ncrtc } p) + (#{peek XRROutputInfo, crtcs } p) + `ap` peekCArrayIO (#{peek XRROutputInfo, nclone } p) + (#{peek XRROutputInfo, clones } p) + `ap` ( #{peek XRROutputInfo, npreferred } p ) + `ap` peekCArrayIO (#{peek XRROutputInfo, nmode } p) + (#{peek XRROutputInfo, modes } p) + + +instance Storable XRRCrtcInfo where + sizeOf _ = #{size XRRCrtcInfo} + -- FIXME: Is this right? + alignment _ = alignment (undefined :: CInt) + + poke p xrr_ci = do + #{poke XRRCrtcInfo, timestamp } p $ xrr_ci_timestamp xrr_ci + #{poke XRRCrtcInfo, x } p $ xrr_ci_x xrr_ci + #{poke XRRCrtcInfo, y } p $ xrr_ci_y xrr_ci + #{poke XRRCrtcInfo, width } p $ xrr_ci_width xrr_ci + #{poke XRRCrtcInfo, height } p $ xrr_ci_height xrr_ci + #{poke XRRCrtcInfo, mode } p $ xrr_ci_mode xrr_ci + #{poke XRRCrtcInfo, rotation } p $ xrr_ci_rotation xrr_ci + #{poke XRRCrtcInfo, rotations } p $ xrr_ci_rotations xrr_ci + -- see comment in Storable XRRScreenResources about dynamic resource allocation + #{poke XRRCrtcInfo, noutput } p ( 0 :: CInt ) + #{poke XRRCrtcInfo, npossible } p ( 0 :: CInt ) + #{poke XRRCrtcInfo, outputs } p ( nullPtr :: Ptr RROutput ) + #{poke XRRCrtcInfo, possible } p ( nullPtr :: Ptr RROutput ) + + peek p = return XRRCrtcInfo + `ap` ( #{peek XRRCrtcInfo, timestamp } p ) + `ap` ( #{peek XRRCrtcInfo, x } p ) + `ap` ( #{peek XRRCrtcInfo, y } p ) + `ap` ( #{peek XRRCrtcInfo, width } p ) + `ap` ( #{peek XRRCrtcInfo, height } p ) + `ap` ( #{peek XRRCrtcInfo, mode } p ) + `ap` ( #{peek XRRCrtcInfo, rotation } p ) + `ap` peekCArrayIO (#{peek XRRCrtcInfo, noutput } p) + (#{peek XRRCrtcInfo, outputs } p) + `ap` ( #{peek XRRCrtcInfo, rotations } p ) + `ap` peekCArrayIO (#{peek XRRCrtcInfo, npossible } p) + (#{peek XRRCrtcInfo, possible } p) + + xrrQueryExtension :: Display -> IO (Maybe (CInt, CInt)) xrrQueryExtension dpy = wrapPtr2 (cXRRQueryExtension dpy) go where go False _ _ = Nothing @@ -158,7 +383,7 @@ sizes <- if nsizes == 0 then return Nothing else peekArray (fromIntegral nsizes) p >>= return . Just - _ <- cXFree p + _ <- xFree p return sizes foreign import ccall "XRRConfigSizes" cXRRConfigSizes :: XRRScreenConfiguration -> Ptr CInt -> IO (Ptr XRRScreenSize) @@ -173,7 +398,7 @@ rates <- if nrates == 0 then return Nothing else peekArray (fromIntegral nrates) p >>= return . Just - _ <- cXFree p + _ <- xFree p return rates foreign import ccall "XRRConfigRates" cXRRConfigRates :: XRRScreenConfiguration -> CInt -> Ptr CInt -> IO (Ptr CShort) @@ -226,7 +451,7 @@ sizes <- if nsizes == 0 then return Nothing else peekArray (fromIntegral nsizes) p >>= return . Just - _ <- cXFree p + _ <- xFree p return sizes foreign import ccall "XRRSizes" cXRRSizes :: Display -> CInt -> Ptr CInt -> IO (Ptr XRRScreenSize) @@ -241,7 +466,7 @@ rates <- if nrates == 0 then return Nothing else peekArray (fromIntegral nrates) p >>= return . Just - _ <- cXFree p + _ <- xFree p return rates foreign import ccall "XRRRates" cXRRRates :: Display -> CInt -> CInt -> Ptr CInt -> IO (Ptr CShort) @@ -255,9 +480,109 @@ foreign import ccall "XRRTimes" cXRRTimes :: Display -> CInt -> Ptr Time -> IO Time -foreign import ccall "XFree" - cXFree :: Ptr a -> IO CInt +xrrGetScreenResources :: Display -> Window -> IO (Maybe XRRScreenResources) +xrrGetScreenResources dpy win = do + srp <- cXRRGetScreenResources dpy win + if srp == nullPtr + then return Nothing + else do + res <- peek srp + cXRRFreeScreenResources srp + return $ Just res +foreign import ccall "XRRGetScreenResources" + cXRRGetScreenResources :: Display -> Window -> IO (Ptr XRRScreenResources) + +foreign import ccall "XRRFreeScreenResources" + cXRRFreeScreenResources :: Ptr XRRScreenResources -> IO () + +xrrGetOutputInfo :: Display -> XRRScreenResources -> RROutput -> IO (Maybe XRROutputInfo) +xrrGetOutputInfo dpy xrr_sr rro = withPool $ \pool -> do + -- XRRGetOutputInfo only uses the timestamp field from the + -- XRRScreenResources struct, so it's probably ok to pass the incomplete + -- structure here (see also the poke implementation for the Storable + -- instance of XRRScreenResources) + -- Alternative version below; This is extremely slow, though! + {- xrrGetOutputInfo :: Display -> Window -> RROutput -> IO (Maybe XRROutputInfo) + xrrGetOutputInfo dpy win rro = do + srp <- cXRRGetScreenResources dpy win + oip <- cXRRGetOutputInfo dpy srp rro + cXRRFreeScreenResources srp + -} + oip <- pooledMalloc pool >>= \srp -> do + poke srp xrr_sr + cXRRGetOutputInfo dpy srp rro -- no need to free srp, because pool mem + + if oip == nullPtr + then return Nothing + else do + oi <- peek oip + _ <- cXRRFreeOutputInfo oip + return $ Just oi + +foreign import ccall "XRRGetOutputInfo" + cXRRGetOutputInfo :: Display -> Ptr XRRScreenResources -> RROutput -> IO (Ptr XRROutputInfo) + +foreign import ccall "XRRFreeOutputInfo" + cXRRFreeOutputInfo :: Ptr XRROutputInfo -> IO () + +xrrGetCrtcInfo :: Display -> XRRScreenResources -> RRCrtc -> IO (Maybe XRRCrtcInfo) +xrrGetCrtcInfo dpy xrr_sr crtc = withPool $ \pool -> do + -- XRRGetCrtcInfo only uses the timestamp field from the + -- XRRScreenResources struct, so it's probably ok to pass the incomplete + -- structure here (see also the poke implementation for the Storable + -- instance of XRRScreenResources) + cip <- pooledMalloc pool >>= \srp -> do + poke srp xrr_sr + cXRRGetCrtcInfo dpy srp crtc -- no need to free srp, because pool mem + + if cip == nullPtr + then return Nothing + else do + ci <- peek cip + cXRRFreeCrtcInfo cip + return $ Just ci + +foreign import ccall "XRRGetCrtcInfo" + cXRRGetCrtcInfo :: Display -> Ptr XRRScreenResources -> RRCrtc -> IO (Ptr XRRCrtcInfo) + +foreign import ccall "XRRFreeCrtcInfo" + cXRRFreeCrtcInfo :: Ptr XRRCrtcInfo -> IO () + +foreign import ccall "XRRSetOutputPrimary" + xrrSetOutputPrimary :: Display -> Window -> RROutput -> IO () + +foreign import ccall "XRRGetOutputPrimary" + xrrGetOutputPrimary :: Display -> Window -> IO RROutput + +xrrGetScreenResourcesCurrent :: Display -> Window -> IO (Maybe XRRScreenResources) +xrrGetScreenResourcesCurrent dpy win = do + srcp <- cXRRGetScreenResourcesCurrent dpy win + if srcp == nullPtr + then return Nothing + else do + res <- peek srcp + cXRRFreeScreenResources srcp + return $ Just res + +foreign import ccall "XRRGetScreenResourcesCurrent" + cXRRGetScreenResourcesCurrent :: Display -> Window -> IO (Ptr XRRScreenResources) + +xrrListOutputProperties :: Display -> RROutput -> IO (Maybe [Atom]) +xrrListOutputProperties dpy rro = withPool $ \pool -> do + intp <- pooledMalloc pool + p <- cXRRListOutputProperties dpy rro intp + if p == nullPtr + then return Nothing + else do + nprop <- peek intp + res <- fmap Just $ peekCArray nprop p + _ <- xFree p + return res + +foreign import ccall "XRRListOutputProperties" + cXRRListOutputProperties :: Display -> RROutput -> Ptr CInt -> IO (Ptr Atom) + wrapPtr2 :: (Storable a, Storable b) => (Ptr a -> Ptr b -> IO c) -> (c -> a -> b -> d) -> IO d wrapPtr2 cfun f = withPool $ \pool -> do aptr <- pooledMalloc pool @@ -266,3 +591,12 @@ a <- peek aptr b <- peek bptr return (f ret a b) + +peekCArray :: Storable a => CInt -> Ptr a -> IO [a] +peekCArray n = peekArray (fromIntegral n) + +peekCArrayIO :: Storable a => IO CInt -> IO (Ptr a) -> IO [a] +peekCArrayIO n = join . liftM2 peekCArray n + +peekCStringLenIO :: IO CInt -> IO (Ptr CChar) -> IO String +peekCStringLenIO n p = liftM2 (,) p (fmap fromIntegral n) >>= peekCStringLen diff --git a/X11.buildinfo.in b/X11.buildinfo.in --- a/X11.buildinfo.in +++ b/X11.buildinfo.in @@ -4,4 +4,4 @@ buildable: @BUILD_PACKAGE_BOOL@ cc-options: @X_CFLAGS@ @CPPFLAGS@ ld-options: @X_LIBS@ @LDFLAGS@ -@EXTRA_LIBRARIES@ +extra-libraries: @EXTRA_LIBRARIES@ diff --git a/X11.cabal b/X11.cabal --- a/X11.cabal +++ b/X11.cabal @@ -1,5 +1,5 @@ name: X11 -version: 1.6.0.2 +version: 1.6.1 license: BSD3 license-file: LICENSE copyright: Alastair Reid, 1999-2003, libraries@haskell.org 2003-2007, Don Stewart 2007-2009, Spencer Janssen 2007-2009, Daniel Wagner 2009-2011. @@ -44,6 +44,7 @@ Graphics.X11.Xlib.Extras, Graphics.X11.Xinerama Graphics.X11.Xrandr + Graphics.X11.XScreenSaver Graphics.X11.ExtraTypes, Graphics.X11.ExtraTypes.AP, Graphics.X11.ExtraTypes.DEC, @@ -51,6 +52,8 @@ Graphics.X11.ExtraTypes.Sun Graphics.X11.ExtraTypes.XF86, Graphics.X11.ExtraTypes.XorgDefault + other-modules: + Graphics.X11.Xlib.Internal c-sources: cbits/fdset.c, cbits/auxiliaries.c, @@ -60,6 +63,6 @@ include-dirs: include includes: HsXlib.h, HsAllKeysyms.h install-includes: HsXlib.h, XlibExtras.h, HsAllKeysyms.h - build-depends: base >= 3 && < 5 + build-depends: base >= 3 && < 5, data-default ghc-options: -funbox-strict-fields -Wall -fno-warn-unused-binds ghc-prof-options: -prof -auto-all diff --git a/configure b/configure --- a/configure +++ b/configure @@ -1,11 +1,13 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for Haskell X11 package 1.4.6. +# Generated by GNU Autoconf 2.68 for Haskell X11 package 1.4.6. # # Report bugs to . # # -# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, +# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software +# Foundation, Inc. # # # This configure script is free software; the Free Software Foundation @@ -134,31 +136,6 @@ # CDPATH. (unset CDPATH) >/dev/null 2>&1 && unset CDPATH -# Use a proper internal environment variable to ensure we don't fall - # into an infinite loop, continuously re-executing ourselves. - if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then - _as_can_reexec=no; export _as_can_reexec; - # We cannot yet assume a decent shell, so we have to provide a -# neutralization value for shells without unset; and this also -# works around shells that cannot unset nonexistent variables. -# Preserve -v and -x to the replacement shell. -BASH_ENV=/dev/null -ENV=/dev/null -(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV -case $- in # (((( - *v*x* | *x*v* ) as_opts=-vx ;; - *v* ) as_opts=-v ;; - *x* ) as_opts=-x ;; - * ) as_opts= ;; -esac -exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} -# Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. -$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 -as_fn_exit 255 - fi - # We don't want this to propagate to other subprocesses. - { _as_can_reexec=; unset _as_can_reexec;} if test "x$CONFIG_SHELL" = x; then as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : emulate sh @@ -192,8 +169,7 @@ else exitcode=1; echo positional parameters were not saved. fi -test x\$exitcode = x0 || exit 1 -test -x / || exit 1" +test x\$exitcode = x0 || exit 1" as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && @@ -238,25 +214,21 @@ if test "x$CONFIG_SHELL" != x; then : - export CONFIG_SHELL - # We cannot yet assume a decent shell, so we have to provide a -# neutralization value for shells without unset; and this also -# works around shells that cannot unset nonexistent variables. -# Preserve -v and -x to the replacement shell. -BASH_ENV=/dev/null -ENV=/dev/null -(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV -case $- in # (((( - *v*x* | *x*v* ) as_opts=-vx ;; - *v* ) as_opts=-v ;; - *x* ) as_opts=-x ;; - * ) as_opts= ;; -esac -exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} -# Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. -$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 -exit 255 + # We cannot yet assume a decent shell, so we have to provide a + # neutralization value for shells without unset; and this also + # works around shells that cannot unset nonexistent variables. + # Preserve -v and -x to the replacement shell. + BASH_ENV=/dev/null + ENV=/dev/null + (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV + export CONFIG_SHELL + case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; + esac + exec "$CONFIG_SHELL" $as_opts "$as_myself" ${1+"$@"} fi if test x$as_have_required = xno; then : @@ -359,14 +331,6 @@ } # as_fn_mkdir_p - -# as_fn_executable_p FILE -# ----------------------- -# Test if FILE is an executable regular file. -as_fn_executable_p () -{ - test -f "$1" && test -x "$1" -} # as_fn_executable_p # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take @@ -488,10 +452,6 @@ chmod +x "$as_me.lineno" || { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } - # If we had to re-execute with $CONFIG_SHELL, we're ensured to have - # already done that, so ensure we don't try to do so again and fall - # in an infinite loop. This has already happened in practice. - _as_can_reexec=no; export _as_can_reexec # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). @@ -526,16 +486,16 @@ # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. + # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -pR' + as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else - as_ln_s='cp -pR' + as_ln_s='cp -p' fi else - as_ln_s='cp -pR' + as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null @@ -547,8 +507,28 @@ as_mkdir_p=false fi -as_test_x='test -x' -as_executable_p=as_fn_executable_p +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in #( + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" @@ -686,6 +666,7 @@ enable_x11 with_x with_xinerama +with_xscreensaver with_xorg_keysym ' ac_precious_vars='build_alias @@ -1153,6 +1134,8 @@ if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe + $as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host. + If a cross compiler is detected then cross compile mode will be used" >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi @@ -1319,6 +1302,7 @@ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-x use the X Window System --without-xinerama do not build Xinerama support + --without-xscreensaver do not build XScreenSaver support --without-xorg-keysym do not build X.org keysym support Some influential environment variables: @@ -1399,9 +1383,9 @@ if $ac_init_version; then cat <<\_ACEOF Haskell X11 package configure 1.4.6 -generated by GNU Autoconf 2.69 +generated by GNU Autoconf 2.68 -Copyright (C) 2012 Free Software Foundation, Inc. +Copyright (C) 2010 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF @@ -1514,7 +1498,7 @@ test ! -s conftest.err } && test -s conftest$ac_exeext && { test "$cross_compiling" = yes || - test -x conftest$ac_exeext + $as_test_x conftest$ac_exeext }; then : ac_retval=0 else @@ -1768,7 +1752,7 @@ running configure, to aid debugging if configure makes a mistake. It was created by Haskell X11 package $as_me 1.4.6, which was -generated by GNU Autoconf 2.69. Invocation command line was +generated by GNU Autoconf 2.68. Invocation command line was $ $0 $@ @@ -2158,7 +2142,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}gcc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -2198,7 +2182,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="gcc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -2251,7 +2235,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}cc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -2292,7 +2276,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue @@ -2350,7 +2334,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -2394,7 +2378,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -2840,7 +2824,8 @@ /* end confdefs.h. */ #include #include -struct stat; +#include +#include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); @@ -3833,7 +3818,7 @@ for ac_prog in grep ggrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_GREP" || continue + { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue # Check for GNU ac_path_GREP and select it if it is found. # Check for GNU $ac_path_GREP case `"$ac_path_GREP" --version 2>&1` in @@ -3899,7 +3884,7 @@ for ac_prog in egrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_EGREP" || continue + { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue # Check for GNU ac_path_EGREP and select it if it is found. # Check for GNU $ac_path_EGREP case `"$ac_path_EGREP" --version 2>&1` in @@ -4089,13 +4074,11 @@ done if test "$have_xinerama" = yes; then - EXTRA_LIBRARIES="extra-libraries: Xinerama Xext" + EXTRA_LIBRARIES="Xinerama Xext" else - EXTRA_LIBRARIES="" echo "WARNING: Xinerama headers not found. Building without Xinerama support" fi else - EXTRA_LIBRARIES="" echo "WARNING: Building without Xinerama support per user request" fi @@ -4115,6 +4098,41 @@ as_fn_error $? "X11/extensions/Xrandr.h (from libXrandr) is required" "$LINENO" 5 fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build XScreenSaver" >&5 +$as_echo_n "checking whether to build XScreenSaver... " >&6; } + +# Check whether --with-xscreensaver was given. +if test "${with_xscreensaver+set}" = set; then : + withval=$with_xscreensaver; +else + with_xscreensaver=yes +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $with_xscreensaver" >&5 +$as_echo "$with_xscreensaver" >&6; } + +if test "$with_xscreensaver" = yes; then + for ac_header in X11/extensions/scrnsaver.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "X11/extensions/scrnsaver.h" "ac_cv_header_X11_extensions_scrnsaver_h" "$ac_includes_default" +if test "x$ac_cv_header_X11_extensions_scrnsaver_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_X11_EXTENSIONS_SCRNSAVER_H 1 +_ACEOF + have_xscreensaver=yes +fi + +done + + if test "$have_xscreensaver" = yes; then + EXTRA_LIBRARIES="Xss $EXTRA_LIBRARIES" + else + echo "WARNING: XScreenSaver headers not found. Building without XScreenSaver support" + fi +else + echo "WARNING: Building without XScreenSaver support per user request" +fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to include X.org keysyms" >&5 $as_echo_n "checking whether to include X.org keysyms... " >&6; } @@ -4671,16 +4689,16 @@ # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. + # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -pR' + as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else - as_ln_s='cp -pR' + as_ln_s='cp -p' fi else - as_ln_s='cp -pR' + as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null @@ -4740,16 +4758,28 @@ as_mkdir_p=false fi - -# as_fn_executable_p FILE -# ----------------------- -# Test if FILE is an executable regular file. -as_fn_executable_p () -{ - test -f "$1" && test -x "$1" -} # as_fn_executable_p -as_test_x='test -x' -as_executable_p=as_fn_executable_p +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in #( + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" @@ -4771,7 +4801,7 @@ # values after options handling. ac_log=" This file was extended by Haskell X11 package $as_me 1.4.6, which was -generated by GNU Autoconf 2.69. Invocation command line was +generated by GNU Autoconf 2.68. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -4833,10 +4863,10 @@ ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ Haskell X11 package config.status 1.4.6 -configured by $0, generated by GNU Autoconf 2.69, +configured by $0, generated by GNU Autoconf 2.68, with options \\"\$ac_cs_config\\" -Copyright (C) 2012 Free Software Foundation, Inc. +Copyright (C) 2010 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." @@ -4924,7 +4954,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then - set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion shift \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 CONFIG_SHELL='$SHELL' diff --git a/configure.ac b/configure.ac --- a/configure.ac +++ b/configure.ac @@ -63,19 +63,35 @@ if test "$with_xinerama" = yes; then AC_CHECK_HEADERS([X11/extensions/Xinerama.h], [have_xinerama=yes]) if test "$have_xinerama" = yes; then - EXTRA_LIBRARIES="extra-libraries: Xinerama Xext" + EXTRA_LIBRARIES="Xinerama Xext" else - EXTRA_LIBRARIES="" echo "WARNING: Xinerama headers not found. Building without Xinerama support" fi else - EXTRA_LIBRARIES="" echo "WARNING: Building without Xinerama support per user request" fi AC_CHECK_HEADERS([X11/extensions/Xrandr.h], [have_xrandr=yes]) if ! test "$have_xrandr" = yes; then AC_MSG_ERROR([X11/extensions/Xrandr.h (from libXrandr) is required]) +fi + +AC_MSG_CHECKING([whether to build XScreenSaver]) +AC_ARG_WITH(xscreensaver, + AS_HELP_STRING([--without-xscreensaver], [do not build XScreenSaver support]), + [], + [with_xscreensaver=yes]) +AC_MSG_RESULT([$with_xscreensaver]) + +if test "$with_xscreensaver" = yes; then + AC_CHECK_HEADERS([X11/extensions/scrnsaver.h], [have_xscreensaver=yes]) + if test "$have_xscreensaver" = yes; then + EXTRA_LIBRARIES="Xss $EXTRA_LIBRARIES" + else + echo "WARNING: XScreenSaver headers not found. Building without XScreenSaver support" + fi +else + echo "WARNING: Building without XScreenSaver support per user request" fi AC_MSG_CHECKING([whether to include X.org keysyms]) diff --git a/include/HsX11Config.h.in b/include/HsX11Config.h.in --- a/include/HsX11Config.h.in +++ b/include/HsX11Config.h.in @@ -36,6 +36,9 @@ /* Define to 1 if you have the header file. */ #undef HAVE_X11_DECKEYSYM_H +/* Define to 1 if you have the header file. */ +#undef HAVE_X11_EXTENSIONS_SCRNSAVER_H + /* Define to 1 if you have the header file. */ #undef HAVE_X11_EXTENSIONS_XINERAMA_H diff --git a/include/HsXlib.h b/include/HsXlib.h --- a/include/HsXlib.h +++ b/include/HsXlib.h @@ -20,6 +20,10 @@ #include +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H +#include +#endif + /* Xutil.h overrides some functions with macros. * In recent versions of X this can be turned off with * diff --git a/include/XlibExtras.h b/include/XlibExtras.h --- a/include/XlibExtras.h +++ b/include/XlibExtras.h @@ -19,6 +19,10 @@ #include +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H +#include +#endif + /* Xutil.h overrides some functions with macros. * In recent versions of X this can be turned off with * #define XUTIL_DEFINE_FUNCTIONS