depend on the X11-extras package

darcs-hash:20070307024838-9c5c1-a1e8969b5a390b2852dda76881e8f571857b37f7.gz

4 files changed, 2 insertions, 293 deletions

diff --git a/XlibExtras.hsc b/XlibExtras.hsc
deleted file mode 100644
index 103a149..0000000
--- a/XlibExtras.hsc
+++ /dev/null
@@ -1,253 +0,0 @@
-module XlibExtras where
-
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Types
-import Foreign
-import Foreign.C.Types
-import Control.Monad (ap)
-
-#include "XlibExtras.h"
-
-data Event 
-    = AnyEvent
-        { event_type            :: EventType
-        , serial                :: CULong
-        , send_event            :: Bool
-        , event_display         :: Display
-        , window                :: Window
-        }
-    | ConfigureRequestEvent
-        { event_type            :: EventType
-        , serial                :: CULong
-        , send_event            :: Bool
-        , event_display         :: Display
-        , parent                :: Window
-        , window                :: Window
-        , x                     :: Int
-        , y                     :: Int
-        , width                 :: Int
-        , height                :: Int
-        , border_width          :: Int
-        , above                 :: Window
-        , detail                :: Int
-        , value_mask            :: CULong
-        }
-    | MapRequestEvent
-        { event_type            :: EventType
-        , serial                :: CULong
-        , send_event            :: Bool
-        , event_display         :: Display
-        , parent                :: Window
-        , window                :: Window
-        }
-    | KeyEvent
-        { event_type            :: EventType
-        , serial                :: CULong
-        , send_event            :: Bool
-        , event_display         :: Display
-        , window                :: Window
-        , root                  :: Window
-        , subwindow             :: Window
-        , time                  :: Time
-        , x                     :: Int
-        , y                     :: Int
-        , x_root                :: Int
-        , y_root                :: Int
-        , state                 :: KeyMask
-        , keycode               :: KeyCode
-        , same_screen           :: Bool
-        }
-    | DestroyWindowEvent
-        { event_type            :: EventType
-        , serial                :: CULong
-        , send_event            :: Bool
-        , event_display         :: Display
-        , event                 :: Window
-        , window                :: Window
-        }
-    | UnmapEvent
-        { event_type            :: EventType
-        , serial                :: CULong
-        , send_event            :: Bool
-        , event_display         :: Display
-        , event                 :: Window
-        , window                :: Window
-        , fromConfigure         :: Bool
-        }
-    deriving Show
-
-getEvent :: XEventPtr -> IO Event
-getEvent p = do
-    -- All events share this layout and naming convention, there is also a
-    -- common Window field, but the names for this field vary.
-    type_ <- #{peek XAnyEvent, type} p
-    serial_ <- #{peek XAnyEvent, serial} p
-    send_event_ <- #{peek XAnyEvent, send_event} p
-    display_ <- fmap Display (#{peek XAnyEvent, display} p)
-    case () of
-
-        -------------------------
-        -- ConfigureRequestEvent:
-        -------------------------
-        _ | type_ == configureRequest -> do
-            parent_       <- #{peek XConfigureRequestEvent, parent      } p
-            window_       <- #{peek XConfigureRequestEvent, window      } p
-            x_            <- #{peek XConfigureRequestEvent, x           } p
-            y_            <- #{peek XConfigureRequestEvent, y           } p
-            width_        <- #{peek XConfigureRequestEvent, width       } p
-            height_       <- #{peek XConfigureRequestEvent, height      } p
-            border_width_ <- #{peek XConfigureRequestEvent, border_width} p
-            above_        <- #{peek XConfigureRequestEvent, above       } p
-            detail_       <- #{peek XConfigureRequestEvent, detail      } p
-            value_mask_   <- #{peek XConfigureRequestEvent, value_mask  } p
-            return $ ConfigureRequestEvent
-                        { event_type    = type_
-                        , serial        = serial_
-                        , send_event    = send_event_
-                        , event_display = display_
-                        , parent        = parent_
-                        , window        = window_
-                        , x             = x_
-                        , y             = y_
-                        , width         = width_
-                        , height        = height_
-                        , border_width  = border_width_
-                        , above         = above_
-                        , detail        = detail_
-                        , value_mask    = value_mask_
-                        }
-
-          -------------------
-          -- MapRequestEvent:
-          -------------------
-          | type_ == mapRequest -> do
-            parent_ <- #{peek XMapRequestEvent, parent} p
-            window_ <- #{peek XMapRequestEvent, window} p
-            return $ MapRequestEvent
-                        { event_type    = type_
-                        , serial        = serial_
-                        , send_event    = send_event_
-                        , event_display = display_
-                        , parent        = parent_
-                        , window        = window_
-                        }
-
-          ------------
-          -- KeyEvent:
-          ------------
-          | type_ == keyPress || type_ == keyRelease -> do
-            window_      <- #{peek XKeyEvent, window     } p
-            root_        <- #{peek XKeyEvent, root       } p
-            subwindow_   <- #{peek XKeyEvent, subwindow  } p
-            time_        <- #{peek XKeyEvent, time       } p
-            x_           <- #{peek XKeyEvent, x          } p
-            y_           <- #{peek XKeyEvent, y          } p
-            x_root_      <- #{peek XKeyEvent, x_root     } p
-            y_root_      <- #{peek XKeyEvent, y_root     } p
-            state_       <- #{peek XKeyEvent, state      } p
-            keycode_     <- #{peek XKeyEvent, keycode    } p
-            same_screen_ <- #{peek XKeyEvent, same_screen} p
-            return $ KeyEvent
-                        { event_type    = type_
-                        , serial        = serial_
-                        , send_event    = send_event_
-                        , event_display = display_
-                        , window        = window_
-                        , root          = root_
-                        , subwindow     = subwindow_
-                        , time          = time_
-                        , x             = x_
-                        , y             = y_
-                        , x_root        = x_root_
-                        , y_root        = y_root_
-                        , state         = state_
-                        , keycode       = keycode_
-                        , same_screen   = same_screen_
-                        }
-
-          ----------------------
-          -- DestroyWindowEvent:
-          ----------------------
-          | type_ == destroyNotify -> do
-            event_  <- #{peek XDestroyWindowEvent, event } p
-            window_ <- #{peek XDestroyWindowEvent, window} p
-            return $ DestroyWindowEvent
-                        { event_type    = type_
-                        , serial        = serial_
-                        , send_event    = send_event_
-                        , event_display = display_
-                        , event         = event_
-                        , window        = window_
-                        }
-
-
-          --------------------
-          -- UnmapNotifyEvent:
-          --------------------
-          | type_ == unmapNotify -> do
-            event_         <- #{peek XUnmapEvent, event         } p
-            window_        <- #{peek XUnmapEvent, window        } p
-            fromConfigure_ <- #{peek XUnmapEvent, from_configure} p
-            return $ UnmapEvent
-                        { event_type    = type_
-                        , serial        = serial_
-                        , send_event    = send_event_
-                        , event_display = display_
-                        , event         = event_
-                        , window        = window_
-                        , fromConfigure = fromConfigure_
-                        }
-
-          -- We don't handle this event specifically, so return the generic
-          -- AnyEvent.
-          | otherwise -> do
-            window_ <- #{peek XAnyEvent, window} p
-            return $ AnyEvent
-                        { event_type    = type_
-                        , serial        = serial_
-                        , send_event    = send_event_
-                        , event_display = display_
-                        , window        = window_
-                        }
-
-data WindowChanges = WindowChanges
-                        { wcX :: Int
-                        , wcY :: Int
-                        , wcWidth :: Int
-                        , wcHeight:: Int
-                        , wcBorderWidth :: Int
-                        , wcSibling :: Window
-                        , wcStackMode :: Int
-                        }
-
-instance Storable WindowChanges where
-    sizeOf _ = #{size XWindowChanges}
-
-    -- I really hope this is right:
-    alignment _ = alignment (undefined :: Int)
-
-    poke p wc = do
-        #{poke XWindowChanges, x           } p $ wcX wc
-        #{poke XWindowChanges, y           } p $ wcY wc
-        #{poke XWindowChanges, width       } p $ wcWidth wc
-        #{poke XWindowChanges, height      } p $ wcHeight wc
-        #{poke XWindowChanges, border_width} p $ wcBorderWidth wc
-        #{poke XWindowChanges, sibling     } p $ wcSibling wc
-        #{poke XWindowChanges, stack_mode  } p $ wcStackMode wc
-        
-    peek p = return WindowChanges
-                `ap` (#{peek XWindowChanges, x} p)
-                `ap` (#{peek XWindowChanges, y} p)
-                `ap` (#{peek XWindowChanges, width} p)
-                `ap` (#{peek XWindowChanges, height} p)
-                `ap` (#{peek XWindowChanges, border_width} p)
-                `ap` (#{peek XWindowChanges, sibling} p)
-                `ap` (#{peek XWindowChanges, stack_mode} p)
-
-foreign import ccall unsafe "XlibExtras.h XConfigureWindow"
-    xConfigureWindow :: Display -> Window -> CULong -> Ptr WindowChanges -> IO Int
-
-configureWindow :: Display -> Window -> CULong -> WindowChanges -> IO ()
-configureWindow d w m c = do
-    with c (xConfigureWindow d w m)
-    return ()
diff --git a/include/XlibExtras.h b/include/XlibExtras.h
deleted file mode 100644
index 52fbeaa..0000000
--- a/include/XlibExtras.h
+++ /dev/null
@@ -1,33 +0,0 @@
-/* This file copied from the X11 package */
-
-/* -----------------------------------------------------------------------------
- * Definitions for package `X11' which are visible in Haskell land.
- * ---------------------------------------------------------------------------*
- */
-
-#ifndef XLIBEXTRAS_H
-#define XLIBEXTRAS_H
-#include <stdlib.h>
-/* This doesn't always work, so we play safe below... */
-#define XUTIL_DEFINE_FUNCTIONS
-#include <X11/X.h>
-#include <X11/X.h>
-#include <X11/Xlib.h>
-#include <X11/Xatom.h>
-#include <X11/Xutil.h>
-/* Xutil.h overrides some functions with macros.
- * In recent versions of X this can be turned off with
- *      #define XUTIL_DEFINE_FUNCTIONS
- * before the #include, but this doesn't work with older versions.
- * As a workaround, we undef the macros here.  Note that this is only
- * safe for functions with return type int.
- */
-#undef XDestroyImage
-#undef XGetPixel
-#undef XPutPixel
-#undef XSubImage
-#undef XAddPixel
-#define XK_MISCELLANY
-#define XK_LATIN1
-#include <X11/keysymdef.h>
-#endif
diff --git a/thunk.cabal b/thunk.cabal
index 8d9b3b3..cee19bf 100644
--- a/thunk.cabal
+++ b/thunk.cabal
@@ -7,13 +7,8 @@ license:        BSD3
 license-file:   LICENSE
 author:         Spencer Janssen
 maintainer:     sjanssen@cse.unl.edu
-build-depends:  base >= 2.0, X11, unix, mtl
+build-depends:  base >= 2.0, X11, X11-extras, unix, mtl
 
 executable:     thunk
 main-is:        thunk.hs
-extensions:     ForeignFunctionInterface
-other-modules:  XlibExtras
 ghc-options:    -O
-include-dirs:   include
--- OpenBSD:
--- include-dirs:   include /usr/X11R6/include
diff --git a/thunk.hs b/thunk.hs
index 3a8f92b..bae8b76 100644
--- a/thunk.hs
+++ b/thunk.hs
@@ -8,11 +8,11 @@ import Data.Bits
 import Control.Monad.State
 import System.IO
 import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
 import System.Process (runCommand)
 import System.Exit
 
 import Wm
-import XlibExtras
 
 handler :: Event -> Wm ()
 handler (MapRequestEvent {window = w}) = manage w