packages feed

X11-extras 0.2 → 0.3

raw patch · 9 files changed

+487/−101 lines, 9 filesdep ~X11new-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: X11

API changes (from Hackage documentation)

+ Graphics.X11.Xinerama: compiledWithXinerama :: Bool
+ Graphics.X11.Xlib.Extras: ClassHint :: String -> String -> ClassHint
+ Graphics.X11.Xlib.Extras: MotionEvent :: !EventType -> !CULong -> !Bool -> Display -> !CInt -> !CInt -> !Window -> Event
+ Graphics.X11.Xlib.Extras: SizeHints :: Maybe (Dimension, Dimension) -> Maybe (Dimension, Dimension) -> Maybe (Dimension, Dimension) -> Maybe ((Dimension, Dimension), (Dimension, Dimension)) -> Maybe (Dimension, Dimension) -> Maybe (BitGravity) -> SizeHints
+ Graphics.X11.Xlib.Extras: TextProperty :: CString -> Atom -> CInt -> Word32 -> TextProperty
+ Graphics.X11.Xlib.Extras: anyPropertyType :: Atom
+ Graphics.X11.Xlib.Extras: changeProperty16 :: Display -> Window -> Atom -> Atom -> CInt -> [Word16] -> IO ()
+ Graphics.X11.Xlib.Extras: changeProperty32 :: Display -> Window -> Atom -> Atom -> CInt -> [Word32] -> IO ()
+ Graphics.X11.Xlib.Extras: changeWindowAttributes :: Display -> Window -> AttributeMask -> Ptr SetWindowAttributes -> IO ()
+ Graphics.X11.Xlib.Extras: data ClassHint
+ Graphics.X11.Xlib.Extras: data SizeHints
+ Graphics.X11.Xlib.Extras: data TextProperty
+ Graphics.X11.Xlib.Extras: getClassHint :: Display -> Window -> IO ClassHint
+ Graphics.X11.Xlib.Extras: getTextProperty :: Display -> Window -> Atom -> IO TextProperty
+ Graphics.X11.Xlib.Extras: getWMNormalHints :: Display -> Window -> IO SizeHints
+ Graphics.X11.Xlib.Extras: getWindowProperty16 :: Display -> Atom -> Window -> IO (Maybe [Word16])
+ Graphics.X11.Xlib.Extras: getWindowProperty32 :: Display -> Atom -> Window -> IO (Maybe [Word32])
+ Graphics.X11.Xlib.Extras: getWindowProperty8 :: Display -> Atom -> Window -> IO (Maybe [Word8])
+ Graphics.X11.Xlib.Extras: instance Read Rectangle
+ Graphics.X11.Xlib.Extras: instance Storable SizeHints
+ Graphics.X11.Xlib.Extras: instance Storable TextProperty
+ Graphics.X11.Xlib.Extras: instance Typeable Event
+ Graphics.X11.Xlib.Extras: isCursorKey :: KeySym -> Bool
+ Graphics.X11.Xlib.Extras: isFunctionKey :: KeySym -> Bool
+ Graphics.X11.Xlib.Extras: isKeypadKey :: KeySym -> Bool
+ Graphics.X11.Xlib.Extras: isMiscFunctionKey :: KeySym -> Bool
+ Graphics.X11.Xlib.Extras: isModifierKey :: KeySym -> Bool
+ Graphics.X11.Xlib.Extras: isPFKey :: KeySym -> Bool
+ Graphics.X11.Xlib.Extras: isPrivateKeypadKey :: KeySym -> Bool
+ Graphics.X11.Xlib.Extras: rawGetWindowProperty :: (Storable a) => Int -> Display -> Atom -> Window -> IO (Maybe [a])
+ Graphics.X11.Xlib.Extras: resClass :: ClassHint -> String
+ Graphics.X11.Xlib.Extras: resName :: ClassHint -> String
+ Graphics.X11.Xlib.Extras: setConfigureEvent :: XEventPtr -> Window -> Window -> CInt -> CInt -> CInt -> CInt -> CInt -> Window -> Bool -> IO ()
+ Graphics.X11.Xlib.Extras: sh_aspect :: SizeHints -> Maybe ((Dimension, Dimension), (Dimension, Dimension))
+ Graphics.X11.Xlib.Extras: sh_base_size :: SizeHints -> Maybe (Dimension, Dimension)
+ Graphics.X11.Xlib.Extras: sh_max_size :: SizeHints -> Maybe (Dimension, Dimension)
+ Graphics.X11.Xlib.Extras: sh_min_size :: SizeHints -> Maybe (Dimension, Dimension)
+ Graphics.X11.Xlib.Extras: sh_resize_inc :: SizeHints -> Maybe (Dimension, Dimension)
+ Graphics.X11.Xlib.Extras: sh_win_gravity :: SizeHints -> Maybe (BitGravity)
+ Graphics.X11.Xlib.Extras: tp_encoding :: TextProperty -> Atom
+ Graphics.X11.Xlib.Extras: tp_format :: TextProperty -> CInt
+ Graphics.X11.Xlib.Extras: tp_nitems :: TextProperty -> Word32
+ Graphics.X11.Xlib.Extras: tp_value :: TextProperty -> CString
+ Graphics.X11.Xlib.Extras: unmapWindow :: Display -> Window -> IO ()
+ Graphics.X11.Xlib.Extras: waIsUnmapped :: CInt
+ Graphics.X11.Xlib.Extras: waIsUnviewable :: CInt
+ Graphics.X11.Xlib.Extras: wcFreeStringList :: Ptr CWString -> IO ()
+ Graphics.X11.Xlib.Extras: wcTextPropertyToTextList :: Display -> TextProperty -> IO [String]
+ Graphics.X11.Xlib.Extras: xConvertSelection :: Display -> Atom -> Atom -> Atom -> Window -> Time -> IO ()
+ Graphics.X11.Xlib.Extras: xGetClassHint :: Display -> Window -> Ptr ClassHint -> IO Status
+ Graphics.X11.Xlib.Extras: xGetSelectionOwner :: Display -> Atom -> IO Window
+ Graphics.X11.Xlib.Extras: xGetTextProperty :: Display -> Window -> Ptr TextProperty -> Atom -> IO Status
+ Graphics.X11.Xlib.Extras: xGetWMNormalHints :: Display -> Window -> Ptr SizeHints -> Ptr CLong -> IO Status
+ Graphics.X11.Xlib.Extras: xGetWindowProperty :: Display -> Window -> Atom -> CLong -> CLong -> Bool -> Atom -> Ptr Atom -> Ptr CInt -> Ptr CULong -> Ptr CULong -> Ptr (Ptr CUChar) -> IO Status
+ Graphics.X11.Xlib.Extras: xSetSelectionOwner :: Display -> Atom -> Window -> Time -> IO ()
+ Graphics.X11.Xlib.Extras: xUnmapWindow :: Display -> Window -> IO CInt
+ Graphics.X11.Xlib.Extras: xwcTextPropertyToTextList :: Display -> Ptr TextProperty -> Ptr (Ptr CWString) -> Ptr CInt -> IO CInt
- Graphics.X11.Xlib.Extras: changeProperty8 :: Display -> Window -> Atom -> Atom -> CInt -> [Char] -> IO ()
+ Graphics.X11.Xlib.Extras: changeProperty8 :: Display -> Window -> Atom -> Atom -> CInt -> [Word8] -> IO ()

Files

Graphics/X11/Xinerama.hsc view
@@ -5,13 +5,15 @@    xineramaQueryExtension,     xineramaQueryVersion,     xineramaQueryScreens,+   compiledWithXinerama,    getScreenInfo) where -#include <config.h>+#include <X11_extras_config.h>  import Foreign import Foreign.C.Types import Graphics.X11.Xlib+import Graphics.X11.Xlib.Extras (WindowAttributes(..), getWindowAttributes) import Control.Monad  -- | Representation of the XineramaScreenInfo struct@@ -27,23 +29,29 @@ -- Xinerama is not active. This is the preferred interface to -- Graphics.X11.Xinerama. getScreenInfo :: Display -> IO [Rectangle]-getScreenInfo dpy = maybe [singleScreen] (map xsiToRect) `liftM` xineramaQueryScreens dpy-    where dflt = defaultScreen dpy-          xsiToRect xsi = Rectangle-                        { rect_x        = fromIntegral $ xsi_x_org xsi-                        , rect_y        = fromIntegral $ xsi_y_org xsi-                        , rect_width    = fromIntegral $ xsi_width xsi-                        , rect_height   = fromIntegral $ xsi_height xsi-                        }-          singleScreen = Rectangle-                       { rect_x      = 0 -                       , rect_y      = 0 -                       , rect_width  = fromIntegral $ displayWidth dpy dflt-                       , rect_height = fromIntegral $ displayHeight dpy dflt-                       }+getScreenInfo dpy = do+    mxs <- xineramaQueryScreens dpy+    case mxs of+        Just xs -> return . map xsiToRect $ xs+        Nothing -> do+            wa <- getWindowAttributes dpy (defaultRootWindow dpy)+            return $ [Rectangle+                        { rect_x      = fromIntegral $ wa_x wa+                        , rect_y      = fromIntegral $ wa_y wa+                        , rect_width  = fromIntegral $ wa_width wa+                        , rect_height = fromIntegral $ wa_height wa }]+ where +    xsiToRect xsi = Rectangle+                    { rect_x        = fromIntegral $ xsi_x_org xsi+                    , rect_y        = fromIntegral $ xsi_y_org xsi+                    , rect_width    = fromIntegral $ xsi_width xsi+                    , rect_height   = fromIntegral $ xsi_height xsi+                    }  #ifdef HAVE_X11_EXTENSIONS_XINERAMA_H -- We have Xinerama, so the library will actually work+compiledWithXinerama :: Bool+compiledWithXinerama = True  -- for XFree() (already included from Xinerama.h, but I don't know if I can count on that.) #include <X11/Xlib.h>@@ -115,6 +123,9 @@  -- No Xinerama, but if we fake a non-active Xinerama interface, "getScreenInfo" -- will continue to work fine in the single-screen case.+compiledWithXinerama :: Bool+compiledWithXinerama = False+ xineramaIsActive :: Display -> IO Bool xineramaIsActive _ = return False 
Graphics/X11/Xlib/Extras.hsc view
@@ -1,3 +1,4 @@+{-# OPTIONS -fglasgow-exts #-} ----------------------------------------------------------------------------- -- | -- Module      :@@ -13,6 +14,7 @@  module Graphics.X11.Xlib.Extras where +import Data.Typeable ( Typeable ) import Graphics.X11.Xlib import Graphics.X11.Xlib.Types import Graphics.X11.Xlib.Misc@@ -104,6 +106,15 @@         , ev_button                :: !Button         , ev_same_screen           :: !Bool         }+    | MotionEvent+        { ev_event_type            :: !EventType+        , ev_serial                :: !CULong+        , ev_send_event            :: !Bool+        , ev_event_display         :: Display+        , ev_x                     :: !CInt+        , ev_y                     :: !CInt+        , ev_window                :: !Window+        }     | DestroyWindowEvent         { ev_event_type            :: !EventType         , ev_serial                :: !CULong@@ -160,7 +171,7 @@         , ev_state                 :: !Modifier         } -    deriving Show+    deriving ( Show, Typeable )  eventTable =     [ (keyPress             , "KeyPress")@@ -379,6 +390,24 @@                         , ev_same_screen   = same_screen                         } +          ---------------+          -- MotionEvent:+          ---------------+          | type_ == motionNotify -> do+            window <- #{peek XMotionEvent, window} p+            x      <- #{peek XMotionEvent, x     } p+            y      <- #{peek XMotionEvent, y     } p+            return $ MotionEvent+                        { ev_event_type    = type_+                        , ev_serial        = serial+                        , ev_send_event    = send_event+                        , ev_event_display = display+                        , ev_x             = x+                        , ev_y             = y+                        , ev_window        = window+                        }++           ----------------------           -- DestroyWindowEvent:           ----------------------@@ -553,6 +582,14 @@             , wa_override_redirect :: Bool             } +-- +-- possible map_states'+--+waIsUnmapped, waIsUnviewable, waIsViewable :: CInt+waIsUnmapped   = fromIntegral $ #{const IsUnmapped}     -- 0+waIsUnviewable = fromIntegral $ #{const IsUnviewable}   -- 1+waIsViewable   = fromIntegral $ #{const IsViewable}     -- 2+ instance Storable WindowAttributes where     -- this might be incorrect     alignment _ = alignment (undefined :: CInt)@@ -581,8 +618,9 @@     xGetWindowAttributes d w p     peek p -waIsViewable :: CInt-waIsViewable = fromIntegral $ #{const IsViewable}+-- | interface to the X11 library function @XChangeWindowAttributes()@.+foreign import ccall unsafe "XlibExtras.h XChangeWindowAttributes"+	changeWindowAttributes :: Display -> Window -> AttributeMask -> Ptr SetWindowAttributes -> IO ()  -- | Run an action with the server withServer :: Display -> IO () -> IO ()@@ -594,6 +632,55 @@ foreign import ccall unsafe "XlibExtras.h XFetchName"     xFetchName :: Display -> Window -> Ptr CString -> IO Status +data TextProperty = TextProperty {+        tp_value    :: CString,+        tp_encoding :: Atom,+        tp_format   :: CInt,+        tp_nitems   :: #{type unsigned long}+    }++instance Storable TextProperty where+    sizeOf    _ = #{size XTextProperty}+    alignment _ = alignment (undefined :: #{type unsigned long})+    peek p = TextProperty `fmap` #{peek XTextProperty, value   } p+                          `ap`   #{peek XTextProperty, encoding} p+                          `ap`   #{peek XTextProperty, format  } p+                          `ap`   #{peek XTextProperty, nitems  } p+    poke p (TextProperty val enc fmt nitems) = do+        #{poke XTextProperty, value   } p val+        #{poke XTextProperty, encoding} p enc+        #{poke XTextProperty, format  } p fmt+        #{poke XTextProperty, nitems  } p nitems++foreign import ccall unsafe "XlibExtras.h XGetTextProperty"+    xGetTextProperty :: Display -> Window -> Ptr TextProperty -> Atom -> IO Status++getTextProperty :: Display -> Window -> Atom -> IO TextProperty+getTextProperty d w a =+    alloca $ \textp -> do+        throwIf (0==) (const "getTextProperty") $ xGetTextProperty d w textp a+        peek textp++foreign import ccall unsafe "XlibExtras.h XwcTextPropertyToTextList"+    xwcTextPropertyToTextList :: Display -> Ptr TextProperty -> Ptr (Ptr CWString) -> Ptr CInt -> IO CInt++wcTextPropertyToTextList :: Display -> TextProperty -> IO [String]+wcTextPropertyToTextList d prop =+    alloca    $ \listp  ->+    alloca    $ \countp ->+    with prop $ \propp  -> do+        throwIf (success>) (const "wcTextPropertyToTextList") $+            xwcTextPropertyToTextList d propp listp countp+        count <- peek countp+        list  <- peek listp+        texts <- flip mapM [0..fromIntegral count - 1] $ \i ->+                     peekElemOff list i >>= peekCWString+        wcFreeStringList list+        return texts++foreign import ccall unsafe "XlibExtras.h XwcFreeStringList"+    wcFreeStringList :: Ptr CWString -> IO ()+ fetchName :: Display -> Window -> IO (Maybe String) fetchName d w = alloca $ \p -> do     xFetchName d w p@@ -648,7 +735,6 @@        if st == 0             then return []             else do sz       <- peek count_ptr-                    print sz                     atom_ptr <- peek atom_ptr_ptr                     atoms    <- peekArray (fromIntegral sz) atom_ptr                     xFree atom_ptr@@ -677,7 +763,19 @@      return () +setConfigureEvent :: XEventPtr -> Window -> Window -> CInt -> CInt -> CInt -> CInt -> CInt -> Window -> Bool -> IO ()+setConfigureEvent p ev win x y w h bw abv or = do+    #{poke XConfigureEvent, event            } p ev+    #{poke XConfigureEvent, window           } p win+    #{poke XConfigureEvent, x                } p x+    #{poke XConfigureEvent, y                } p y+    #{poke XConfigureEvent, width            } p w+    #{poke XConfigureEvent, height           } p h+    #{poke XConfigureEvent, border_width     } p bw+    #{poke XConfigureEvent, above            } p abv+    #{poke XConfigureEvent, override_redirect} p (if or then 1 else 0 :: CInt) + {-        typedef struct {             int type;                /* ClientMessage */@@ -727,18 +825,237 @@  -- Properties +anyPropertyType :: Atom+anyPropertyType = #{const AnyPropertyType}+ foreign import ccall unsafe "XlibExtras.h XChangeProperty"     xChangeProperty :: Display -> Window -> Atom -> Atom -> CInt -> CInt -> Ptr CUChar -> CInt -> IO Status +foreign import ccall unsafe "XlibExtras.h XGetWindowProperty"+    xGetWindowProperty :: Display -> Window -> Atom -> CLong -> CLong -> Bool -> Atom -> Ptr Atom -> Ptr CInt -> Ptr CULong -> Ptr CULong -> Ptr (Ptr CUChar) -> IO Status++rawGetWindowProperty :: Storable a => Int -> Display -> Atom -> Window -> IO (Maybe [a])+rawGetWindowProperty bits d atom w =+    alloca $ \actual_type_return ->+    alloca $ \actual_format_return ->+    alloca $ \nitems_return ->+    alloca $ \bytes_after_return ->+    alloca $ \prop_return -> do+        xGetWindowProperty d w atom 0 0xFFFFFFFF False anyPropertyType+                           actual_type_return+                           actual_format_return+                           nitems_return+                           bytes_after_return+                           prop_return++        prop_ptr      <- peek prop_return+        actual_format <- fromIntegral `liftM` peek actual_format_return+        nitems        <- fromIntegral `liftM` peek nitems_return+        getprop prop_ptr nitems actual_format+  where+    getprop prop_ptr nitems actual_format+        | actual_format == 0    = return Nothing -- Property not found+        | actual_format /= bits = xFree prop_ptr >> return Nothing+        | otherwise = do+            retval <- peekArray nitems (castPtr prop_ptr)+            xFree prop_ptr+            return $ Just retval++getWindowProperty8 :: Display -> Atom -> Window -> IO (Maybe [Word8])+getWindowProperty8 = rawGetWindowProperty 8++getWindowProperty16 :: Display -> Atom -> Window -> IO (Maybe [Word16])+getWindowProperty16 = rawGetWindowProperty 16++getWindowProperty32 :: Display -> Atom -> Window -> IO (Maybe [Word32])+getWindowProperty32 = rawGetWindowProperty 32+ -- this assumes bytes are 8 bits.  I hope X isn't more portable than that :( -changeProperty8 :: Display -> Window -> Atom -> Atom -> CInt -> [Char] -> IO ()+changeProperty8 :: Display -> Window -> Atom -> Atom -> CInt -> [Word8] -> IO () changeProperty8 dpy w prop typ mode dat =-    withArrayLen (map (fromIntegral . fromEnum) dat) $ \ len ptr -> do-        xChangeProperty dpy w prop typ 8 mode ptr (fromIntegral len)+    withArrayLen dat $ \ len ptr -> do+        xChangeProperty dpy w prop typ 8 mode (castPtr ptr) (fromIntegral len)         return () +changeProperty16 :: Display -> Window -> Atom -> Atom -> CInt -> [Word16] -> IO ()+changeProperty16 dpy w prop typ mode dat =+    withArrayLen dat $ \ len ptr -> do+        xChangeProperty dpy w prop typ 16 mode (castPtr ptr) (fromIntegral len)+        return ()++changeProperty32 :: Display -> Window -> Atom -> Atom -> CInt -> [Word32] -> IO ()+changeProperty32 dpy w prop typ mode dat =+    withArrayLen dat $ \ len ptr -> do+        xChangeProperty dpy w prop typ 32 mode (castPtr ptr) (fromIntegral len)+        return ()+ propModeReplace, propModePrepend, propModeAppend :: CInt propModeReplace = #{const PropModeReplace} propModePrepend = #{const PropModePrepend} propModeAppend = #{const PropModeAppend}++-- Windows++foreign import ccall unsafe "XlibExtras.h XUnmapWindow"+    xUnmapWindow :: Display -> Window -> IO CInt++unmapWindow :: Display -> Window -> IO ()+unmapWindow d w = xUnmapWindow d w >> return ()++------------------------------------------------------------------------+-- Size hints++data SizeHints = SizeHints+                   { sh_min_size     :: Maybe (Dimension, Dimension)+                   , sh_max_size     :: Maybe (Dimension, Dimension)+                   , sh_resize_inc   :: Maybe (Dimension, Dimension)+                   , sh_aspect       :: Maybe ((Dimension, Dimension), (Dimension, Dimension))+                   , sh_base_size    :: Maybe (Dimension, Dimension)+                   , sh_win_gravity  :: Maybe (BitGravity)+                   }++pMinSizeBit    = 4+pMaxSizeBit    = 5+pResizeIncBit  = 6+pAspectBit     = 7+pBaseSizeBit   = 8+pWinGravityBit = 9++instance Storable SizeHints where+    alignment _ = alignment (undefined :: CInt)+    sizeOf _ = #{size XSizeHints}++    poke p sh = do+      let whenSet f x = maybe (return ()) x (f sh)+      let pokeFlag b = do flag <- #{peek XSizeHints, flags} p :: IO CLong+                          #{poke XSizeHints, flags} p (setBit flag b)+      #{poke XSizeHints, flags} p (0 :: CLong)+      whenSet sh_min_size $ \(w, h) -> do+        pokeFlag pMinSizeBit+        #{poke XSizeHints, min_width   } p w+        #{poke XSizeHints, min_height  } p h+      whenSet sh_max_size $ \(w, h) -> do+        pokeFlag pMaxSizeBit+        #{poke XSizeHints, max_width   } p w+        #{poke XSizeHints, max_height  } p h+      whenSet sh_resize_inc $ \(w, h) -> do+        pokeFlag pResizeIncBit+        #{poke XSizeHints, width_inc   } p w+        #{poke XSizeHints, height_inc  } p w+      whenSet sh_aspect $ \((minx, miny), (maxx, maxy)) -> do+        pokeFlag pAspectBit+        #{poke XSizeHints, min_aspect.x} p minx+        #{poke XSizeHints, min_aspect.y} p miny+        #{poke XSizeHints, max_aspect.x} p maxx+        #{poke XSizeHints, max_aspect.y} p maxy+      whenSet sh_base_size $ \(w, h) -> do+        pokeFlag pBaseSizeBit+        #{poke XSizeHints, base_width  } p w+        #{poke XSizeHints, base_height } p h+      whenSet sh_win_gravity $ \g -> do+        pokeFlag pWinGravityBit+        #{poke XSizeHints, win_gravity } p g++    peek p = do+      flags <- #{peek XSizeHints, flags} p :: IO CLong+      let whenBit n x = if testBit flags n then liftM Just x else return Nothing+      return SizeHints+         `ap` whenBit pMinSizeBit    (do liftM2 (,) (#{peek XSizeHints, min_width  } p)+                                                    (#{peek XSizeHints, min_height } p))+         `ap` whenBit pMaxSizeBit    (do liftM2 (,) (#{peek XSizeHints, max_width  } p)+                                                    (#{peek XSizeHints, max_height } p))+         `ap` whenBit pResizeIncBit  (do liftM2 (,) (#{peek XSizeHints, width_inc  } p)+                                                    (#{peek XSizeHints, height_inc } p))+         `ap` whenBit pAspectBit     (do minx <- #{peek XSizeHints, min_aspect.x} p+                                         miny <- #{peek XSizeHints, min_aspect.y} p+                                         maxx <- #{peek XSizeHints, max_aspect.x} p+                                         maxy <- #{peek XSizeHints, max_aspect.y} p+                                         return ((minx, miny), (maxx, maxy)))+         `ap` whenBit pBaseSizeBit   (do liftM2 (,) (#{peek XSizeHints, base_width } p)+                                                    (#{peek XSizeHints, base_height} p))+         `ap` whenBit pWinGravityBit (#{peek XSizeHints, win_gravity} p)+++foreign import ccall unsafe "XlibExtras.h XGetWMNormalHints"+    xGetWMNormalHints :: Display -> Window -> Ptr SizeHints -> Ptr CLong -> IO Status++getWMNormalHints :: Display -> Window -> IO SizeHints+getWMNormalHints d w+    = alloca $ \sh -> do+        alloca $ \supplied_return -> do+          -- what's the purpose of supplied_return?+          xGetWMNormalHints d w sh supplied_return+          peek sh+++data ClassHint = ClassHint+                        { resName  :: String+                        , resClass :: String+                        }++getClassHint :: Display -> Window -> IO ClassHint+getClassHint d w =  allocaBytes (#{size XClassHint}) $ \ p -> do+    s <- xGetClassHint d w p+    if s /= 0 -- returns a nonzero status on success+        then do+            res_name_p <- #{peek XClassHint, res_name} p+            res_class_p <- #{peek XClassHint, res_class} p+            res <- liftM2 ClassHint (peekCString res_name_p) (peekCString res_class_p)+            xFree res_name_p+            xFree res_class_p+            return res+        else return $ ClassHint "" ""++foreign import ccall unsafe "XlibExtras.h XGetClassHint"+    xGetClassHint :: Display -> Window -> Ptr ClassHint -> IO Status++------------------------------------------------------------------------+-- Keysym Macros+--+-- Which we have to wrap in functions, then bind here.++foreign import ccall unsafe "XlibExtras.h x11_extras_IsCursorKey"+    isCursorKey :: KeySym -> Bool+foreign import ccall unsafe "XlibExtras.h x11_extras_IsFunctionKey"+    isFunctionKey :: KeySym -> Bool+foreign import ccall unsafe "XlibExtras.h x11_extras_IsKeypadKey"+    isKeypadKey :: KeySym -> Bool+foreign import ccall unsafe "XlibExtras.h x11_extras_IsMiscFunctionKey"+    isMiscFunctionKey :: KeySym -> Bool+foreign import ccall unsafe "XlibExtras.h x11_extras_IsModifierKey"+    isModifierKey :: KeySym -> Bool+foreign import ccall unsafe "XlibExtras.h x11_extras_IsPFKey"+    isPFKey :: KeySym -> Bool+foreign import ccall unsafe "XlibExtras.h x11_extras_IsPrivateKeypadKey"+    isPrivateKeypadKey :: KeySym -> Bool++-- FIXME: X11 doesn't have a Read instance for Rectangle, so we include one for now.+{-* Generated by DrIFT : Look, but Don't Touch. *-}+instance Read Rectangle where+    readsPrec d input =+          readParen (d > 9)+          (\ inp ->+           [((Rectangle aa ab ac ad) , rest) | ("Rectangle" , inp) <- lex inp+        , ("{" , inp) <- lex inp , ("rect_x" , inp) <- lex inp ,+        ("=" , inp) <- lex inp , (aa , inp) <- readsPrec 10 inp ,+        ("," , inp) <- lex inp , ("rect_y" , inp) <- lex inp ,+        ("=" , inp) <- lex inp , (ab , inp) <- readsPrec 10 inp ,+        ("," , inp) <- lex inp , ("rect_width" , inp) <- lex inp ,+        ("=" , inp) <- lex inp , (ac , inp) <- readsPrec 10 inp ,+        ("," , inp) <- lex inp , ("rect_height" , inp) <- lex inp ,+        ("=" , inp) <- lex inp , (ad , inp) <- readsPrec 10 inp ,+        ("}" , rest) <- lex inp])+          input++-------------------------------------------------------------------------------+-- Selections+--+foreign import ccall unsafe "HsXlib.h XSetSelectionOwner"+    xSetSelectionOwner :: Display -> Atom -> Window -> Time -> IO ()++foreign import ccall unsafe "HsXlib.h XGetSelectionOwner"+    xGetSelectionOwner :: Display -> Atom -> IO Window++foreign import ccall unsafe "HsXlib.h XConvertSelection"+    xConvertSelection :: Display -> Atom -> Atom -> Atom -> Window -> Time -> IO ()
X11-extras.cabal view
@@ -1,5 +1,5 @@ name:           X11-extras-version:        0.2+version:        0.3 license:        BSD3 license-file:   LICENSE author:         Spencer Janssen@@ -15,8 +15,8 @@ exposed-modules:    Graphics.X11.Xlib.Extras, Graphics.X11.Xinerama extensions:         ForeignFunctionInterface build-depends:	    base, X11>=1.2.1-ghc-options:        -O2 -funbox-strict-fields-extra-libraries:    "X11" "Xext"+ghc-options:        -O2 -fasm -funbox-strict-fields+extra-libraries:    "X11" c-sources:          cbits/XUtils.c install-includes:   XlibExtras.h extra-source-files:@@ -24,6 +24,6 @@     configure.ac     configure     X11-extras.buildinfo.in-    include/config.h.in+    include/X11_extras_config.h.in include-dirs:	    include-extra-tmp-files:    include/config.h X11-extras.buildinfo config.log config.status autom4te.cache+extra-tmp-files:    include/X11_extras_config.h X11-extras.buildinfo config.log config.status autom4te.cache
cbits/XUtils.c view
@@ -2,16 +2,13 @@ #include <X11/X.h> #include <X11/Xlib.h> #include <X11/Xproto.h>+#include <X11/Xutil.h>+#include <X11/keysym.h> -int x11_extras_default_error_handler(Display *d, XErrorEvent *ev)-{+int x11_extras_xerror(Display *dpy, XErrorEvent *ee) {     char buffer[1000];-    XGetErrorText(d,ev->error_code,buffer,1000);-    printf("Error: %s\n", buffer);-    return 0;-} -int x11_extras_xerror(Display *dpy, XErrorEvent *ee) {+    XGetErrorText(dpy,ee->error_code,buffer,1000);      if(ee->error_code == BadWindow     || (ee->request_code == X_SetInputFocus && ee->error_code == BadMatch)@@ -19,12 +16,35 @@     || (ee->request_code == X_GrabKey && ee->error_code == BadAccess))         return 0; -    fprintf(stderr, "xmonad: fatal error: request code=%d, error code=%d\n",-            ee->request_code, ee->error_code);+    fprintf(stderr, "xmonad: X11 error: %s, request code=%d, error code=%d\n",+            buffer, ee->request_code, ee->error_code); -    return x11_extras_default_error_handler(dpy,ee);+    return 0; }  void x11_extras_set_error_handler() {     XSetErrorHandler(x11_extras_xerror);+}++/* bloody macros */+int x11_extras_IsCursorKey(KeySym keysym) {+    return IsCursorKey(keysym);+}+int x11_extras_IsFunctionKey(KeySym keysym) {+    return IsFunctionKey(keysym);+}+int x11_extras_IsKeypadKey(KeySym keysym) {+    return IsKeypadKey(keysym);+}+int x11_extras_IsMiscFunctionKey(KeySym keysym) {+    return IsMiscFunctionKey(keysym);+}+int x11_extras_IsModifierKey(KeySym keysym) {+    return IsModifierKey(keysym);+}+int x11_extras_IsPFKey(KeySym keysym) {+    return IsPFKey(keysym);+}+int x11_extras_IsPrivateKeypadKey(KeySym keysym) {+    return IsPrivateKeypadKey(keysym); }
configure view
@@ -1251,6 +1251,7 @@   --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]   --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  Some influential environment variables:   XMKMF       Path to xmkmf, Makefile generator for X Window System@@ -1686,7 +1687,7 @@   -ac_config_headers="$ac_config_headers include/config.h"+ac_config_headers="$ac_config_headers include/X11_extras_config.h"   ac_ext=c@@ -4161,7 +4162,21 @@     CPPFLAGS="$CPPFLAGS -I $x_includes" fi -{ echo "$as_me:$LINENO: checking for grep that handles long lines and -e" >&5+{ echo "$as_me:$LINENO: checking whether to build Xinerama" >&5+echo $ECHO_N "checking whether to build Xinerama... $ECHO_C" >&6; }++# Check whether --with-xinerama was given.+if test "${with_xinerama+set}" = set; then+  withval=$with_xinerama; want_xinerama=no+else+  want_xinerama=yes+fi++{ echo "$as_me:$LINENO: result: $want_xinerama" >&5+echo "${ECHO_T}$want_xinerama" >&6; }++if test "$want_xinerama" = yes; then+    { echo "$as_me:$LINENO: checking for grep that handles long lines and -e" >&5 echo $ECHO_N "checking for grep that handles long lines and -e... $ECHO_C" >&6; } if test "${ac_cv_path_GREP+set}" = set; then   echo $ECHO_N "(cached) $ECHO_C" >&6@@ -4706,15 +4721,19 @@  done --if test "$have_xinerama" = yes; then-    EXTRA_LIBRARIES="extra-libraries: Xinerama"+    if test "$have_xinerama" = yes; then+        EXTRA_LIBRARIES="extra-libraries: Xinerama Xext"+    else+        EXTRA_LIBRARIES=""+        echo "WARNING: Xinerama headers not found. Building without Xinerama support"+    fi else     EXTRA_LIBRARIES=""-    echo "WARNING: Xinerama headers not found. Building without Xinerama support"+    echo "WARNING: Building without Xinerama support per user request" fi  + ac_config_files="$ac_config_files X11-extras.buildinfo"  cat >confcache <<\_ACEOF@@ -5269,7 +5288,7 @@ for ac_config_target in $ac_config_targets do   case $ac_config_target in-    "include/config.h") CONFIG_HEADERS="$CONFIG_HEADERS include/config.h" ;;+    "include/X11_extras_config.h") CONFIG_HEADERS="$CONFIG_HEADERS include/X11_extras_config.h" ;;     "X11-extras.buildinfo") CONFIG_FILES="$CONFIG_FILES X11-extras.buildinfo" ;;    *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
configure.ac view
@@ -1,6 +1,6 @@ AC_INIT -AC_CONFIG_HEADERS([include/config.h])+AC_CONFIG_HEADERS([include/X11_extras_config.h])  AC_PATH_XTRA @@ -10,14 +10,26 @@     CPPFLAGS="$CPPFLAGS -I $x_includes" fi -AC_CHECK_HEADERS([X11/extensions/Xinerama.h], [have_xinerama=yes])+AC_MSG_CHECKING([whether to build Xinerama])+AC_ARG_WITH(xinerama,+            AS_HELP_STRING([--without-xinerama], [do not build Xinerama support]),+            want_xinerama=no,+            want_xinerama=yes)+AC_MSG_RESULT([$want_xinerama]) -if test "$have_xinerama" = yes; then-    EXTRA_LIBRARIES="extra-libraries: Xinerama" +if test "$want_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"+    else+        EXTRA_LIBRARIES=""+        echo "WARNING: Xinerama headers not found. Building without Xinerama support"+    fi else     EXTRA_LIBRARIES=""-    echo "WARNING: Xinerama headers not found. Building without Xinerama support"+    echo "WARNING: Building without Xinerama support per user request" fi+ AC_SUBST([EXTRA_LIBRARIES])  AC_CONFIG_FILES([X11-extras.buildinfo])
+ include/X11_extras_config.h.in view
@@ -0,0 +1,52 @@+/* include/X11_extras_config.h.in.  Generated from configure.ac by autoheader.  */++/* Define to 1 if you have the <inttypes.h> header file. */+#undef HAVE_INTTYPES_H++/* Define to 1 if you have the <memory.h> header file. */+#undef HAVE_MEMORY_H++/* Define to 1 if you have the <stdint.h> header file. */+#undef HAVE_STDINT_H++/* Define to 1 if you have the <stdlib.h> header file. */+#undef HAVE_STDLIB_H++/* Define to 1 if you have the <strings.h> header file. */+#undef HAVE_STRINGS_H++/* Define to 1 if you have the <string.h> header file. */+#undef HAVE_STRING_H++/* Define to 1 if you have the <sys/stat.h> header file. */+#undef HAVE_SYS_STAT_H++/* Define to 1 if you have the <sys/types.h> header file. */+#undef HAVE_SYS_TYPES_H++/* Define to 1 if you have the <unistd.h> header file. */+#undef HAVE_UNISTD_H++/* Define to 1 if you have the <X11/extensions/Xinerama.h> header file. */+#undef HAVE_X11_EXTENSIONS_XINERAMA_H++/* Define to the address where bug reports for this package should be sent. */+#undef PACKAGE_BUGREPORT++/* Define to the full name of this package. */+#undef PACKAGE_NAME++/* Define to the full name and version of this package. */+#undef PACKAGE_STRING++/* Define to the one symbol short name of this package. */+#undef PACKAGE_TARNAME++/* Define to the version of this package. */+#undef PACKAGE_VERSION++/* Define to 1 if you have the ANSI C header files. */+#undef STDC_HEADERS++/* Define to 1 if the X Window System is missing or not being used. */+#undef X_DISPLAY_MISSING
include/XlibExtras.h view
@@ -35,3 +35,10 @@ #endif  void x11_extras_set_error_handler();+int x11_extras_IsCursorKey(KeySym keysym);+int x11_extras_IsFunctionKey(KeySym keysym);+int x11_extras_IsKeypadKey(KeySym keysym);+int x11_extras_IsMiscFunctionKey(KeySym keysym);+int x11_extras_IsModifierKey(KeySym keysym);+int x11_extras_IsPFKey(KeySym keysym);+int x11_extras_IsPrivateKeypadKey(KeySym keysym);
− include/config.h.in
@@ -1,52 +0,0 @@-/* include/config.h.in.  Generated from configure.ac by autoheader.  */--/* Define to 1 if you have the <inttypes.h> header file. */-#undef HAVE_INTTYPES_H--/* Define to 1 if you have the <memory.h> header file. */-#undef HAVE_MEMORY_H--/* Define to 1 if you have the <stdint.h> header file. */-#undef HAVE_STDINT_H--/* Define to 1 if you have the <stdlib.h> header file. */-#undef HAVE_STDLIB_H--/* Define to 1 if you have the <strings.h> header file. */-#undef HAVE_STRINGS_H--/* Define to 1 if you have the <string.h> header file. */-#undef HAVE_STRING_H--/* Define to 1 if you have the <sys/stat.h> header file. */-#undef HAVE_SYS_STAT_H--/* Define to 1 if you have the <sys/types.h> header file. */-#undef HAVE_SYS_TYPES_H--/* Define to 1 if you have the <unistd.h> header file. */-#undef HAVE_UNISTD_H--/* Define to 1 if you have the <X11/extensions/Xinerama.h> header file. */-#undef HAVE_X11_EXTENSIONS_XINERAMA_H--/* Define to the address where bug reports for this package should be sent. */-#undef PACKAGE_BUGREPORT--/* Define to the full name of this package. */-#undef PACKAGE_NAME--/* Define to the full name and version of this package. */-#undef PACKAGE_STRING--/* Define to the one symbol short name of this package. */-#undef PACKAGE_TARNAME--/* Define to the version of this package. */-#undef PACKAGE_VERSION--/* Define to 1 if you have the ANSI C header files. */-#undef STDC_HEADERS--/* Define to 1 if the X Window System is missing or not being used. */-#undef X_DISPLAY_MISSING