module Graphics.X11.Xlib.Extras where
import Data.Typeable ( Typeable )
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Types
import Graphics.X11.Xlib.Misc
import Foreign
import Foreign.C.Types
import Foreign.C.String
import Control.Monad
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]
}
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)
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
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 = 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::[Word32])
_ -> 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
}
| 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
xGetWMNormalHints d w sh supplied_return
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
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
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