module Graphics.X11.Xlib.Extras where
import Data.Maybe
import Data.Typeable ( Typeable )
import Graphics.X11.Xrandr
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, Word32, Int32, plusPtr, castPtr, withArrayLen, setBit, testBit, allocaBytes, FunPtr)
import Foreign.C.Types
import Foreign.C.String
import Control.Monad
import System.IO.Unsafe
data Event
    = AnyEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_window                :: !Window
        }
    | ConfigureRequestEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_parent                :: !Window
        , ev_window                :: !Window
        , ev_x                     :: !CInt
        , ev_y                     :: !CInt
        , ev_width                 :: !CInt
        , ev_height                :: !CInt
        , ev_border_width          :: !CInt
        , ev_above                 :: !Window
        , ev_detail                :: !NotifyDetail
        , ev_value_mask            :: !CULong
        }
    | ConfigureEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_event                 :: !Window
        , ev_window                :: !Window
        , ev_x                     :: !CInt
        , ev_y                     :: !CInt
        , ev_width                 :: !CInt
        , ev_height                :: !CInt
        , ev_border_width          :: !CInt
        , ev_above                 :: !Window
        , ev_override_redirect     :: !Bool
        }
    | MapRequestEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_parent                :: !Window
        , ev_window                :: !Window
        }
    | KeyEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_window                :: !Window
        , ev_root                  :: !Window
        , ev_subwindow             :: !Window
        , ev_time                  :: !Time
        , ev_x                     :: !CInt
        , ev_y                     :: !CInt
        , ev_x_root                :: !CInt
        , ev_y_root                :: !CInt
        , ev_state                 :: !KeyMask
        , ev_keycode               :: !KeyCode
        , ev_same_screen           :: !Bool
        }
    | ButtonEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_window                :: !Window
        , ev_root                  :: !Window
        , ev_subwindow             :: !Window
        , ev_time                  :: !Time
        , ev_x                     :: !CInt
        , ev_y                     :: !CInt
        , ev_x_root                :: !CInt
        , ev_y_root                :: !CInt
        , ev_state                 :: !KeyMask
        , 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
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_event                 :: !Window
        , ev_window                :: !Window
        }
    | UnmapEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_event                 :: !Window
        , ev_window                :: !Window
        , ev_from_configure        :: !Bool
        }
    | MapNotifyEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_event                 :: !Window
        , ev_window                :: !Window
        , ev_override_redirect     :: !Bool
        }
    | MappingNotifyEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_window                :: !Window
        , ev_request               :: !MappingRequest
        , ev_first_keycode         :: !KeyCode
        , ev_count                 :: !CInt
        }
    | CrossingEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_window                :: !Window
        , ev_root                  :: !Window
        , ev_subwindow             :: !Window
        , ev_time                  :: !Time
        , ev_x                     :: !CInt
        , ev_y                     :: !CInt
        , ev_x_root                :: !CInt
        , ev_y_root                :: !CInt
        , ev_mode                  :: !NotifyMode
        , ev_detail                :: !NotifyDetail
        , ev_same_screen           :: !Bool
        , ev_focus                 :: !Bool
        , ev_state                 :: !Modifier
        }
    | SelectionRequest
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_owner                 :: !Window
        , ev_requestor             :: !Window
        , ev_selection             :: !Atom
        , ev_target                :: !Atom
        , ev_property              :: !Atom
        , ev_time                  :: !Time
        }
    | PropertyEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_window                :: !Window
        , ev_atom                  :: !Atom
        , ev_time                  :: !Time
        , ev_propstate             :: !CInt
        }
    | ExposeEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_window                :: !Window
        , ev_x                     :: !CInt
        , ev_y                     :: !CInt
        , ev_width                 :: !CInt
        , ev_height                :: !CInt
        , ev_count                 :: !CInt
        }
    | ClientMessageEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_window                :: !Window
        , ev_message_type          :: !Atom
        , ev_data                  :: ![CInt]
        }
    | RRScreenChangeNotifyEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_window                :: !Window
        , ev_root                  :: !Window
        , ev_timestamp             :: !Time
        , ev_config_timestamp      :: !Time
        , ev_size_index            :: !SizeID
        , ev_subpixel_order        :: !SubpixelOrder
        , ev_rotation              :: !Rotation
        , ev_width                 :: !CInt
        , ev_height                :: !CInt
        , ev_mwidth                :: !CInt
        , ev_mheight               :: !CInt
        }
    | RRNotifyEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_window                :: !Window
        , ev_subtype               :: !CInt
        }
    | RRCrtcChangeNotifyEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_window                :: !Window
        , ev_subtype               :: !CInt
        , ev_crtc                  :: !RRCrtc
        , ev_rr_mode               :: !RRMode
        , ev_rotation              :: !Rotation
        , ev_x                     :: !CInt
        , ev_y                     :: !CInt
        , ev_rr_width              :: !CUInt
        , ev_rr_height             :: !CUInt
        }
    | RROutputChangeNotifyEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_window                :: !Window
        , ev_subtype               :: !CInt
        , ev_output                :: !RROutput
        , ev_crtc                  :: !RRCrtc
        , ev_rr_mode               :: !RRMode
        , ev_rotation              :: !Rotation
        , ev_connection            :: !Connection
        , ev_subpixel_order        :: !SubpixelOrder
        }
    | RROutputPropertyNotifyEvent
        { ev_event_type            :: !EventType
        , ev_serial                :: !CULong
        , ev_send_event            :: !Bool
        , ev_event_display         :: Display
        , ev_window                :: !Window
        , ev_subtype               :: !CInt
        , ev_output                :: !RROutput
        , ev_property              :: !Atom
        , ev_timestamp             :: !Time
        , ev_rr_state              :: !CInt
        }
    deriving ( Show, Typeable )
eventTable :: [(EventType, String)]
eventTable =
    [ (keyPress             , "KeyPress")
    , (keyRelease           , "KeyRelease")
    , (buttonPress          , "ButtonPress")
    , (buttonRelease        , "ButtonRelease")
    , (motionNotify         , "MotionNotify")
    , (enterNotify          , "EnterNotify")
    , (leaveNotify          , "LeaveNotify")
    , (focusIn              , "FocusIn")
    , (focusOut             , "FocusOut")
    , (keymapNotify         , "KeymapNotify")
    , (expose               , "Expose")
    , (graphicsExpose       , "GraphicsExpose")
    , (noExpose             , "NoExpose")
    , (visibilityNotify     , "VisibilityNotify")
    , (createNotify         , "CreateNotify")
    , (destroyNotify        , "DestroyNotify")
    , (unmapNotify          , "UnmapNotify")
    , (mapNotify            , "MapNotify")
    , (mapRequest           , "MapRequest")
    , (reparentNotify       , "ReparentNotify")
    , (configureNotify      , "ConfigureNotify")
    , (configureRequest     , "ConfigureRequest")
    , (gravityNotify        , "GravityNotify")
    , (resizeRequest        , "ResizeRequest")
    , (circulateNotify      , "CirculateNotify")
    , (circulateRequest     , "CirculateRequest")
    , (propertyNotify       , "PropertyNotify")
    , (selectionClear       , "SelectionClear")
    , (selectionRequest     , "SelectionRequest")
    , (selectionNotify      , "SelectionNotify")
    , (colormapNotify       , "ColormapNotify")
    , (clientMessage        , "ClientMessage")
    , (mappingNotify        , "MappingNotify")
    , (lASTEvent            , "LASTEvent")
    ]
eventName :: Event -> String
eventName e = maybe ("unknown " ++ show x) id $ lookup x eventTable
 where x = fromIntegral $ ev_event_type e
getEvent :: XEventPtr -> IO Event
getEvent p = do
    
    
    type_      <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
    serial     <- (\hsc_ptr -> peekByteOff hsc_ptr 4) p
    send_event <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
    display    <- fmap Display ((\hsc_ptr -> peekByteOff hsc_ptr 12) p)
    rrData     <- xrrQueryExtension display
    let rrHasExtension = isJust rrData
    let rrEventBase    = fromIntegral $ fst $ fromMaybe (0, 0) rrData
    case () of
        
        
        
        _ | type_ == configureRequest -> do
            parent       <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
            window       <- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
            x            <- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
            y            <- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
            width        <- (\hsc_ptr -> peekByteOff hsc_ptr 32) p
            height       <- (\hsc_ptr -> peekByteOff hsc_ptr 36) p
            border_width <- (\hsc_ptr -> peekByteOff hsc_ptr 40) p
            above        <- (\hsc_ptr -> peekByteOff hsc_ptr 44) p
            detail       <- (\hsc_ptr -> peekByteOff hsc_ptr 48) p
            value_mask   <- (\hsc_ptr -> peekByteOff hsc_ptr 52) p
            return $ ConfigureRequestEvent
                        { ev_event_type    = type_
                        , ev_serial        = serial
                        , ev_send_event    = send_event
                        , ev_event_display = display
                        , ev_parent        = parent
                        , ev_window        = window
                        , ev_x             = x
                        , ev_y             = y
                        , ev_width         = width
                        , ev_height        = height
                        , ev_border_width  = border_width
                        , ev_above         = above
                        , ev_detail        = detail
                        , ev_value_mask    = value_mask
                        }
          
          
          
          | type_ == configureNotify -> do
            return (ConfigureEvent type_ serial send_event display)
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 16) p
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 20) p
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 24) p
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 28) p
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 32) p
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 36) p
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 40) p
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 44) p
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 48) p
          
          
          
          | type_ == mapRequest -> do
            parent <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
            window <- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
            return $ MapRequestEvent
                        { ev_event_type    = type_
                        , ev_serial        = serial
                        , ev_send_event    = send_event
                        , ev_event_display = display
                        , ev_parent        = parent
                        , ev_window        = window
                        }
          
          
          
          | type_ == mapNotify -> do
            event             <- (\hsc_ptr -> peekByteOff hsc_ptr 16)  p
            window            <- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
            override_redirect <- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
            return $ MapNotifyEvent
                        { ev_event_type        = type_
                        , ev_serial            = serial
                        , ev_send_event        = send_event
                        , ev_event_display     = display
                        , ev_event             = event
                        , ev_window            = window
                        , ev_override_redirect = override_redirect
                        }
          
          
          
          | type_ == mappingNotify -> do
            window        <- (\hsc_ptr -> peekByteOff hsc_ptr 16)          p
            request       <- (\hsc_ptr -> peekByteOff hsc_ptr 20)         p
            first_keycode <- (\hsc_ptr -> peekByteOff hsc_ptr 24)   p
            count         <- (\hsc_ptr -> peekByteOff hsc_ptr 28)           p
            return $ MappingNotifyEvent
                        { ev_event_type    = type_
                        , ev_serial        = serial
                        , ev_send_event    = send_event
                        , ev_event_display = display
                        , ev_window        = window
                        , ev_request       = request
                        , ev_first_keycode = first_keycode
                        , ev_count         = count
                        }
          
          
          
          | type_ == keyPress || type_ == keyRelease -> do
            window      <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
            root        <- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
            subwindow   <- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
            time        <- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
            x           <- (\hsc_ptr -> peekByteOff hsc_ptr 32) p
            y           <- (\hsc_ptr -> peekByteOff hsc_ptr 36) p
            x_root      <- (\hsc_ptr -> peekByteOff hsc_ptr 40) p
            y_root      <- (\hsc_ptr -> peekByteOff hsc_ptr 44) p
            state       <- ((\hsc_ptr -> peekByteOff hsc_ptr 48) p) :: IO CUInt
            keycode     <- ((\hsc_ptr -> peekByteOff hsc_ptr 52) p) :: IO CUInt
            same_screen <- (\hsc_ptr -> peekByteOff hsc_ptr 56) p
            return $ KeyEvent
                        { ev_event_type    = type_
                        , ev_serial        = serial
                        , ev_send_event    = send_event
                        , ev_event_display = display
                        , ev_window        = window
                        , ev_root          = root
                        , ev_subwindow     = subwindow
                        , ev_time          = time
                        , ev_x             = x
                        , ev_y             = y
                        , ev_x_root        = x_root
                        , ev_y_root        = y_root
                        , ev_state         = fromIntegral state
                        , ev_keycode       = fromIntegral keycode
                        , ev_same_screen   = same_screen
                        }
          
          
          
          | type_ == buttonPress || type_ == buttonRelease -> do
            window      <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
            root        <- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
            subwindow   <- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
            time        <- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
            x           <- (\hsc_ptr -> peekByteOff hsc_ptr 32) p
            y           <- (\hsc_ptr -> peekByteOff hsc_ptr 36) p
            x_root      <- (\hsc_ptr -> peekByteOff hsc_ptr 40) p
            y_root      <- (\hsc_ptr -> peekByteOff hsc_ptr 44) p
            state       <- ((\hsc_ptr -> peekByteOff hsc_ptr 48) p) :: IO CUInt
            button      <- (\hsc_ptr -> peekByteOff hsc_ptr 52) p
            same_screen <- (\hsc_ptr -> peekByteOff hsc_ptr 56) p
            return $ ButtonEvent
                        { ev_event_type    = type_
                        , ev_serial        = serial
                        , ev_send_event    = send_event
                        , ev_event_display = display
                        , ev_window        = window
                        , ev_root          = root
                        , ev_subwindow     = subwindow
                        , ev_time          = time
                        , ev_x             = x
                        , ev_y             = y
                        , ev_x_root        = x_root
                        , ev_y_root        = y_root
                        , ev_state         = fromIntegral state
                        , ev_button        = button
                        , ev_same_screen   = same_screen
                        }
          
          
          
          | type_ == motionNotify -> do
            window <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
            x      <- (\hsc_ptr -> peekByteOff hsc_ptr 32) p
            y      <- (\hsc_ptr -> peekByteOff hsc_ptr 36) 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
                        }
          
          
          
          | type_ == destroyNotify -> do
            event  <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
            window <- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
            return $ DestroyWindowEvent
                        { ev_event_type    = type_
                        , ev_serial        = serial
                        , ev_send_event    = send_event
                        , ev_event_display = display
                        , ev_event         = event
                        , ev_window        = window
                        }
          
          
          
          | type_ == unmapNotify -> do
            event          <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
            window         <- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
            from_configure <- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
            return $ UnmapEvent
                        { ev_event_type    = type_
                        , ev_serial        = serial
                        , ev_send_event    = send_event
                        , ev_event_display = display
                        , ev_event         = event
                        , ev_window        = window
                        , ev_from_configure = from_configure
                        }
          
          
          
          | type_ == enterNotify || type_ == leaveNotify -> do
            window        <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
            root          <- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
            subwindow     <- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
            time          <- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
            x             <- (\hsc_ptr -> peekByteOff hsc_ptr 32) p
            y             <- (\hsc_ptr -> peekByteOff hsc_ptr 36) p
            x_root        <- (\hsc_ptr -> peekByteOff hsc_ptr 40) p
            y_root        <- (\hsc_ptr -> peekByteOff hsc_ptr 44) p
            mode          <- (\hsc_ptr -> peekByteOff hsc_ptr 48) p
            detail        <- (\hsc_ptr -> peekByteOff hsc_ptr 52) p
            same_screen   <- (\hsc_ptr -> peekByteOff hsc_ptr 56) p
            focus         <- (\hsc_ptr -> peekByteOff hsc_ptr 60) p
            state         <- ((\hsc_ptr -> peekByteOff hsc_ptr 64) p) :: IO CUInt
            return $ CrossingEvent
                        { ev_event_type    = type_
                        , ev_serial        = serial
                        , ev_send_event    = send_event
                        , ev_event_display = display
                        , ev_window        = window
                        , ev_root          = root
                        , ev_subwindow     = subwindow
                        , ev_time          = time
                        , ev_x             = x
                        , ev_y             = y
                        , ev_x_root        = x_root
                        , ev_y_root        = y_root
                        , ev_mode          = mode
                        , ev_detail        = detail
                        , ev_same_screen   = same_screen
                        , ev_focus         = focus
                        , ev_state         = fromIntegral state
                        }
          
          
          
          | type_ == selectionRequest -> do
            owner          <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
            requestor      <- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
            selection      <- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
            target         <- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
            property       <- (\hsc_ptr -> peekByteOff hsc_ptr 32) p
            time           <- (\hsc_ptr -> peekByteOff hsc_ptr 36) p
            return $ SelectionRequest
                        { ev_event_type    = type_
                        , ev_serial        = serial
                        , ev_send_event    = send_event
                        , ev_event_display = display
                        , ev_owner         = owner
                        , ev_requestor     = requestor
                        , ev_selection     = selection
                        , ev_target        = target
                        , ev_property      = property
                        , ev_time          = time
                        }
          
          
          
          | type_ == propertyNotify -> do
            window <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
            atom   <- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
            time   <- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
            state  <- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
            return $ PropertyEvent
                        { ev_event_type    = type_
                        , ev_serial        = serial
                        , ev_send_event    = send_event
                        , ev_event_display = display
                        , ev_window        = window
                        , ev_atom          = atom
                        , ev_time          = time
                        , ev_propstate     = state
                        }
          
          
          
          | type_ == expose -> do
            window <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
            x      <- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
            y      <- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
            width  <- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
            height <- (\hsc_ptr -> peekByteOff hsc_ptr 32) p
            count  <- (\hsc_ptr -> peekByteOff hsc_ptr 36) p
            return $ ExposeEvent
                        { ev_event_type    = type_
                        , ev_serial        = serial
                        , ev_send_event    = send_event
                        , ev_event_display = display
                        , ev_window        = window
                        , ev_x             = x
                        , ev_y             = y
                        , ev_width         = width
                        , ev_height        = height
                        , ev_count         = count
                        }
          
          
          
          | type_ == clientMessage -> do
            window       <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
            message_type <- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
            format       <- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
            let datPtr =    (\hsc_ptr -> hsc_ptr `plusPtr` 28) p
            dat          <- case (format::CInt) of
                        8  -> do a <- peekArray 20 datPtr
                                 return $ map fromIntegral (a::[Word8])
                        16 -> do a <- peekArray 10 datPtr
                                 return $ map fromIntegral (a::[Word16])
                        32 -> do a <- peekArray 5 datPtr
                                 return $ map fromIntegral (a::[CLong])
                        _  -> error "X11.Extras.clientMessage: illegal value"
            return $ ClientMessageEvent
                        { ev_event_type    = type_
                        , ev_serial        = serial
                        , ev_send_event    = send_event
                        , ev_event_display = display
                        , ev_window        = window
                        , ev_message_type  = message_type
                        , ev_data          = dat
                        }
          
          
          
          | rrHasExtension &&
            type_ == rrEventBase + rrScreenChangeNotify -> do
            window           <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
            root             <- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
            timestamp        <- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
            config_timestamp <- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
            size_index       <- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
            subpixel_order   <- (\hsc_ptr -> peekByteOff hsc_ptr 34) p
            rotation         <- (\hsc_ptr -> peekByteOff hsc_ptr 36) p
            width            <- (\hsc_ptr -> peekByteOff hsc_ptr 40) p
            height           <- (\hsc_ptr -> peekByteOff hsc_ptr 44) p
            mwidth           <- (\hsc_ptr -> peekByteOff hsc_ptr 48) p
            mheight          <- (\hsc_ptr -> peekByteOff hsc_ptr 52) p
            return $ RRScreenChangeNotifyEvent
                        { ev_event_type       = type_
                        , ev_serial           = serial
                        , ev_send_event       = send_event
                        , ev_event_display    = display
                        , ev_window           = window
                        , ev_root             = root
                        , ev_timestamp        = timestamp
                        , ev_config_timestamp = config_timestamp
                        , ev_size_index       = size_index
                        , ev_subpixel_order   = subpixel_order
                        , ev_rotation         = rotation
                        , ev_width            = width
                        , ev_height           = height
                        , ev_mwidth           = mwidth
                        , ev_mheight          = mheight
                        }
          
          
          
          | rrHasExtension &&
            type_ == rrEventBase + rrNotify -> do
            window   <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
            subtype  <- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
            let subtype_ = fromIntegral subtype_
            case () of
                _ | subtype_ == rrNotifyCrtcChange -> do
                    crtc           <- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
                    mode           <- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
                    rotation       <- (\hsc_ptr -> peekByteOff hsc_ptr 32) p
                    x              <- (\hsc_ptr -> peekByteOff hsc_ptr 36) p
                    y              <- (\hsc_ptr -> peekByteOff hsc_ptr 40) p
                    width          <- (\hsc_ptr -> peekByteOff hsc_ptr 44) p
                    height         <- (\hsc_ptr -> peekByteOff hsc_ptr 48) p
                    return $ RRCrtcChangeNotifyEvent
                             { ev_event_type    = type_
                             , ev_serial        = serial
                             , ev_send_event    = send_event
                             , ev_event_display = display
                             , ev_window        = window
                             , ev_subtype       = subtype
                             , ev_crtc          = crtc
                             , ev_rr_mode       = mode
                             , ev_rotation      = rotation
                             , ev_x             = x
                             , ev_y             = y
                             , ev_rr_width      = width
                             , ev_rr_height     = height
                             }
                  | subtype_ == rrNotifyOutputChange -> do
                    output         <- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
                    crtc           <- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
                    mode           <- (\hsc_ptr -> peekByteOff hsc_ptr 32) p
                    rotation       <- (\hsc_ptr -> peekByteOff hsc_ptr 36) p
                    connection     <- (\hsc_ptr -> peekByteOff hsc_ptr 38) p
                    subpixel_order <- (\hsc_ptr -> peekByteOff hsc_ptr 40) p
                    return $ RROutputChangeNotifyEvent
                             { ev_event_type     = type_
                             , ev_serial         = serial
                             , ev_send_event     = send_event
                             , ev_event_display  = display
                             , ev_window         = window
                             , ev_subtype        = subtype
                             , ev_output         = output
                             , ev_crtc           = crtc
                             , ev_rr_mode        = mode
                             , ev_rotation       = rotation
                             , ev_connection     = connection
                             , ev_subpixel_order = subpixel_order
                             }
                  | subtype_ == rrNotifyOutputProperty -> do
                    output         <- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
                    property       <- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
                    timestamp      <- (\hsc_ptr -> peekByteOff hsc_ptr 32) p
                    state          <- (\hsc_ptr -> peekByteOff hsc_ptr 36) p
                    return $ RROutputPropertyNotifyEvent
                             { ev_event_type    = type_
                             , ev_serial        = serial
                             , ev_send_event    = send_event
                             , ev_event_display = display
                             , ev_window        = window
                             , ev_subtype       = subtype
                             , ev_output        = output
                             , ev_property      = property
                             , ev_timestamp     = timestamp
                             , ev_rr_state      = state
                             }
                  
                  
                  | otherwise -> do
                    return $ RRNotifyEvent
                                { ev_event_type    = type_
                                , ev_serial        = serial
                                , ev_send_event    = send_event
                                , ev_event_display = display
                                , ev_window        = window
                                , ev_subtype       = subtype
                                }
          
          
          | otherwise -> do
            window <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
            return $ AnyEvent
                        { ev_event_type    = type_
                        , ev_serial        = serial
                        , ev_send_event    = send_event
                        , ev_event_display = display
                        , ev_window        = window
                        }
data WindowChanges = WindowChanges
                        { wc_x :: CInt
                        , wc_y :: CInt
                        , wc_width :: CInt
                        , wc_height:: CInt
                        , wc_border_width :: CInt
                        , wc_sibling :: Window
                        , wc_stack_mode :: CInt
                        }
instance Storable WindowChanges where
    sizeOf _ = (28)
    
    alignment _ = alignment (undefined :: CInt)
    poke p wc = do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) p $ wc_x wc
        (\hsc_ptr -> pokeByteOff hsc_ptr 4) p $ wc_y wc
        (\hsc_ptr -> pokeByteOff hsc_ptr 8) p $ wc_width wc
        (\hsc_ptr -> pokeByteOff hsc_ptr 12) p $ wc_height wc
        (\hsc_ptr -> pokeByteOff hsc_ptr 16) p $ wc_border_width wc
        (\hsc_ptr -> pokeByteOff hsc_ptr 20) p $ wc_sibling wc
        (\hsc_ptr -> pokeByteOff hsc_ptr 24) p $ wc_stack_mode wc
        
    peek p = return WindowChanges
                `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 0) p)
                `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 4) p)
                `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 8) p)
                `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 12) p)
                `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 16) p)
                `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 20) p)
                `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 24) p)
none :: XID
none = 0
anyButton :: Button
anyButton = 0
anyKey :: KeyCode
anyKey = toEnum 0
currentTime :: Time
currentTime = 0
foreign import ccall unsafe "XlibExtras.h XConfigureWindow"
    xConfigureWindow :: Display -> Window -> CULong -> Ptr WindowChanges -> IO CInt
foreign import ccall unsafe "XlibExtras.h XKillClient"
    killClient :: Display -> Window -> IO CInt
configureWindow :: Display -> Window -> CULong -> WindowChanges -> IO ()
configureWindow d w m c = do
    _ <- with c (xConfigureWindow d w m)
    return ()
foreign import ccall unsafe "XlibExtras.h XFree"
    xFree :: Ptr a -> IO CInt
foreign import ccall unsafe "XlibExtras.h XQueryTree"
    xQueryTree :: Display -> Window -> Ptr Window -> Ptr Window -> Ptr (Ptr Window) -> Ptr CInt -> IO Status
queryTree :: Display -> Window -> IO (Window, Window, [Window])
queryTree d w =
    alloca $ \root_return ->
    alloca $ \parent_return ->
    alloca $ \children_return ->
    alloca $ \nchildren_return -> do
        _ <- xQueryTree d w root_return parent_return children_return nchildren_return
        p <- peek children_return
        n <- fmap fromIntegral $ peek nchildren_return
        ws <- peekArray n p
        _ <- xFree p
        liftM3 (,,) (peek root_return) (peek parent_return) (return ws)
data WindowAttributes = WindowAttributes
            { wa_x, wa_y, wa_width, wa_height, wa_border_width :: CInt
            , wa_map_state :: CInt
            , wa_override_redirect :: Bool
            }
waIsUnmapped, waIsUnviewable, waIsViewable :: CInt
waIsUnmapped   = fromIntegral ( 0   :: CInt )  
waIsUnviewable = fromIntegral ( 1 :: CInt )  
waIsViewable   = fromIntegral ( 2   :: CInt )  
instance Storable WindowAttributes where
    
    alignment _ = alignment (undefined :: CInt)
    sizeOf _ = (92)
    peek p = return WindowAttributes
                `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 0) p)
                `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 4) p)
                `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 8) p)
                `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 12) p)
                `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 16) p)
                `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 68) p)
                `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 84) p)
    poke p wa = do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) p $ wa_x wa
        (\hsc_ptr -> pokeByteOff hsc_ptr 4) p $ wa_y wa
        (\hsc_ptr -> pokeByteOff hsc_ptr 8) p $ wa_width wa
        (\hsc_ptr -> pokeByteOff hsc_ptr 12) p $ wa_height wa
        (\hsc_ptr -> pokeByteOff hsc_ptr 16) p $ wa_border_width wa
        (\hsc_ptr -> pokeByteOff hsc_ptr 68) p $ wa_map_state wa
        (\hsc_ptr -> pokeByteOff hsc_ptr 84) p $ wa_override_redirect wa
foreign import ccall unsafe "XlibExtras.h XGetWindowAttributes"
    xGetWindowAttributes :: Display -> Window -> Ptr (WindowAttributes) -> IO Status
getWindowAttributes :: Display -> Window -> IO WindowAttributes
getWindowAttributes d w = alloca $ \p -> do
    _ <- xGetWindowAttributes d w p
    peek p
foreign import ccall unsafe "XlibExtras.h XChangeWindowAttributes"
        changeWindowAttributes :: Display -> Window -> AttributeMask -> Ptr SetWindowAttributes -> IO ()
withServer :: Display -> IO () -> IO ()
withServer dpy f = do
    grabServer dpy
    f
    ungrabServer dpy
data TextProperty = TextProperty {
        tp_value    :: CString,
        tp_encoding :: Atom,
        tp_format   :: CInt,
        tp_nitems   :: Word32
    }
instance Storable TextProperty where
    sizeOf    _ = (16)
    alignment _ = alignment (undefined :: Word32)
    peek p = TextProperty `fmap` (\hsc_ptr -> peekByteOff hsc_ptr 0) p
                          `ap`   (\hsc_ptr -> peekByteOff hsc_ptr 4) p
                          `ap`   (\hsc_ptr -> peekByteOff hsc_ptr 8) p
                          `ap`   (\hsc_ptr -> peekByteOff hsc_ptr 12) p
    poke p (TextProperty val enc fmt nitems) = do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) p val
        (\hsc_ptr -> pokeByteOff hsc_ptr 4) p enc
        (\hsc_ptr -> pokeByteOff hsc_ptr 8) p fmt
        (\hsc_ptr -> pokeByteOff hsc_ptr 12) 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 ()
newtype FontSet = FontSet (Ptr FontSet)
    deriving (Eq, Ord, Show)
foreign import ccall unsafe "XlibExtras.h XCreateFontSet"
    xCreateFontSet :: Display -> CString -> Ptr (Ptr CString) -> Ptr CInt -> Ptr CString -> IO (Ptr FontSet)
createFontSet :: Display -> String -> IO ([String], String, FontSet)
createFontSet d fn =
    withCString fn $ \fontp  ->
    alloca         $ \listp  ->
    alloca         $ \countp ->
    alloca         $ \defp   -> do
        fs      <- throwIfNull "createFontSet" $
                       xCreateFontSet d fontp listp countp defp
        count   <- peek countp
        list    <- peek listp
        missing <- flip mapM [0..fromIntegral count  1] $ \i ->
                       peekElemOff list i >>= peekCString
        def     <- peek defp >>= peekCString
        freeStringList list
        return (missing, def, FontSet fs)
foreign import ccall unsafe "XlibExtras.h XFreeStringList"
    freeStringList :: Ptr CString -> IO ()
foreign import ccall unsafe "XlibExtras.h XFreeFontSet"
    freeFontSet :: Display -> FontSet -> IO ()
foreign import ccall unsafe "XlibExtras.h XwcTextExtents"
    xwcTextExtents :: FontSet -> CWString -> CInt -> Ptr Rectangle -> Ptr Rectangle -> IO CInt
wcTextExtents :: FontSet -> String -> (Rectangle, Rectangle)
wcTextExtents fs text = unsafePerformIO $
    withCWStringLen text $ \(textp, len) ->
    alloca               $ \inkp          ->
    alloca               $ \logicalp      -> do
        _ <- xwcTextExtents fs textp (fromIntegral len) inkp logicalp
        (,) `fmap` peek inkp `ap` peek logicalp
foreign import ccall unsafe "XlibExtras.h XwcDrawString"
    xwcDrawString :: Display -> Drawable -> FontSet -> GC -> Position -> Position -> CWString -> CInt -> IO ()
wcDrawString :: Display -> Drawable -> FontSet -> GC -> Position -> Position -> String -> IO ()
wcDrawString d w fs gc x y =
    flip withCWStringLen $ \(s, len) ->
        xwcDrawString d w fs gc x y s (fromIntegral len)
foreign import ccall unsafe "XlibExtras.h XwcDrawImageString"
    xwcDrawImageString :: Display -> Drawable -> FontSet -> GC -> Position -> Position -> CWString -> CInt -> IO ()
wcDrawImageString :: Display -> Drawable -> FontSet -> GC -> Position -> Position -> String -> IO ()
wcDrawImageString d w fs gc x y =
    flip withCWStringLen $ \(s, len) ->
        xwcDrawImageString d w fs gc x y s (fromIntegral len)
foreign import ccall unsafe "XlibExtras.h XwcTextEscapement"
    xwcTextEscapement :: FontSet -> CWString -> CInt -> IO Int32
wcTextEscapement :: FontSet -> String -> Int32
wcTextEscapement font_set string = unsafePerformIO $
    withCWStringLen string $ \ (c_string, len) ->
    xwcTextEscapement font_set c_string (fromIntegral len)
foreign import ccall unsafe "XlibExtras.h XFetchName"
    xFetchName :: Display -> Window -> Ptr CString -> IO Status
fetchName :: Display -> Window -> IO (Maybe String)
fetchName d w = alloca $ \p -> do
    _ <- xFetchName d w p
    cstr <- peek p
    if cstr == nullPtr
        then return Nothing
        else do
            str <- peekCString cstr
            _ <- xFree cstr
            return $ Just str
foreign import ccall unsafe "XlibExtras.h XGetTransientForHint"
    xGetTransientForHint :: Display -> Window -> Ptr Window -> IO Status
getTransientForHint :: Display -> Window -> IO (Maybe Window)
getTransientForHint d w = alloca $ \wp -> do
    status <- xGetTransientForHint d w wp
    if status == 0
        then return Nothing
        else Just `liftM` peek wp
getWMProtocols :: Display -> Window -> IO [Atom]
getWMProtocols display w = do
    alloca $ \atom_ptr_ptr ->
      alloca $ \count_ptr -> do
       st <- xGetWMProtocols display w atom_ptr_ptr count_ptr
       if st == 0
            then return []
            else do sz       <- peek count_ptr
                    atom_ptr <- peek atom_ptr_ptr
                    atoms    <- peekArray (fromIntegral sz) atom_ptr
                    _ <- xFree atom_ptr
                    return atoms
foreign import ccall unsafe "HsXlib.h XGetWMProtocols"
    xGetWMProtocols :: Display -> Window -> Ptr (Ptr Atom) -> Ptr CInt -> IO Status
setEventType :: XEventPtr -> EventType -> IO ()
setEventType = (\hsc_ptr -> pokeByteOff hsc_ptr 0)
setSelectionNotify :: XEventPtr -> Window -> Atom -> Atom -> Atom -> Time -> IO ()
setSelectionNotify p requestor selection target property time = do
    setEventType p selectionNotify
    (\hsc_ptr -> pokeByteOff hsc_ptr 16)    p requestor
    (\hsc_ptr -> pokeByteOff hsc_ptr 20)    p selection
    (\hsc_ptr -> pokeByteOff hsc_ptr 24)       p target
    (\hsc_ptr -> pokeByteOff hsc_ptr 28)     p property
    (\hsc_ptr -> pokeByteOff hsc_ptr 32)         p time
setClientMessageEvent :: XEventPtr -> Window -> Atom -> CInt -> Atom -> Time -> IO ()
setClientMessageEvent p window message_type format l_0_ l_1_ = do
    (\hsc_ptr -> pokeByteOff hsc_ptr 16)         p window
    (\hsc_ptr -> pokeByteOff hsc_ptr 20)   p message_type
    (\hsc_ptr -> pokeByteOff hsc_ptr 24)         p format
    let datap = (\hsc_ptr -> hsc_ptr `plusPtr` 28) p :: Ptr CLong
    poke        datap   (fromIntegral l_0_) 
    pokeElemOff datap 1 (fromIntegral l_1_)
    return ()
setConfigureEvent :: XEventPtr -> Window -> Window -> CInt -> CInt -> CInt -> CInt -> CInt -> Window -> Bool -> IO ()
setConfigureEvent p ev win x y w h bw abv org = do
    (\hsc_ptr -> pokeByteOff hsc_ptr 16) p ev
    (\hsc_ptr -> pokeByteOff hsc_ptr 20) p win
    (\hsc_ptr -> pokeByteOff hsc_ptr 24) p x
    (\hsc_ptr -> pokeByteOff hsc_ptr 28) p y
    (\hsc_ptr -> pokeByteOff hsc_ptr 32) p w
    (\hsc_ptr -> pokeByteOff hsc_ptr 36) p h
    (\hsc_ptr -> pokeByteOff hsc_ptr 40) p bw
    (\hsc_ptr -> pokeByteOff hsc_ptr 44) p abv
    (\hsc_ptr -> pokeByteOff hsc_ptr 48) p (if org then 1 else 0 :: CInt)
setKeyEvent :: XEventPtr -> Window -> Window -> Window -> KeyMask -> KeyCode -> Bool -> IO ()
setKeyEvent p win root subwin state keycode sameScreen = do
    (\hsc_ptr -> pokeByteOff hsc_ptr 16) p win
    (\hsc_ptr -> pokeByteOff hsc_ptr 20) p root
    (\hsc_ptr -> pokeByteOff hsc_ptr 24) p subwin
    (\hsc_ptr -> pokeByteOff hsc_ptr 28) p currentTime
    (\hsc_ptr -> pokeByteOff hsc_ptr 32) p (1 :: CInt)
    (\hsc_ptr -> pokeByteOff hsc_ptr 36) p (1 :: CInt)
    (\hsc_ptr -> pokeByteOff hsc_ptr 40) p (1 :: CInt)
    (\hsc_ptr -> pokeByteOff hsc_ptr 44) p (1 :: CInt)
    (\hsc_ptr -> pokeByteOff hsc_ptr 48) p state
    (\hsc_ptr -> pokeByteOff hsc_ptr 52) p keycode
    (\hsc_ptr -> pokeByteOff hsc_ptr 56) p sameScreen
    return ()
foreign import ccall unsafe "XlibExtras.h x11_extras_set_error_handler"
    xSetErrorHandler   :: IO ()
refreshKeyboardMapping :: Event -> IO ()
refreshKeyboardMapping ev@(MappingNotifyEvent {ev_event_display = (Display d)})
 = allocaBytes (32) $ \p -> do
    (\hsc_ptr -> pokeByteOff hsc_ptr 0) p $ ev_event_type    ev
    (\hsc_ptr -> pokeByteOff hsc_ptr 4) p $ ev_serial        ev
    (\hsc_ptr -> pokeByteOff hsc_ptr 8) p $ ev_send_event    ev
    (\hsc_ptr -> pokeByteOff hsc_ptr 12) p $ d
    (\hsc_ptr -> pokeByteOff hsc_ptr 16) p $ ev_window        ev
    (\hsc_ptr -> pokeByteOff hsc_ptr 20) p $ ev_request       ev
    (\hsc_ptr -> pokeByteOff hsc_ptr 24) p $ ev_first_keycode ev
    (\hsc_ptr -> pokeByteOff hsc_ptr 28) p $ ev_count         ev
    _ <- xRefreshKeyboardMapping p
    return ()
refreshKeyboardMapping _ = return ()
foreign import ccall unsafe "XlibExtras.h XRefreshKeyboardMapping"
    xRefreshKeyboardMapping :: Ptr () -> IO CInt
anyPropertyType :: Atom
anyPropertyType = 0
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
        ret <- xGetWindowProperty d w atom 0 0xFFFFFFFF False anyPropertyType
                           actual_type_return
                           actual_format_return
                           nitems_return
                           bytes_after_return
                           prop_return
        if ret /= 0
            then return Nothing
            else do
                prop_ptr      <- peek prop_return
                actual_format <- fromIntegral `fmap` peek actual_format_return
                nitems        <- fromIntegral `fmap` peek nitems_return
                getprop prop_ptr nitems actual_format
  where
    getprop prop_ptr nitems actual_format
        | actual_format == 0    = return Nothing 
        | 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 [CChar])
getWindowProperty8 = rawGetWindowProperty 8
getWindowProperty16 :: Display -> Atom -> Window -> IO (Maybe [CShort])
getWindowProperty16 = rawGetWindowProperty 16
getWindowProperty32 :: Display -> Atom -> Window -> IO (Maybe [CLong])
getWindowProperty32 = rawGetWindowProperty 32
changeProperty8 :: Display -> Window -> Atom -> Atom -> CInt -> [CChar] -> IO ()
changeProperty8 dpy w prop typ mode dat =
    withArrayLen dat $ \ len ptr -> do
        _ <- xChangeProperty dpy w prop typ 8 mode (castPtr ptr) (fromIntegral len)
        return ()
changeProperty16 :: Display -> Window -> Atom -> Atom -> CInt -> [CShort] -> 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 -> [CLong] -> 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 = 0
propModePrepend = 1
propModeAppend = 2
foreign import ccall unsafe "XlibExtras.h XUnmapWindow"
    xUnmapWindow :: Display -> Window -> IO CInt
unmapWindow :: Display -> Window -> IO ()
unmapWindow d w = xUnmapWindow d w >> return ()
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, pMaxSizeBit, pResizeIncBit, pAspectBit, pBaseSizeBit, pWinGravityBit :: Int
pMinSizeBit    = 4
pMaxSizeBit    = 5
pResizeIncBit  = 6
pAspectBit     = 7
pBaseSizeBit   = 8
pWinGravityBit = 9
instance Storable SizeHints where
    alignment _ = alignment (undefined :: CInt)
    sizeOf _ = (72)
    poke p sh = do
      let whenSet f x = maybe (return ()) x (f sh)
      let pokeFlag b = do flag <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p :: IO CLong
                          (\hsc_ptr -> pokeByteOff hsc_ptr 0) p (setBit flag b)
      (\hsc_ptr -> pokeByteOff hsc_ptr 0) p (0 :: CLong)
      whenSet sh_min_size $ \(w, h) -> do
        pokeFlag pMinSizeBit
        (\hsc_ptr -> pokeByteOff hsc_ptr 20) p w
        (\hsc_ptr -> pokeByteOff hsc_ptr 24) p h
      whenSet sh_max_size $ \(w, h) -> do
        pokeFlag pMaxSizeBit
        (\hsc_ptr -> pokeByteOff hsc_ptr 28) p w
        (\hsc_ptr -> pokeByteOff hsc_ptr 32) p h
      whenSet sh_resize_inc $ \(w, h) -> do
        pokeFlag pResizeIncBit
        (\hsc_ptr -> pokeByteOff hsc_ptr 36) p w
        (\hsc_ptr -> pokeByteOff hsc_ptr 40) p h
      whenSet sh_aspect $ \((minx, miny), (maxx, maxy)) -> do
        pokeFlag pAspectBit
        (\hsc_ptr -> pokeByteOff hsc_ptr 44) p minx
        (\hsc_ptr -> pokeByteOff hsc_ptr 48) p miny
        (\hsc_ptr -> pokeByteOff hsc_ptr 52) p maxx
        (\hsc_ptr -> pokeByteOff hsc_ptr 56) p maxy
      whenSet sh_base_size $ \(w, h) -> do
        pokeFlag pBaseSizeBit
        (\hsc_ptr -> pokeByteOff hsc_ptr 60) p w
        (\hsc_ptr -> pokeByteOff hsc_ptr 64) p h
      whenSet sh_win_gravity $ \g -> do
        pokeFlag pWinGravityBit
        (\hsc_ptr -> pokeByteOff hsc_ptr 68) p g
    peek p = do
      flags <- (\hsc_ptr -> peekByteOff hsc_ptr 0) 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 (,) ((\hsc_ptr -> peekByteOff hsc_ptr 20) p)
                                                    ((\hsc_ptr -> peekByteOff hsc_ptr 24) p))
         `ap` whenBit pMaxSizeBit    (do liftM2 (,) ((\hsc_ptr -> peekByteOff hsc_ptr 28) p)
                                                    ((\hsc_ptr -> peekByteOff hsc_ptr 32) p))
         `ap` whenBit pResizeIncBit  (do liftM2 (,) ((\hsc_ptr -> peekByteOff hsc_ptr 36) p)
                                                    ((\hsc_ptr -> peekByteOff hsc_ptr 40) p))
         `ap` whenBit pAspectBit     (do minx <- (\hsc_ptr -> peekByteOff hsc_ptr 44) p
                                         miny <- (\hsc_ptr -> peekByteOff hsc_ptr 48) p
                                         maxx <- (\hsc_ptr -> peekByteOff hsc_ptr 52) p
                                         maxy <- (\hsc_ptr -> peekByteOff hsc_ptr 56) p
                                         return ((minx, miny), (maxx, maxy)))
         `ap` whenBit pBaseSizeBit   (do liftM2 (,) ((\hsc_ptr -> peekByteOff hsc_ptr 60) p)
                                                    ((\hsc_ptr -> peekByteOff hsc_ptr 64) p))
         `ap` whenBit pWinGravityBit ((\hsc_ptr -> peekByteOff hsc_ptr 68) 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
          
          status <- xGetWMNormalHints d w sh supplied_return
          case status of
            0 -> return (SizeHints Nothing Nothing Nothing Nothing Nothing Nothing)
            _ -> peek sh
data ClassHint = ClassHint
                        { resName  :: String
                        , resClass :: String
                        }
getClassHint :: Display -> Window -> IO ClassHint
getClassHint d w =  allocaBytes ((8)) $ \ p -> do
    s <- xGetClassHint d w p
    if s /= 0 
        then do
            res_name_p <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
            res_class_p <- (\hsc_ptr -> peekByteOff hsc_ptr 4) 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
withdrawnState,normalState, iconicState :: Int
withdrawnState = 0
normalState    = 1
iconicState    = 3
inputHintBit,stateHintBit,iconPixmapHintBit,iconWindowHintBit,iconPositionHintBit,iconMaskHintBit,windowGroupHintBit,urgencyHintBit :: Int
inputHintBit        = 0
stateHintBit        = 1
iconPixmapHintBit   = 2
iconWindowHintBit   = 3
iconPositionHintBit = 4
iconMaskHintBit     = 5
windowGroupHintBit  = 6
urgencyHintBit      = 8
allHintsBitmask :: CLong
allHintsBitmask    = 127
data WMHints = WMHints
                 { wmh_flags         :: CLong
                 , wmh_input         :: Bool
                 , wmh_initial_state :: CInt
                 , wmh_icon_pixmap   :: Pixmap
                 , wmh_icon_window   :: Window
                 , wmh_icon_x        :: CInt
                 , wmh_icon_y        :: CInt
                 , wmh_icon_mask     :: Pixmap
                 , wmh_window_group  :: XID
                 }
instance Storable WMHints where
    
    alignment _ = alignment (undefined :: CLong)
    sizeOf _ = (36)
    peek p = return WMHints
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 0)         p
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 4)         p
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 8) p
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 12)   p
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 16)   p
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 20)        p
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 20)        p
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 28)     p
                `ap` (\hsc_ptr -> peekByteOff hsc_ptr 32)  p
    poke p wmh = do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0)         p $ wmh_flags         wmh
        (\hsc_ptr -> pokeByteOff hsc_ptr 4)         p $ wmh_input         wmh
        (\hsc_ptr -> pokeByteOff hsc_ptr 8) p $ wmh_initial_state wmh
        (\hsc_ptr -> pokeByteOff hsc_ptr 12)   p $ wmh_icon_pixmap   wmh
        (\hsc_ptr -> pokeByteOff hsc_ptr 16)   p $ wmh_icon_window   wmh
        (\hsc_ptr -> pokeByteOff hsc_ptr 20)        p $ wmh_icon_x        wmh
        (\hsc_ptr -> pokeByteOff hsc_ptr 24)        p $ wmh_icon_y        wmh
        (\hsc_ptr -> pokeByteOff hsc_ptr 28)     p $ wmh_icon_mask     wmh
        (\hsc_ptr -> pokeByteOff hsc_ptr 32)  p $ wmh_window_group  wmh
foreign import ccall unsafe "XlibExtras.h XGetWMHints"
    xGetWMHints :: Display -> Window -> IO (Ptr WMHints)
getWMHints :: Display -> Window -> IO WMHints
getWMHints dpy w = do
    p <- xGetWMHints dpy w
    if p == nullPtr
        then return $ WMHints 0 False 0 0 0 0 0 0 0
        else do x <- peek p; _ <- xFree p; return x
foreign import ccall unsafe "XlibExtras.h XAllocWMHints"
    xAllocWMHints :: IO (Ptr WMHints)
foreign import ccall unsafe "XlibExtras.h XSetWMHints"
    xSetWMHints :: Display -> Window -> Ptr WMHints -> IO Status
setWMHints :: Display -> Window -> WMHints -> IO Status
setWMHints dpy w wmh = do
    p_wmh <- xAllocWMHints
    poke p_wmh wmh
    res <- xSetWMHints dpy w p_wmh
    _ <- xFree p_wmh
    return res
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
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 ()
type XErrorEventPtr = Ptr ()
type CXErrorHandler = Display -> XErrorEventPtr -> IO CInt
type XErrorHandler = Display -> XErrorEventPtr -> IO ()
data ErrorEvent = ErrorEvent {
    ev_type :: !CInt,
    ev_display :: Display,
    ev_serialnum :: !CULong,
    ev_error_code :: !CUChar,
    ev_request_code :: !CUChar,
    ev_minor_code :: !CUChar,
    ev_resourceid :: !XID
}
foreign import ccall safe "wrapper"
    mkXErrorHandler :: CXErrorHandler -> IO (FunPtr CXErrorHandler)
foreign import ccall safe "dynamic"
    getXErrorHandler :: FunPtr CXErrorHandler -> CXErrorHandler
foreign import ccall safe "HsXlib.h XSetErrorHandler"
    _xSetErrorHandler :: FunPtr CXErrorHandler -> IO (FunPtr CXErrorHandler)
setErrorHandler :: XErrorHandler -> IO ()
setErrorHandler new_handler = do
    _handler <- mkXErrorHandler (\d -> \e -> new_handler d e >> return 0)
    _ <- _xSetErrorHandler _handler
    return ()
getErrorEvent :: XErrorEventPtr -> IO ErrorEvent
getErrorEvent ev_ptr = do
    _type <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ev_ptr
    serial <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ev_ptr
    dsp <- fmap Display ((\hsc_ptr -> peekByteOff hsc_ptr 4) ev_ptr)
    error_code <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ev_ptr
    request_code <- (\hsc_ptr -> peekByteOff hsc_ptr 17) ev_ptr
    minor_code <- (\hsc_ptr -> peekByteOff hsc_ptr 18) ev_ptr
    resourceid <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ev_ptr
    return $ ErrorEvent {
        ev_type = _type,
        ev_display = dsp,
        ev_serialnum = serial,
        ev_error_code = error_code,
        ev_request_code = request_code,
        ev_minor_code = minor_code,
        ev_resourceid = resourceid
    }
foreign import ccall unsafe "HsXlib.h XMapRaised"
    mapRaised :: Display -> Window -> IO CInt
foreign import ccall unsafe "HsXlib.h XGetCommand"
    xGetCommand :: Display -> Window -> Ptr (Ptr CWString) -> Ptr CInt -> IO Status
getCommand :: Display -> Window -> IO [String]
getCommand d w =
  alloca $
  \argvp ->
  alloca $
  \argcp ->
  do
    _ <- throwIf (success >) (\status -> "xGetCommand returned status: " ++ show status) $ xGetCommand d w argvp argcp
    argc <- peek argcp
    argv <- peek argvp
    texts <- flip mapM [0 .. fromIntegral $ pred argc] $ \i -> peekElemOff argv i >>= peekCWString
    wcFreeStringList argv
    return texts
foreign import ccall unsafe "HsXlib.h XGetModifierMapping"
    xGetModifierMapping :: Display -> IO (Ptr ())
foreign import ccall unsafe "HsXlib.h XFreeModifiermap"
    xFreeModifiermap :: Ptr () -> IO (Ptr CInt)
getModifierMapping :: Display -> IO [(Modifier, [KeyCode])]
getModifierMapping d = do
    p <- xGetModifierMapping d
    m' <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p :: IO CInt
    let m = fromIntegral m'
    pks <- (\hsc_ptr -> peekByteOff hsc_ptr 4) p :: IO (Ptr KeyCode)
    ks <- peekArray (m * 8) pks
    _ <- xFreeModifiermap p
    return . zip masks . map fst . tail . iterate (splitAt m . snd) $ ([], ks)
 where
    masks = [shiftMapIndex .. mod5MapIndex]