From fac0b5c4fced9cf6054cd68b76d54de06b70fd43 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Mon, 13 Aug 2012 09:39:05 +0200 Subject: [PATCH 01/16] Import (incomplete) bindings to XScreenSaver extension Written by Joachim Breitner: http://darcs.nomeata.de/arbtt/src/Graphics/X11/XScreenSaver.hsc Sorry, no darcs2git here. --- Graphics/X11/XScreenSaver.hsc | 187 ++++++++++++++++++++++++++++++++++ 1 file changed, 187 insertions(+) create mode 100644 Graphics/X11/XScreenSaver.hsc diff --git a/Graphics/X11/XScreenSaver.hsc b/Graphics/X11/XScreenSaver.hsc new file mode 100644 index 0000000..f1950d0 --- /dev/null +++ b/Graphics/X11/XScreenSaver.hsc @@ -0,0 +1,187 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +-------------------------------------------------------------------- +-- | +-- Module : Graphics.X11.XScreenSaver +-- Copyright : (c) Joachim Breitner +-- License : GPL2 +-- +-- Maintainer: Joachim Breitner +-- Stability : provisional +-- Portability: portable +-- +-------------------------------------------------------------------- +-- +-- Interface to XScreenSaver API +-- + +module Graphics.X11.XScreenSaver ( + getXIdleTime, + XScreenSaverState(..), + XScreenSaverKind(..), + XScreenSaverInfo(..), + xScreenSaverQueryExtension, + xScreenSaverQueryVersion, + xScreenSaverQueryInfo, + compiledWithXScreenSaver + ) where + +import Foreign +import Foreign.C.Types +import Graphics.X11.Xlib +import Control.Monad + +data XScreenSaverState = ScreenSaverOff | ScreenSaverOn | ScreenSaverDisabled deriving Show +data XScreenSaverKind = ScreenSaverBlanked | ScreenSaverInternal | ScreenSaverExternal deriving Show + +-- | Representation of the XScreenSaverInfo struct. +data XScreenSaverInfo = XScreenSaverInfo + { xssi_window :: !Window, + xssi_state :: !XScreenSaverState, +-- ^ The state field specified whether or not the screen saver is currently +-- active and how the til-or-since value should be interpreted: +-- +-- ['ScreenSaverOff'] The screen is not currently being saved; til-or-since specifies the +-- number of milliseconds until the screen saver is expected to activate. +-- +-- ['ScreenSaverOn'] The screen is currently being saved; til-or-since specifies the number +-- of milliseconds since the screen saver activated. +-- +-- ['ScreenSaverDisabled'] The screen saver is currently disabled; til-or-since is zero. + xssi_kind :: !XScreenSaverKind, +-- ^ The kind field specifies the mechanism that either is currently being used +-- or would have been were the screen being saved: +-- +-- ['ScreenSaverBlanked'] The video signal to the display monitor was disabled. +-- +-- ['ScreenSaverInternal'] 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. +-- +-- ['ScreenSaverExternal'] The screen saver window was mapped with attributes set by a client +-- using the ScreenSaverSetAttributes request. + xssi_til_or_since :: !CULong, + xssi_idle :: !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_event_mask :: !CULong +-- ^ The event-mask field specifies which, if any, screen saver events this +-- client has requested using ScreenSaverSelectInput. + } 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 ScreenSaverDisabled = #const ScreenSaverDisabled + +cInt2XScreenSaverState :: CInt -> XScreenSaverState +cInt2XScreenSaverState (#const ScreenSaverOn) = ScreenSaverOn +cInt2XScreenSaverState (#const ScreenSaverOff) = ScreenSaverOff +cInt2XScreenSaverState (#const ScreenSaverDisabled) = ScreenSaverDisabled +cInt2XScreenSaverState _ = error "Unknown state in xScreenSaverQueryInfo" + +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 _ = error "Unknown kind in xScreenSaverQueryInfo" + +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) + + +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 + cXFree p + return (Just xssi) + +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 "XFree" + cXFree :: Ptr a -> IO CInt From f57259f69b113c0be2507ca79f31ffab25ded688 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Mon, 13 Aug 2012 10:07:01 +0200 Subject: [PATCH 02/16] Add XScreenSaver to build system so that it is built and installed --- Makefile.nhc98 | 1 + X11.cabal | 1 + 2 files changed, 2 insertions(+) diff --git a/Makefile.nhc98 b/Makefile.nhc98 index 0878be2..37cddb0 100644 --- a/Makefile.nhc98 +++ b/Makefile.nhc98 @@ -20,6 +20,7 @@ SRCS = \ Graphics/X11/Xlib/Window.hs \ Graphics.X11.Xlib.Extras \ Graphics.X11.Xinerama \ + Graphics.X11.XScreenSaver \ fdset.c \ XUtils.c \ auxiliaries.c diff --git a/X11.cabal b/X11.cabal index 3773a33..e1efbbd 100644 --- a/X11.cabal +++ b/X11.cabal @@ -44,6 +44,7 @@ library Graphics.X11.Xlib.Extras, Graphics.X11.Xinerama Graphics.X11.Xrandr + Graphics.X11.XScreenSaver Graphics.X11.ExtraTypes, Graphics.X11.ExtraTypes.AP, Graphics.X11.ExtraTypes.DEC, From 7f25c628c041c06ae93790051ff4275b6b0953dc Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Mon, 13 Aug 2012 10:07:21 +0200 Subject: [PATCH 03/16] Reformat code (cosmetic surgery) Indendation with 4 ws as tab, 80 char line limit, comma first --- Graphics/X11/XScreenSaver.hsc | 167 ++++++++++++++++++---------------- 1 file changed, 91 insertions(+), 76 deletions(-) diff --git a/Graphics/X11/XScreenSaver.hsc b/Graphics/X11/XScreenSaver.hsc index f1950d0..a174b69 100644 --- a/Graphics/X11/XScreenSaver.hsc +++ b/Graphics/X11/XScreenSaver.hsc @@ -30,55 +30,66 @@ import Foreign.C.Types import Graphics.X11.Xlib import Control.Monad -data XScreenSaverState = ScreenSaverOff | ScreenSaverOn | ScreenSaverDisabled deriving Show -data XScreenSaverKind = ScreenSaverBlanked | ScreenSaverInternal | ScreenSaverExternal deriving Show +data XScreenSaverState = ScreenSaverOff + | ScreenSaverOn + | ScreenSaverDisabled + deriving Show + +data XScreenSaverKind = ScreenSaverBlanked + | ScreenSaverInternal + | ScreenSaverExternal + deriving Show -- | Representation of the XScreenSaverInfo struct. data XScreenSaverInfo = XScreenSaverInfo - { xssi_window :: !Window, - xssi_state :: !XScreenSaverState, + { xssi_window :: !Window + , xssi_state :: !XScreenSaverState -- ^ The state field specified whether or not the screen saver is currently -- active and how the til-or-since value should be interpreted: -- --- ['ScreenSaverOff'] 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 not currently being saved; til-or-since +-- specifies the number of milliseconds until the screen saver is expected to +-- activate. -- --- ['ScreenSaverOn'] The screen is currently being saved; til-or-since specifies the number --- of milliseconds since the screen saver activated. +-- ['ScreenSaverOn'] The screen is currently being saved; til-or-since specifies +-- the number of milliseconds since the screen saver activated. -- --- ['ScreenSaverDisabled'] The screen saver is currently disabled; til-or-since is zero. - xssi_kind :: !XScreenSaverKind, +-- ['ScreenSaverDisabled'] The screen saver is currently disabled; til-or-since +-- is zero. + , xssi_kind :: !XScreenSaverKind -- ^ The kind field specifies the mechanism that either is currently being used -- or would have been were the screen being saved: -- -- ['ScreenSaverBlanked'] The video signal to the display monitor was disabled. -- --- ['ScreenSaverInternal'] 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'] 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. -- --- ['ScreenSaverExternal'] The screen saver window was mapped with attributes set by a client --- using the ScreenSaverSetAttributes request. - xssi_til_or_since :: !CULong, - xssi_idle :: !CULong, +-- ['ScreenSaverExternal'] The screen saver window was mapped with attributes +-- set by a client using the ScreenSaverSetAttributes request. + , xssi_til_or_since :: !CULong + , xssi_idle :: !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_event_mask :: !CULong + , xssi_event_mask :: !CULong -- ^ The event-mask field specifies which, if any, screen saver events this -- client has requested using ScreenSaverSelectInput. - } deriving (Show) + } 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 +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.) +-- for XFree() (already included from scrnsaver.h, but I don't know if I can +-- count on that.) #include #include @@ -94,11 +105,11 @@ cInt2XScreenSaverState (#const ScreenSaverDisabled) = ScreenSaverDisabled cInt2XScreenSaverState _ = error "Unknown state in xScreenSaverQueryInfo" 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) - + 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 @@ -112,76 +123,80 @@ cInt2XScreenSaverKind (#const ScreenSaverExternal) = ScreenSaverExternal cInt2XScreenSaverKind _ = error "Unknown kind in xScreenSaverQueryInfo" 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) - + 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) + 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) 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) + 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) + 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 +-- 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 - cXFree p - return (Just xssi) + 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 + cXFree p + return (Just xssi) foreign import ccall "XScreenSaverQueryExtension" - cXScreenSaverQueryExtension :: Display -> Ptr CInt -> Ptr CInt -> IO Bool + cXScreenSaverQueryExtension :: Display -> Ptr CInt -> Ptr CInt -> IO Bool foreign import ccall "XScreenSaverQueryVersion" - cXScreenSaverQueryVersion :: Display -> Ptr CInt -> Ptr CInt -> IO Bool + cXScreenSaverQueryVersion :: Display -> Ptr CInt -> Ptr CInt -> IO Bool foreign import ccall "XScreenSaverAllocInfo" - cXScreenSaverAllocInfo :: IO (Ptr XScreenSaverInfo) + cXScreenSaverAllocInfo :: IO (Ptr XScreenSaverInfo) foreign import ccall "XScreenSaverQueryInfo" - cXScreenSaverQueryInfo :: Display -> Drawable -> Ptr XScreenSaverInfo -> IO Status + cXScreenSaverQueryInfo :: Display -> Drawable -> Ptr XScreenSaverInfo + -> IO Status foreign import ccall "XFree" - cXFree :: Ptr a -> IO CInt + cXFree :: Ptr a -> IO CInt From 49dd5f3a820bd5a53f66584893b1dc4c14409d4d Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Tue, 14 Aug 2012 09:20:42 +0200 Subject: [PATCH 04/16] Check for extensions/scrnsaver.h and issue an error if not available --- configure.ac | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/configure.ac b/configure.ac index 1623858..8f3fda5 100644 --- a/configure.ac +++ b/configure.ac @@ -78,6 +78,11 @@ if ! test "$have_xrandr" = yes; then AC_MSG_ERROR([X11/extensions/Xrandr.h (from libXrandr) is required]) fi +AC_CHECK_HEADERS([X11/extensions/scrnsaver.h], [have_xrandr=yes]) +if ! test "$have_xrandr" = yes; then + AC_MSG_ERROR([X11/extensions/scrnsaver.h (XScreenSaver) is required]) +fi + AC_MSG_CHECKING([whether to include X.org keysyms]) AC_ARG_WITH(xorg-keysym, AS_HELP_STRING([--without-xorg-keysym], [do not build X.org keysym support]), From 3a416420c444eab551c4aaacc1684877366fd94c Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Tue, 14 Aug 2012 09:21:40 +0200 Subject: [PATCH 05/16] include extensions/scrnsaver.h to make its contents available --- include/HsXlib.h | 1 + include/XlibExtras.h | 1 + 2 files changed, 2 insertions(+) diff --git a/include/HsXlib.h b/include/HsXlib.h index 921768b..f1bbfa2 100644 --- a/include/HsXlib.h +++ b/include/HsXlib.h @@ -19,6 +19,7 @@ #include #include +#include /* 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 index 33953b8..cb532ee 100644 --- a/include/XlibExtras.h +++ b/include/XlibExtras.h @@ -18,6 +18,7 @@ #include #include +#include /* Xutil.h overrides some functions with macros. * In recent versions of X this can be turned off with From 67e97d49846389480780456cbcd4b9d467b9f847 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Tue, 14 Aug 2012 09:23:37 +0200 Subject: [PATCH 06/16] Add some basic data types from scrnsaver.h (untyped, only aliases) --- Graphics/X11/Types.hsc | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Graphics/X11/Types.hsc b/Graphics/X11/Types.hsc index f7a4603..ba01ce3 100644 --- a/Graphics/X11/Types.hsc +++ b/Graphics/X11/Types.hsc @@ -434,6 +434,8 @@ module Graphics.X11.Types rrCrtcChangeNotifyMask, rrOutputChangeNotifyMask, rrOutputPropertyNotifyMask, + screenSaverCycleMask, + screenSaverNotifyMask, -- ** Event types EventType, @@ -476,6 +478,7 @@ module Graphics.X11.Types rrNotifyOutputChange, rrNotifyOutputProperty, lASTEvent, + screenSaverNotify, -- ** Modifiers Modifier, @@ -1285,6 +1288,8 @@ type EventMask = Mask , rrCrtcChangeNotifyMask = RRCrtcChangeNotifyMask , rrOutputChangeNotifyMask = RROutputChangeNotifyMask , rrOutputPropertyNotifyMask = RROutputPropertyNotifyMask + , screenSaverCycleMask = ScreenSaverCycleMask + , screenSaverNotifyMask = ScreenSaverNotifyMask } type EventType = Word32 @@ -1328,6 +1333,7 @@ type EventType = Word32 , rrNotifyOutputChange = RRNotify_OutputChange , rrNotifyOutputProperty=RRNotify_OutputProperty , lASTEvent = LASTEvent + , screenSaverNotify = ScreenSaverNotify } type Modifier = CUInt From edba629435826aa58f760f209c365560b3d6e68e Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Tue, 14 Aug 2012 09:25:39 +0200 Subject: [PATCH 07/16] Add ScreenSaverNotifyEvent to the list / switch in getEvent --- Graphics/X11/Xlib/Extras.hsc | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/Graphics/X11/Xlib/Extras.hsc b/Graphics/X11/Xlib/Extras.hsc index acad869..0b5c206 100644 --- a/Graphics/X11/Xlib/Extras.hsc +++ b/Graphics/X11/Xlib/Extras.hsc @@ -16,6 +16,7 @@ module Graphics.X11.Xlib.Extras where import Data.Maybe import Data.Typeable ( Typeable ) import Graphics.X11.Xrandr +import Graphics.X11.XScreenSaver import Graphics.X11.Xlib 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, Word64, Int32, plusPtr, castPtr, withArrayLen, setBit, testBit, allocaBytes, FunPtr) @@ -281,7 +282,18 @@ data Event , ev_timestamp :: !Time , ev_rr_state :: !CInt } - + | 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 + } deriving ( Show, Typeable ) eventTable :: [(EventType, String)] @@ -320,6 +332,7 @@ eventTable = , (clientMessage , "ClientMessage") , (mappingNotify , "MappingNotify") , (lASTEvent , "LASTEvent") + , (screenSaverNotify , "ScreenSaverNotify") ] eventName :: Event -> String @@ -804,6 +817,18 @@ getEvent p = do , ev_subtype = subtype } + ----------------- + -- 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 ) + -- We don't handle this event specifically, so return the generic -- AnyEvent. | otherwise -> do From 8ac8abfff6411557257d0fa273376211fdf207b1 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Tue, 14 Aug 2012 09:28:09 +0200 Subject: [PATCH 08/16] Methods for handling XScreenSaverNotifyEvents Instance of storable for a pointer to an XScreenSaverNotifyEvent, a get_* method for easy extraction of relevant fields and an type alias for the n-tuple of fields. --- Graphics/X11/XScreenSaver.hsc | 36 ++++++++++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) diff --git a/Graphics/X11/XScreenSaver.hsc b/Graphics/X11/XScreenSaver.hsc index a174b69..7a54b1a 100644 --- a/Graphics/X11/XScreenSaver.hsc +++ b/Graphics/X11/XScreenSaver.hsc @@ -1,4 +1,4 @@ -{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE DeriveDataTypeable, ForeignFunctionInterface #-} -------------------------------------------------------------------- -- | -- Module : Graphics.X11.XScreenSaver @@ -19,9 +19,11 @@ module Graphics.X11.XScreenSaver ( XScreenSaverState(..), XScreenSaverKind(..), XScreenSaverInfo(..), + XScreenSaverNotifyEvent, xScreenSaverQueryExtension, xScreenSaverQueryVersion, xScreenSaverQueryInfo, + get_XScreenSaverNotifyEvent, compiledWithXScreenSaver ) where @@ -150,6 +152,38 @@ instance Storable XScreenSaverInfo where `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 From 99db667eca2f88592a4add4fda8a4439848ddc21 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Tue, 14 Aug 2012 09:32:32 +0200 Subject: [PATCH 09/16] Add missing foreign function calls from scrnsaver.h Couple of functions plus some wrapper functions --- Graphics/X11/XScreenSaver.hsc | 85 ++++++++++++++++++++++++++++++++++- 1 file changed, 84 insertions(+), 1 deletion(-) diff --git a/Graphics/X11/XScreenSaver.hsc b/Graphics/X11/XScreenSaver.hsc index 7a54b1a..eb51338 100644 --- a/Graphics/X11/XScreenSaver.hsc +++ b/Graphics/X11/XScreenSaver.hsc @@ -23,10 +23,20 @@ module Graphics.X11.XScreenSaver ( 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 @@ -216,9 +226,52 @@ xScreenSaverQueryInfo dpy = do s <- cXScreenSaverQueryInfo dpy (defaultRootWindow dpy) p if s == 0 then return Nothing else do xssi <- peek p - cXFree p + _ <- cXFree 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 :: 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 :: Display -> IO () +xScreenSaverUnsetAttributes dpy = + cXScreenSaverUnsetAttributes dpy (defaultRootWindow dpy) + +xScreenSaverSaverRegister :: Display -> ScreenNumber -> XID -> Atom -> IO () +xScreenSaverSaverRegister = cXScreenSaverSaverRegister + +xScreenSaverUnregister :: Display -> ScreenNumber -> IO Status +xScreenSaverUnregister = cXScreenSaverUnregister + + +xScreenSaverGetRegistered :: Display -> ScreenNumber -> XID -> Atom -> IO Status +xScreenSaverGetRegistered = cXScreenSaverGetRegistered + +xScreenSaverSuspend :: Display -> Bool -> IO () +xScreenSaverSuspend = cXScreenSaverSuspend + + foreign import ccall "XScreenSaverQueryExtension" cXScreenSaverQueryExtension :: Display -> Ptr CInt -> Ptr CInt -> IO Bool @@ -232,5 +285,35 @@ 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 () + foreign import ccall "XFree" cXFree :: Ptr a -> IO CInt From 268dc3cdf53d9cd8db7f6f7f00764a9790d8006c Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Tue, 14 Aug 2012 09:35:41 +0200 Subject: [PATCH 10/16] Add missing ScreenSaverCycle constant --- Graphics/X11/XScreenSaver.hsc | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/Graphics/X11/XScreenSaver.hsc b/Graphics/X11/XScreenSaver.hsc index eb51338..1174b2b 100644 --- a/Graphics/X11/XScreenSaver.hsc +++ b/Graphics/X11/XScreenSaver.hsc @@ -42,10 +42,7 @@ import Foreign.C.Types import Graphics.X11.Xlib import Control.Monad -data XScreenSaverState = ScreenSaverOff - | ScreenSaverOn - | ScreenSaverDisabled - deriving Show + | ScreenSaverCycle data XScreenSaverKind = ScreenSaverBlanked | ScreenSaverInternal @@ -108,11 +105,13 @@ compiledWithXScreenSaver = True 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 _ = error "Unknown state in xScreenSaverQueryInfo" From 5099f40b75db49639ec50353fb2abe86c77fd5f8 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Tue, 14 Aug 2012 09:36:26 +0200 Subject: [PATCH 11/16] Obey 80 char line limit --- Graphics/X11/XScreenSaver.hsc | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/Graphics/X11/XScreenSaver.hsc b/Graphics/X11/XScreenSaver.hsc index 1174b2b..625b198 100644 --- a/Graphics/X11/XScreenSaver.hsc +++ b/Graphics/X11/XScreenSaver.hsc @@ -113,7 +113,8 @@ cInt2XScreenSaverState (#const ScreenSaverOn) = ScreenSaverOn cInt2XScreenSaverState (#const ScreenSaverOff) = ScreenSaverOff cInt2XScreenSaverState (#const ScreenSaverCycle) = ScreenSaverCycle cInt2XScreenSaverState (#const ScreenSaverDisabled) = ScreenSaverDisabled -cInt2XScreenSaverState _ = error "Unknown state in xScreenSaverQueryInfo" +cInt2XScreenSaverState s = error $ + "Unknown state in xScreenSaverQueryInfo for XScreenSaverState: " ++ show s instance Storable XScreenSaverState where sizeOf _ = sizeOf (undefined :: CInt) @@ -131,7 +132,8 @@ cInt2XScreenSaverKind :: CInt -> XScreenSaverKind cInt2XScreenSaverKind (#const ScreenSaverBlanked) = ScreenSaverBlanked cInt2XScreenSaverKind (#const ScreenSaverInternal) = ScreenSaverInternal cInt2XScreenSaverKind (#const ScreenSaverExternal) = ScreenSaverExternal -cInt2XScreenSaverKind _ = error "Unknown kind in xScreenSaverQueryInfo" +cInt2XScreenSaverKind s = error $ + "Unknown kind in xScreenSaverQueryInfo for XScreenSaverKind: " ++ show s instance Storable XScreenSaverKind where sizeOf _ = sizeOf (undefined :: CInt) From 121691cf2b1f954b3af3ca965851cb2cc07b4305 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Tue, 14 Aug 2012 09:40:22 +0200 Subject: [PATCH 12/16] Move documentation of constants to their data definitions --- Graphics/X11/XScreenSaver.hsc | 55 ++++++++++++++++++++--------------- 1 file changed, 31 insertions(+), 24 deletions(-) diff --git a/Graphics/X11/XScreenSaver.hsc b/Graphics/X11/XScreenSaver.hsc index 625b198..706c625 100644 --- a/Graphics/X11/XScreenSaver.hsc +++ b/Graphics/X11/XScreenSaver.hsc @@ -40,14 +40,39 @@ import Graphics.X11.Xlib.Types import Foreign import Foreign.C.Types import Graphics.X11.Xlib -import Control.Monad - | ScreenSaverCycle +import Control.Monad -data XScreenSaverKind = ScreenSaverBlanked - | ScreenSaverInternal - | ScreenSaverExternal - deriving Show +-- | 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 @@ -55,28 +80,10 @@ data XScreenSaverInfo = XScreenSaverInfo , xssi_state :: !XScreenSaverState -- ^ The state field specified whether or not the screen saver is currently -- active and how the til-or-since value should be interpreted: --- --- ['ScreenSaverOff'] The screen is not currently being saved; til-or-since --- specifies the number of milliseconds until the screen saver is expected to --- activate. --- --- ['ScreenSaverOn'] The screen is currently being saved; til-or-since specifies --- the number of milliseconds since the screen saver activated. --- --- ['ScreenSaverDisabled'] The screen saver is currently disabled; til-or-since --- is zero. , xssi_kind :: !XScreenSaverKind -- ^ The kind field specifies the mechanism that either is currently being used -- or would have been were the screen being saved: -- --- ['ScreenSaverBlanked'] The video signal to the display monitor was disabled. --- --- ['ScreenSaverInternal'] 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. --- --- ['ScreenSaverExternal'] The screen saver window was mapped with attributes --- set by a client using the ScreenSaverSetAttributes request. , xssi_til_or_since :: !CULong , xssi_idle :: !CULong -- ^ The idle field specifies the number of milliseconds since the last input From f11b58632a7df8230cf6e47cd19451a4b196d0d8 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Tue, 14 Aug 2012 09:41:11 +0200 Subject: [PATCH 13/16] Reformat inline documentation --- Graphics/X11/XScreenSaver.hsc | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/Graphics/X11/XScreenSaver.hsc b/Graphics/X11/XScreenSaver.hsc index 706c625..d2de848 100644 --- a/Graphics/X11/XScreenSaver.hsc +++ b/Graphics/X11/XScreenSaver.hsc @@ -77,22 +77,22 @@ data XScreenSaverKind -- | 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 state field specified whether or not the screen saver is currently --- active and how the til-or-since value should be interpreted: + -- | The kind field specifies the mechanism that either is currently + -- being used or would have been were the screen being saved , xssi_kind :: !XScreenSaverKind --- ^ The kind field specifies the mechanism that either is currently being used --- or would have been were the screen being saved: --- , 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 idle field specifies the number of milliseconds since the last input --- was received from the user on any of the input devices. + -- | The event-mask field specifies which, if any, screen saver events + -- this client has requested using ScreenSaverSelectInput. , xssi_event_mask :: !CULong --- ^ The event-mask field specifies which, if any, screen saver events this --- client has requested using ScreenSaverSelectInput. } 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 From 33553c9917785303a4b07574755774bd93f97227 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Tue, 14 Aug 2012 09:43:32 +0200 Subject: [PATCH 14/16] Update header --- Graphics/X11/XScreenSaver.hsc | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Graphics/X11/XScreenSaver.hsc b/Graphics/X11/XScreenSaver.hsc index d2de848..99d259f 100644 --- a/Graphics/X11/XScreenSaver.hsc +++ b/Graphics/X11/XScreenSaver.hsc @@ -3,9 +3,10 @@ -- | -- Module : Graphics.X11.XScreenSaver -- Copyright : (c) Joachim Breitner +-- (c) Jochen Keil -- License : GPL2 -- --- Maintainer: Joachim Breitner +-- Maintainer: Jochen Keil -- Stability : provisional -- Portability: portable -- From e45ac8d0b536ac877c75571c66799c93ea24864d Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Tue, 14 Aug 2012 09:52:30 +0200 Subject: [PATCH 15/16] Add missing documentation for XScreenSaver API functions --- Graphics/X11/XScreenSaver.hsc | 97 +++++++++++++++++++++++++++++++++++ 1 file changed, 97 insertions(+) diff --git a/Graphics/X11/XScreenSaver.hsc b/Graphics/X11/XScreenSaver.hsc index 99d259f..915d91d 100644 --- a/Graphics/X11/XScreenSaver.hsc +++ b/Graphics/X11/XScreenSaver.hsc @@ -247,6 +247,58 @@ xScreenSaverSelectInput dpy xssem = do 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 @@ -263,20 +315,65 @@ 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 From ac3933e46e52fe10d875d673be5d7aec46f6de65 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Mon, 10 Sep 2012 11:10:44 +0200 Subject: [PATCH 16/16] Guard against missing scrnsaver.h file The scrnsaver.h header is not available on all systems. Therefore code depending on it is left out when the check fails. In addition compiledWithXScreenSaver is set to False. --- Graphics/X11/Types.hsc | 8 ++++++++ Graphics/X11/XScreenSaver.hsc | 11 +++++++++++ Graphics/X11/Xlib/Extras.hsc | 8 ++++++++ configure.ac | 21 ++++++++++++++++++--- include/HsXlib.h | 3 +++ include/XlibExtras.h | 3 +++ 6 files changed, 51 insertions(+), 3 deletions(-) diff --git a/Graphics/X11/Types.hsc b/Graphics/X11/Types.hsc index ba01ce3..300476f 100644 --- a/Graphics/X11/Types.hsc +++ b/Graphics/X11/Types.hsc @@ -434,8 +434,10 @@ module Graphics.X11.Types rrCrtcChangeNotifyMask, rrOutputChangeNotifyMask, rrOutputPropertyNotifyMask, +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H screenSaverCycleMask, screenSaverNotifyMask, +#endif -- ** Event types EventType, @@ -478,7 +480,9 @@ module Graphics.X11.Types rrNotifyOutputChange, rrNotifyOutputProperty, lASTEvent, +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H screenSaverNotify, +#endif -- ** Modifiers Modifier, @@ -1288,8 +1292,10 @@ type EventMask = Mask , rrCrtcChangeNotifyMask = RRCrtcChangeNotifyMask , rrOutputChangeNotifyMask = RROutputChangeNotifyMask , rrOutputPropertyNotifyMask = RROutputPropertyNotifyMask +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H , screenSaverCycleMask = ScreenSaverCycleMask , screenSaverNotifyMask = ScreenSaverNotifyMask +#endif } type EventType = Word32 @@ -1333,7 +1339,9 @@ type EventType = Word32 , rrNotifyOutputChange = RRNotify_OutputChange , rrNotifyOutputProperty=RRNotify_OutputProperty , lASTEvent = LASTEvent +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H , screenSaverNotify = ScreenSaverNotify +#endif } type Modifier = CUInt diff --git a/Graphics/X11/XScreenSaver.hsc b/Graphics/X11/XScreenSaver.hsc index 915d91d..666b74b 100644 --- a/Graphics/X11/XScreenSaver.hsc +++ b/Graphics/X11/XScreenSaver.hsc @@ -15,6 +15,10 @@ -- Interface to XScreenSaver API -- +#include + +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H + module Graphics.X11.XScreenSaver ( getXIdleTime, XScreenSaverState(..), @@ -423,3 +427,10 @@ foreign import ccall "XScreenSaverSuspend" foreign import ccall "XFree" cXFree :: Ptr a -> IO CInt + +#else +module Graphics.X11.XScreenSaver where + +compiledWithXScreenSaver :: Bool +compiledWithXScreenSaver = False +#endif diff --git a/Graphics/X11/Xlib/Extras.hsc b/Graphics/X11/Xlib/Extras.hsc index 0b5c206..a771157 100644 --- a/Graphics/X11/Xlib/Extras.hsc +++ b/Graphics/X11/Xlib/Extras.hsc @@ -16,7 +16,9 @@ module Graphics.X11.Xlib.Extras where 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.Types import Foreign (Storable, Ptr, peek, poke, peekElemOff, pokeElemOff, peekByteOff, pokeByteOff, peekArray, throwIfNull, nullPtr, sizeOf, alignment, alloca, with, throwIf, Word8, Word16, Word64, Int32, plusPtr, castPtr, withArrayLen, setBit, testBit, allocaBytes, FunPtr) @@ -282,6 +284,7 @@ data Event , ev_timestamp :: !Time , ev_rr_state :: !CInt } +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H | ScreenSaverNotifyEvent { ev_event_type :: !EventType , ev_serial :: !CULong @@ -294,6 +297,7 @@ data Event , ev_forced :: !Bool , ev_time :: !Time } +#endif deriving ( Show, Typeable ) eventTable :: [(EventType, String)] @@ -332,7 +336,9 @@ eventTable = , (clientMessage , "ClientMessage") , (mappingNotify , "MappingNotify") , (lASTEvent , "LASTEvent") +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H , (screenSaverNotify , "ScreenSaverNotify") +#endif ] eventName :: Event -> String @@ -817,6 +823,7 @@ getEvent p = do , ev_subtype = subtype } +#ifdef HAVE_X11_EXTENSIONS_SCRNSAVER_H ----------------- -- ScreenSaverNotifyEvent: ----------------- @@ -828,6 +835,7 @@ getEvent p = do `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. diff --git a/configure.ac b/configure.ac index 8f3fda5..c1f8e58 100644 --- a/configure.ac +++ b/configure.ac @@ -78,9 +78,24 @@ if ! test "$have_xrandr" = yes; then AC_MSG_ERROR([X11/extensions/Xrandr.h (from libXrandr) is required]) fi -AC_CHECK_HEADERS([X11/extensions/scrnsaver.h], [have_xrandr=yes]) -if ! test "$have_xrandr" = yes; then - AC_MSG_ERROR([X11/extensions/scrnsaver.h (XScreenSaver) is required]) +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="extra-libraries: Xss" + else + EXTRA_LIBRARIES="" + echo "WARNING: XScreenSaver headers not found. Building without XScreenSaver support" + fi +else + EXTRA_LIBRARIES="" + echo "WARNING: Building without XScreenSaver support per user request" fi AC_MSG_CHECKING([whether to include X.org keysyms]) diff --git a/include/HsXlib.h b/include/HsXlib.h index f1bbfa2..8514583 100644 --- a/include/HsXlib.h +++ b/include/HsXlib.h @@ -19,7 +19,10 @@ #include #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 index cb532ee..3d6f286 100644 --- a/include/XlibExtras.h +++ b/include/XlibExtras.h @@ -18,7 +18,10 @@ #include #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