{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.X11.Xlib.Misc
-- Copyright   :  (c) Alastair Reid, 1999-2003
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- A collection of FFI declarations for interfacing with Xlib.
--
-----------------------------------------------------------------------------

module Graphics.X11.Xlib.Misc(

        rmInitialize,
        autoRepeatOff,
        autoRepeatOn,
        bell,
        setCloseDownMode,
        lastKnownRequestProcessed,
        getInputFocus,
        setInputFocus,
        grabButton,
        ungrabButton,
        grabPointer,
        ungrabPointer,
        grabKey,
        ungrabKey,
        grabKeyboard,
        ungrabKeyboard,
        grabServer,
        ungrabServer,
        queryBestTile,
        queryBestStipple,
        queryBestCursor,
        queryBestSize,
        queryPointer,

        -- * Error reporting
        displayName,
        setDefaultErrorHandler,

        -- * Geometry
        geometry,
        getGeometry,

        -- * Locale
        supportsLocale,
        setLocaleModifiers,

        -- * Screen saver
        AllowExposuresMode,
        dontAllowExposures,
        allowExposures,
        defaultExposures,
        PreferBlankingMode,
        dontPreferBlanking,
        preferBlanking,
        defaultBlanking,
        ScreenSaverMode,
        screenSaverActive,
        screenSaverReset,
        getScreenSaver,
        setScreenSaver,
        activateScreenSaver,
        resetScreenSaver,
        forceScreenSaver,

        -- * Pointer
        getPointerControl,
        warpPointer,

        -- * Visuals
        visualIDFromVisual,
        VisualInfoMask,
        visualNoMask,
        visualIDMask,
        visualScreenMask,
        visualDepthMask,
        visualClassMask,
        visualRedMaskMask,
        visualGreenMaskMask,
        visualBlueMaskMask,
        visualColormapSizeMask,
        visualBitsPerRGBMask,
        visualAllMask,
        getVisualInfo,
        matchVisualInfo,

        -- * Threads
        initThreads,
        lockDisplay,
        unlockDisplay,

        -- * Pixmaps
        createPixmap,
        freePixmap,
        bitmapBitOrder,
        bitmapUnit,
        bitmapPad,
        readBitmapFile,

        -- * Keycodes
        displayKeycodes,
        lookupKeysym,
        keycodeToKeysym,
        keysymToKeycode,
        keysymToString,
        stringToKeysym,
        noSymbol,
        lookupString,

        -- * Icons
        getIconName,
        setIconName,

        -- * Cursors
        defineCursor,
        undefineCursor,
        createPixmapCursor,
        createGlyphCursor,
        createFontCursor,
        freeCursor,
        recolorCursor,

        -- * Window manager stuff
        setWMProtocols,

        -- * Set window attributes
        allocaSetWindowAttributes,
        set_background_pixmap,
        set_background_pixel,
        set_border_pixmap,
        set_border_pixel,
        set_bit_gravity,
        set_win_gravity,
        set_backing_store,
        set_backing_planes,
        set_backing_pixel,
        set_save_under,
        set_event_mask,
        set_do_not_propagate_mask,
        set_override_redirect,
        set_colormap,
        set_cursor,

        -- * Drawing
        drawPoint,
        drawPoints,
        drawLine,
        drawLines,
        drawSegments,
        drawRectangle,
        drawRectangles,
        drawArc,
        drawArcs,
        fillRectangle,
        fillRectangles,
        fillPolygon,
        fillArc,
        fillArcs,
        copyArea,
        copyPlane,
        drawString,
        drawImageString,

        -- * Cut and paste buffers
        storeBuffer,
        storeBytes,
        fetchBuffer,
        fetchBytes,
        rotateBuffers,

        -- * Window properties
        setTextProperty,

        ) where

import Graphics.X11.Types
import Graphics.X11.Xlib.Types
import Graphics.X11.Xlib.Atom
import Graphics.X11.Xlib.Event
import Graphics.X11.Xlib.Font
import Graphics.X11.Xlib.Internal

import Foreign (Storable, Ptr, alloca, peek, throwIfNull, with, withArrayLen, allocaBytes, pokeByteOff, withArray, FunPtr, nullPtr, Word32, peekArray)
import Foreign.C

import System.IO.Unsafe

#if __GLASGOW_HASKELL__
import Data.Data
#endif

#include "HsXlib.h"

-- I'm not sure why I added this since I don't have any of the related
-- functions.

-- | interface to the X11 library function @XrmInitialize()@.
foreign import ccall unsafe "HsXlib.h XrmInitialize"
        rmInitialize :: IO ()

-- %fun XGetDefault :: Display -> String -> String -> IO ()

-- | interface to the X11 library function @XAutoRepeatOff()@.
foreign import ccall unsafe "HsXlib.h XAutoRepeatOff"
        autoRepeatOff    :: Display -> IO ()

-- | interface to the X11 library function @XAutoRepeatOn()@.
foreign import ccall unsafe "HsXlib.h XAutoRepeatOn"
        autoRepeatOn     :: Display -> IO ()

-- | interface to the X11 library function @XBell()@.
foreign import ccall unsafe "HsXlib.h XBell"
        bell             :: Display -> CInt -> IO ()

-- | interface to the X11 library function @XSetCloseDownMode()@.
foreign import ccall unsafe "HsXlib.h XSetCloseDownMode"
        setCloseDownMode :: Display -> CloseDownMode -> IO ()

-- | interface to the X11 library function @XLastKnownRequestProcessed()@.
foreign import ccall unsafe "HsXlib.h XLastKnownRequestProcessed"
        lastKnownRequestProcessed :: Display -> IO CInt

-- | interface to the X11 library function @XGetInputFocus()@.
getInputFocus :: Display -> IO (Window, FocusMode)
getInputFocus display =
        alloca $ \ focus_return ->
        alloca $ \ revert_to_return -> do
        xGetInputFocus display focus_return revert_to_return
        focus <- peek focus_return
        revert_to <- peek revert_to_return
        return (focus, revert_to)
foreign import ccall unsafe "HsXlib.h XGetInputFocus"
        xGetInputFocus :: Display -> Ptr Window -> Ptr FocusMode -> IO ()

-- | interface to the X11 library function @XSetInputFocus()@.
foreign import ccall unsafe "HsXlib.h XSetInputFocus"
        setInputFocus   :: Display -> Window -> FocusMode -> Time -> IO ()

-- XAllocID omitted
-- XKillClient omitted
-- XFetchName omitted
-- XGetKeyboardControl omitted
-- XChangeKeyboardControl omitted
-- XChangeKeyboardMapping omitted
-- XChangePointerControl omitted

-- | interface to the X11 library function @XGrabButton()@.
foreign import ccall unsafe "HsXlib.h XGrabButton"
        grabButton     :: Display -> Button -> ButtonMask -> Window -> Bool -> EventMask -> GrabMode -> GrabMode -> Window -> Cursor -> IO ()

-- | interface to the X11 library function @XUngrabButton()@.
foreign import ccall unsafe "HsXlib.h XUngrabButton"
        ungrabButton   :: Display -> Button -> ButtonMask -> Window -> IO ()

-- | interface to the X11 library function @XGrabPointer()@.
foreign import ccall unsafe "HsXlib.h XGrabPointer"
        grabPointer    :: Display -> Window -> Bool -> EventMask -> GrabMode -> GrabMode -> Window -> Cursor -> Time -> IO GrabStatus

-- | interface to the X11 library function @XUngrabPointer()@.
foreign import ccall unsafe "HsXlib.h XUngrabPointer"
        ungrabPointer  :: Display -> Time -> IO ()

-- | interface to the X11 library function @XGrabKey()@.
foreign import ccall unsafe "HsXlib.h XGrabKey"
        grabKey        :: Display -> KeyCode -> KeyMask -> Window -> Bool -> GrabMode -> GrabMode -> IO ()

-- | interface to the X11 library function @XUngrabKey()@.
foreign import ccall unsafe "HsXlib.h XUngrabKey"
        ungrabKey      :: Display -> KeyCode -> KeyMask -> Window -> IO ()

-- | interface to the X11 library function @XGrabKeyboard()@.
foreign import ccall unsafe "HsXlib.h XGrabKeyboard"
        grabKeyboard   :: Display -> Window -> Bool -> GrabMode -> GrabMode -> Time -> IO GrabStatus

-- | interface to the X11 library function @XUngrabKeyboard()@.
foreign import ccall unsafe "HsXlib.h XUngrabKeyboard"
        ungrabKeyboard :: Display -> Time -> IO ()

-- | interface to the X11 library function @XGrabServer()@.
foreign import ccall unsafe "HsXlib.h XGrabServer"
        grabServer   :: Display -> IO ()

-- | interface to the X11 library function @XUngrabServer()@.
foreign import ccall unsafe "HsXlib.h XUngrabServer"
        ungrabServer :: Display -> IO ()

-- XChangeActivePointerGrab omitted

-- XFreeStringList omitted

-- | interface to the X11 library function @XQueryBestTile()@.
queryBestTile    :: Display -> Drawable -> Dimension -> Dimension ->
                        IO (Dimension, Dimension)
queryBestTile display which_screen width height =
        outParameters2 (throwIfZero "queryBestTile") $
                xQueryBestTile display which_screen width height
foreign import ccall unsafe "HsXlib.h XQueryBestTile"
        xQueryBestTile    :: Display -> Drawable -> Dimension -> Dimension ->
                                Ptr Dimension -> Ptr Dimension -> IO Status

-- | interface to the X11 library function @XQueryBestStipple()@.
queryBestStipple :: Display -> Drawable -> Dimension -> Dimension ->
                        IO (Dimension, Dimension)
queryBestStipple display which_screen width height =
        outParameters2 (throwIfZero "queryBestStipple") $
                xQueryBestStipple display which_screen width height
foreign import ccall unsafe "HsXlib.h XQueryBestStipple"
        xQueryBestStipple :: Display -> Drawable -> Dimension -> Dimension ->
                                Ptr Dimension -> Ptr Dimension -> IO Status

-- | interface to the X11 library function @XQueryBestCursor()@.
queryBestCursor  :: Display -> Drawable -> Dimension -> Dimension ->
                        IO (Dimension, Dimension)
queryBestCursor display d width height =
        outParameters2 (throwIfZero "queryBestCursor") $
                xQueryBestCursor display d width height
foreign import ccall unsafe "HsXlib.h XQueryBestCursor"
        xQueryBestCursor  :: Display -> Drawable -> Dimension -> Dimension ->
                                Ptr Dimension -> Ptr Dimension -> IO Status

-- | interface to the X11 library function @XQueryBestSize()@.
queryBestSize    :: Display -> QueryBestSizeClass -> Drawable ->
                        Dimension -> Dimension -> IO (Dimension, Dimension)
queryBestSize display shape_class which_screen width height =
        outParameters2 (throwIfZero "queryBestSize") $
                xQueryBestSize display shape_class which_screen width height
foreign import ccall unsafe "HsXlib.h XQueryBestSize"
        xQueryBestSize    :: Display -> QueryBestSizeClass -> Drawable ->
                                Dimension -> Dimension ->
                                Ptr Dimension -> Ptr Dimension -> IO Status

-- Note: Returns false if pointer not in window w (and win_x = win_y = 0)
-- ToDo: more effective use of Maybes?

-- | interface to the X11 library function @XQueryPointer()@.
queryPointer :: Display -> Window ->
                IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
queryPointer display w =
        alloca $ \ root_return ->
        alloca $ \ child_return ->
        alloca $ \ root_x_return ->
        alloca $ \ root_y_return ->
        alloca $ \ win_x_return ->
        alloca $ \ win_y_return ->
        alloca $ \ mask_return -> do
        rel <- xQueryPointer display w root_return child_return root_x_return
                root_y_return win_x_return win_y_return mask_return
        root <- peek root_return
        child <- peek child_return
        root_x <- peek root_x_return
        root_y <- peek root_y_return
        win_x <- peek win_x_return
        win_y <- peek win_y_return
        mask <- peek mask_return
        return (rel, root, child, root_x, root_y, win_x, win_y, mask)
foreign import ccall unsafe "HsXlib.h XQueryPointer"
        xQueryPointer :: Display -> Window ->
                Ptr Window -> Ptr Window -> Ptr CInt -> Ptr CInt ->
                Ptr CInt -> Ptr CInt -> Ptr Modifier -> IO Bool

-- XSetSelectionOwner omitted

-- XOpenOM omitted
-- XCloseOM omitted
-- XSetOMValues omitted
-- XGetOMValues omitted
-- DisplayOfOM omitted
-- XLocaleOfOM omitted

-- XCreateOC omitted
-- XDestroyOC omitted
-- XOMOfOC omitted
-- XSetOCValues omitted
-- XGetOCValues omitted

-- XVaCreateNestedList omitted

----------------------------------------------------------------
-- Error reporting
----------------------------------------------------------------

-- | interface to the X11 library function @XDisplayName()@.
displayName :: String -> String
displayName str = unsafePerformIO $
        withCString str $ \ c_str -> do
        c_name <- xDisplayName c_str
        peekCString c_name
foreign import ccall unsafe "HsXlib.h XDisplayName"
        xDisplayName :: CString -> IO CString

-- type ErrorHandler   = Display -> ErrorEvent -> IO CInt
-- %dis errorHandler x = (stable x)
--
-- type IOErrorHandler = Display ->                IO CInt
-- %dis ioErrorHandler x = (stable x)

-- Sadly, this code doesn't work because hugs->runIO creates a fresh
-- stack of exception handlers so the exception gets thrown to the
-- wrong place.
--
-- %C
-- % static HugsStablePtr ioErrorHandlerPtr;
-- %
-- % int genericIOErrorHandler(Display *d)
-- % {
-- %     if (ioErrorHandlerPtr >= 0) {
-- %              hugs->putStablePtr(ioErrorHandlerPtr);
-- %              hugs->putAddr(d);
-- %              if (hugs->runIO(1)) { /* exitWith value returned */
-- %               return hugs->getInt();
-- %              } else {
-- %               return hugs->getWord();
-- %              }
-- %     }
-- %     return 1;
-- % }

-- Here's what we might do instead.  The two error handlers set flags
-- when they fire and every single call to X contains the line:
--
--   %fail { errorFlags != 0 } { XError(errorFlags) }
--
-- This really sucks.
-- Oh, and it won't even work with IOErrors since they terminate
-- the process if the handler returns.  I don't know what the hell they
-- think they're doing taking it upon themselves to terminate MY
-- process when THEIR library has a problem but I don't think anyone
-- ever accused X of being well-designed.
--
-- % static int genericIOErrorHandler(Display *d)
-- % {
-- %     if (ioErrorHandlerPtr >= 0) {
-- %              hugs->putStablePtr(ioErrorHandlerPtr);
-- %              hugs->putAddr(d);
-- %              if (hugs->runIO(1)) { /* exitWith value returned */
-- %               return hugs->getInt();
-- %              } else {
-- %               return hugs->getWord();
-- %              }
-- %     }
-- %     return 1;
-- % }

-- HN 2001-02-06
-- Moved to auxiliaries.c to make it easier to use the inlining option.
-- -- Sigh, for now we just use an error handler that prints an error
-- -- message on the screen
-- %C
-- % static int defaultErrorHandler(Display *d, XErrorEvent *ev)
-- % {
-- %      char buffer[1000];
-- %      XGetErrorText(d,ev->error_code,buffer,1000);
-- %      printf("Error: %s\n", buffer);
-- %      return 0;
-- % }

{-# CFILES cbits/auxiliaries.c #-}

newtype XErrorEvent = XErrorEvent (Ptr XErrorEvent)
#if __GLASGOW_HASKELL__
        deriving (Eq, Ord, Show, Typeable, Data)
#else
        deriving (Eq, Ord, Show)
#endif

type ErrorHandler = FunPtr (Display -> Ptr XErrorEvent -> IO CInt)

foreign import ccall unsafe "HsXlib.h &defaultErrorHandler"
        defaultErrorHandler :: FunPtr (Display -> Ptr XErrorEvent -> IO CInt)

-- | The Xlib library reports most errors by invoking a user-provided
-- error handler.  This function installs an error handler that prints a
-- textual representation of the error.
setDefaultErrorHandler :: IO ()
setDefaultErrorHandler = do
        _ <- xSetErrorHandler defaultErrorHandler
        return ()

-- %fun XSetIOErrorHandler :: IOErrorHandler -> IO IOErrorHandler

foreign import ccall unsafe "HsXlib.h XSetErrorHandler"
        xSetErrorHandler   :: ErrorHandler   -> IO ErrorHandler

-- XGetErrorDatabaseText omitted
-- XGetErrorText omitted

----------------------------------------------------------------
-- -- Buffers
-- ----------------------------------------------------------------
--
-- -- OLD: Would arrays be more appropriate?
-- --
-- -- IMPURE void       XStoreBytes(display, bytes, nbytes)
-- -- IN Display*               display
-- -- VAR Int                   nbytes
-- -- IN list[nbytes] Byte      bytes
-- --
-- -- IMPURE list[nbytes] Byte  XFetchBytes(display, &nbytes)
-- -- IN Display*       display
-- -- VAR Int           nbytes
-- --
-- -- IMPURE void       XStoreBuffer(display, bytes, nbytes, buffer)
-- -- IN Display*               display
-- -- VAR Int                   nbytes
-- -- IN list[nbytes] Byte      bytes
-- -- IN Buffer         buffer
-- --
-- -- IMPURE list[nbytes] Byte  XFetchBuffer(display, &nbytes, buffer)
-- -- IN Display*       display
-- -- VAR Int           nbytes
-- -- IN Buffer buffer
-- --
-- -- IMPURE void       XRotateBuffers(display, rotate)
-- -- IN Display*       display
-- -- VAR Int           rotate

----------------------------------------------------------------
-- Extensions
----------------------------------------------------------------

-- ToDo: Use XFreeExtensionList
-- %fun XListExtensions :: Display -> IO ListString using res1 = XListExtensions(arg1,&res1_size)

-- %errfun False XQueryExtension :: Display -> String -> IO (Int,Int,Int) using res4 = XQueryExtension(arg1,arg2,&res1,&res2,&res3)->(res1,res2,res3)
-- %fun XInitExtensions :: Display -> String -> IO XExtCodes
-- %fun XAddExtensions  :: Display ->           IO XExtCodes

-- XAddToExtensionList omitted
-- XFindOnExtensionList omitted
-- XEHeadOfExtensionList omitted

----------------------------------------------------------------
-- Hosts
----------------------------------------------------------------

-- ToDo: operations to construct and destruct an XHostAddress

-- %fun XAddHost :: Display -> XHostAddress -> IO ()
-- %fun XRemoveHost :: Display -> XHostAddress -> IO ()
--
-- %fun XAddHosts    :: Display -> ListXHostAddress -> IO () using XAddHosts(arg1,arg2,arg2_size)
-- %fun XRemoveHosts :: Display -> ListXHostAddress -> IO () using XRemoveHosts(arg1,arg2,arg2_size)
--
-- -- Uses %prim to let us call XFree
-- %prim XListHosts :: Display -> IO (ListXHostAddress, Bool)
-- Bool state;
-- Int r_size;
-- XHostAddress* r = XListHosts(arg1,&r_size,&state);
-- %update(r,state);
-- XFree(r);
-- return;

-- %fun XEnableAccessControl  :: Display -> IO ()
-- %fun XDisableAccessControl :: Display -> IO ()
-- %fun XSetAccessControl     :: Display -> Access -> IO ()

----------------------------------------------------------------
-- Geometry
----------------------------------------------------------------

-- | interface to the X11 library function @XGeometry()@.
geometry :: Display -> CInt -> String -> String ->
                Dimension -> Dimension -> Dimension -> CInt -> CInt ->
                IO (CInt, Position, Position, Dimension, Dimension)
geometry display screen position default_position
                bwidth fwidth fheight xadder yadder =
        withCString position $ \ c_position ->
        withCString default_position $ \ c_default_position ->
        alloca $ \ x_return ->
        alloca $ \ y_return ->
        alloca $ \ width_return ->
        alloca $ \ height_return -> do
        res <- xGeometry display screen c_position c_default_position
                bwidth fwidth fheight xadder yadder
                x_return y_return width_return height_return
        x <- peek x_return
        y <- peek y_return
        width <- peek width_return
        height <- peek height_return
        return (res, x, y, width, height)
foreign import ccall unsafe "HsXlib.h XGeometry"
        xGeometry :: Display -> CInt -> CString -> CString ->
                Dimension -> Dimension -> Dimension -> CInt -> CInt ->
                Ptr Position -> Ptr Position ->
                Ptr Dimension -> Ptr Dimension -> IO CInt

-- | interface to the X11 library function @XGetGeometry()@.
getGeometry :: Display -> Drawable ->
        IO (Window, Position, Position, Dimension, Dimension, Dimension, CInt)
getGeometry display d =
        outParameters7 (throwIfZero "getGeometry") $
                xGetGeometry display d
foreign import ccall unsafe "HsXlib.h XGetGeometry"
        xGetGeometry :: Display -> Drawable ->
                Ptr Window -> Ptr Position -> Ptr Position -> Ptr Dimension ->
                Ptr Dimension -> Ptr Dimension -> Ptr CInt -> IO Status

-- XParseGeometry omitted (returned bitset too weird)

----------------------------------------------------------------
-- Locale
----------------------------------------------------------------

-- | interface to the X11 library function @XSupportsLocale()@.
foreign import ccall unsafe "HsXlib.h XSupportsLocale"
        supportsLocale :: IO Bool

-- | interface to the X11 library function @XSetLocaleModifiers()@.
setLocaleModifiers :: String -> IO String
setLocaleModifiers mods =
        withCString mods $ \ modifier_list -> do
        c_str <- xSetLocaleModifiers modifier_list
        peekCString c_str
foreign import ccall unsafe "HsXlib.h XSetLocaleModifiers"
        xSetLocaleModifiers :: CString -> IO CString

----------------------------------------------------------------
-- Screen Saver
----------------------------------------------------------------

type AllowExposuresMode = CInt
#{enum AllowExposuresMode,
 , dontAllowExposures   = DontAllowExposures
 , allowExposures       = AllowExposures
 , defaultExposures     = DefaultExposures
 }

type PreferBlankingMode = CInt
#{enum PreferBlankingMode,
 , dontPreferBlanking   = DontPreferBlanking
 , preferBlanking       = PreferBlanking
 , defaultBlanking      = DefaultBlanking
 }

type ScreenSaverMode = CInt
#{enum ScreenSaverMode,
 , screenSaverActive    = ScreenSaverActive
 , screenSaverReset     = ScreenSaverReset
 }

getScreenSaver :: Display ->
        IO (CInt, CInt, PreferBlankingMode, AllowExposuresMode)
getScreenSaver display = outParameters4 id (xGetScreenSaver display)
foreign import ccall unsafe "HsXlib.h XGetScreenSaver"
        xGetScreenSaver :: Display -> Ptr CInt -> Ptr CInt ->
                Ptr PreferBlankingMode -> Ptr AllowExposuresMode -> IO ()

-- | interface to the X11 library function @XSetScreenSaver()@.
foreign import ccall unsafe "HsXlib.h XSetScreenSaver"
        setScreenSaver      :: Display -> CInt -> CInt ->
                PreferBlankingMode -> AllowExposuresMode -> IO ()

-- | interface to the X11 library function @XActivateScreenSaver()@.
foreign import ccall unsafe "HsXlib.h XActivateScreenSaver"
        activateScreenSaver :: Display -> IO ()

-- | interface to the X11 library function @XResetScreenSaver()@.
foreign import ccall unsafe "HsXlib.h XResetScreenSaver"
        resetScreenSaver    :: Display -> IO ()

-- | interface to the X11 library function @XForceScreenSaver()@.
foreign import ccall unsafe "HsXlib.h XForceScreenSaver"
        forceScreenSaver    :: Display -> ScreenSaverMode -> IO ()

----------------------------------------------------------------
-- Pointer
----------------------------------------------------------------

-- | interface to the X11 library function @XGetPointerControl()@.
getPointerControl :: Display -> IO (CInt, CInt, CInt)
getPointerControl display = outParameters3 id (xGetPointerControl display)
foreign import ccall unsafe "HsXlib.h XGetPointerControl"
        xGetPointerControl :: Display -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()

-- | interface to the X11 library function @XWarpPointer()@.
foreign import ccall unsafe "HsXlib.h XWarpPointer"
        warpPointer :: Display -> Window -> Window -> Position -> Position ->
                Dimension -> Dimension -> Position -> Position -> IO ()

-- XGetPointerMapping omitted
-- XSetPointerMapping omitted

----------------------------------------------------------------
-- Visuals
----------------------------------------------------------------

-- | see @XVisualIDFromVisual()@
foreign import ccall unsafe "HsXlib.h XVisualIDFromVisual"
        visualIDFromVisual :: Visual -> IO VisualID

type VisualInfoMask = CLong
#{enum VisualInfoMask,
 , visualNoMask = VisualNoMask
 , visualIDMask = VisualIDMask
 , visualScreenMask = VisualScreenMask
 , visualDepthMask = VisualDepthMask
 , visualClassMask = VisualClassMask
 , visualRedMaskMask = VisualRedMaskMask
 , visualGreenMaskMask = VisualGreenMaskMask
 , visualBlueMaskMask = VisualBlueMaskMask
 , visualColormapSizeMask = VisualColormapSizeMask
 , visualBitsPerRGBMask = VisualBitsPerRGBMask
 , visualAllMask = VisualAllMask
 }

-- | interface to the X11 library function @XGetVisualInfo()@
getVisualInfo :: Display -> VisualInfoMask -> VisualInfo -> IO [VisualInfo]
getVisualInfo dpy mask template =
        alloca $ \nItemsPtr ->
        with template $ \templatePtr -> do
        itemsPtr <- xGetVisualInfo dpy mask templatePtr nItemsPtr
        if itemsPtr == nullPtr
                then return []
                else do
                        nItems <- peek nItemsPtr
                        items <- peekArray (fromIntegral nItems) itemsPtr
                        _ <- xFree itemsPtr
                        return items

foreign import ccall unsafe "XGetVisualInfo"
        xGetVisualInfo :: Display -> VisualInfoMask -> Ptr VisualInfo ->
                Ptr CInt -> IO (Ptr VisualInfo)

-- | interface to the X11 library function @XMatchVisualInfo()@
matchVisualInfo
        :: Display -> ScreenNumber -> CInt -> CInt -> IO (Maybe VisualInfo)
matchVisualInfo dpy screen depth class_ =
        alloca $ \infoPtr -> do
        status <- xMatchVisualInfo dpy screen depth class_ infoPtr
        if status == 0
                then return Nothing
                else do
                        info <- peek infoPtr
                        return $ Just info

foreign import ccall unsafe "XMatchVisualInfo"
        xMatchVisualInfo :: Display -> ScreenNumber -> CInt -> CInt ->
                Ptr VisualInfo -> IO Status

----------------------------------------------------------------
-- Threads
----------------------------------------------------------------

foreign import ccall unsafe "HsXlib.h XInitThreads"
        initThreads :: IO Status

foreign import ccall unsafe "HsXlib.h XLockDisplay"
        lockDisplay :: Display -> IO ()

foreign import ccall unsafe "HsXlib.h XUnlockDisplay"
        unlockDisplay :: Display -> IO ()

----------------------------------------------------------------
-- Pixmaps
----------------------------------------------------------------

-- | interface to the X11 library function @XCreatePixmap()@.
foreign import ccall unsafe "HsXlib.h XCreatePixmap"
        createPixmap :: Display -> Drawable -> Dimension -> Dimension -> CInt -> IO Pixmap

-- | interface to the X11 library function @XFreePixmap()@.
foreign import ccall unsafe "HsXlib.h XFreePixmap"
        freePixmap :: Display -> Pixmap -> IO ()

-- XCreatePixmapFromBitmapData omitted (type looks strange)

-- %fun XListPixmapFormatValues = res1 = XListPixmapFormatValues(display, &res1_size) :: Display -> ListXPixmapFormatValues

----------------------------------------------------------------
-- Bitmaps
----------------------------------------------------------------

-- ToDo: do these need to be available to the programmer?
-- Maybe I could just wire them into all other operations?

-- | interface to the X11 library function @XBitmapBitOrder()@.
foreign import ccall unsafe "HsXlib.h XBitmapBitOrder"
        bitmapBitOrder :: Display -> ByteOrder

-- | interface to the X11 library function @XBitmapUnit()@.
foreign import ccall unsafe "HsXlib.h XBitmapUnit"
        bitmapUnit     :: Display -> CInt

-- | interface to the X11 library function @XBitmapPad()@.
foreign import ccall unsafe "HsXlib.h XBitmapPad"
        bitmapPad      :: Display -> CInt

-- ToDo: make sure that initialisation works correctly for x/y_hot
-- omitted
-- IMPURE void  XWriteBitmapFile(display, filename, bitmap, width, height, x_hot, y_hot) RAISES Either
-- RETURNTYPE   BitmapFileStatus
-- GLOBAL ERROR BitmapFileStatus        RETVAL
-- IN Display*  display
-- IN String    filename
-- IN Pixmap    bitmap
-- IN Dimension width
-- IN Dimension height
-- IN Maybe Int x_hot = -1
-- IN Maybe Int y_hot = -1
-- POST: RETVAL == BitmapSuccess

-- added: unstable
-- IMPURE void  XReadBitmapFile(display, d, filename, bitmap, width, height, x_hot, y_hot) RAISES Either
-- RETURNTYPE   BitmapFileStatus
-- GLOBAL ERROR BitmapFileStatus        RETVAL
-- IN Display*  display
-- IN Drawable  d
-- IN String    filename
-- OUT Pixmap   bitmap
-- OUT Dimension        width
-- OUT Dimension        height
-- OUT Int              x_hot RAISES Maybe IF x_hot == -1
-- OUT Int              y_hot RAISES Maybe IF x_hot == -1
-- POST: RETVAL == BitmapSuccess

-- | interface to the X11 library function @XReadBitmapFile@.
readBitmapFile :: Display -> Drawable -> String
                  -> IO (Either String (Dimension, Dimension, Pixmap, Maybe CInt, Maybe CInt))
readBitmapFile display d filename =
  withCString filename $ \ c_filename ->
  alloca $ \ width_return ->
  alloca $ \ height_return ->
  alloca $ \ bitmap_return ->
  alloca $ \ x_hot_return ->
  alloca $ \ y_hot_return -> do
    rv <- xReadBitmapFile display d c_filename width_return height_return
         bitmap_return x_hot_return y_hot_return
    width <- peek width_return
    height <- peek height_return
    bitmap <- peek bitmap_return
    x_hot <- peek x_hot_return
    y_hot <- peek y_hot_return
    let m_x_hot | x_hot == -1 = Nothing
                | otherwise  = Just x_hot
        m_y_hot | y_hot == -1 = Nothing
                | otherwise  = Just y_hot
    case rv of
        0 -> return $ Right (width, height, bitmap, m_x_hot, m_y_hot)
        1 -> return $ Left "readBitmapFile: BitmapOpenFailed"
        2 -> return $ Left "readBitmapFile: BitmapFileInvalid"
        3 -> return $ Left "readBitmapFile: BitmapNoMemory"
        _ -> return $ Left "readBitmapFile: BitmapUnknownError"
foreign import ccall unsafe "X11/Xlib.h XReadBitmapFile"
  xReadBitmapFile :: Display -> Drawable -> CString -> Ptr Dimension -> Ptr Dimension
                     -> Ptr Pixmap -> Ptr CInt -> Ptr CInt -> IO CInt

-- XCreateBitmapFromData omitted (awkward looking type)
-- XReadBitmapFileData omitted (awkward looking type)

----------------------------------------------------------------
-- Keycodes
----------------------------------------------------------------

-- | interface to the X11 library function @XDisplayKeycodes()@.
displayKeycodes :: Display -> (CInt,CInt)
displayKeycodes display =
        unsafePerformIO $ outParameters2 id $ xDisplayKeycodes display
foreign import ccall unsafe "HsXlib.h XDisplayKeycodes"
        xDisplayKeycodes :: Display -> Ptr CInt -> Ptr CInt -> IO ()

-- | interface to the X11 library function @XLookupKeysym()@.
foreign import ccall unsafe "HsXlib.h XLookupKeysym"
        lookupKeysym    :: XKeyEventPtr -> CInt -> IO KeySym

-- | interface to the X11 library function @XKeycodeToKeysym()@.
foreign import ccall unsafe "HsXlib.h XKeycodeToKeysym"
        keycodeToKeysym :: Display -> KeyCode -> CInt -> IO KeySym

-- | interface to the X11 library function @XKeysymToKeycode()@.
foreign import ccall unsafe "HsXlib.h XKeysymToKeycode"
        keysymToKeycode :: Display -> KeySym  -> IO KeyCode

-- | interface to the X11 library function @XKeysymToString()@.
keysymToString  :: KeySym -> String
keysymToString keysym = unsafePerformIO $ do
        c_str <- xKeysymToString keysym
        peekCString c_str
foreign import ccall unsafe "HsXlib.h XKeysymToString"
        xKeysymToString  :: KeySym -> IO CString

-- | interface to the X11 library function @XStringToKeysym()@.
stringToKeysym  :: String -> KeySym
stringToKeysym str = unsafePerformIO $
        withCString str $ \ c_str ->
        xStringToKeysym c_str
foreign import ccall unsafe "HsXlib.h XStringToKeysym"
        xStringToKeysym  :: CString -> IO KeySym

noSymbol :: KeySym
noSymbol = #{const NoSymbol}

newtype XComposeStatus = XComposeStatus (Ptr XComposeStatus)
#if __GLASGOW_HASKELL__
        deriving (Eq, Ord, Show, Typeable, Data)
#else
        deriving (Eq, Ord, Show)
#endif

-- XLookupString cannot handle compose, it seems.

-- | interface to the X11 library function @XLookupString()@.
lookupString :: XKeyEventPtr -> IO (Maybe KeySym, String)
lookupString event_ptr =
        allocaBytes 100 $ \ buf ->
        alloca $ \ keysym_return -> do
        n <- xLookupString event_ptr buf 100 keysym_return nullPtr
        str <- peekCStringLen (buf, fromIntegral n)
        keysym <- peek keysym_return
        return (if keysym == noSymbol then Nothing else Just keysym, str)
foreign import ccall unsafe "HsXlib.h XLookupString"
        xLookupString :: XKeyEventPtr -> CString -> CInt ->
                Ptr KeySym -> Ptr XComposeStatus -> IO CInt

-- XQueryKeymap omitted
-- XRebindKeysym omitted
-- XDeleteModifiermapEntry omitted
-- XInsertModifiermapEntry omitted
-- XNewModifiermap omitted
-- XFreeModifiermap omitted
-- XSetModifierMapping omitted
-- XGetModifierMapping omitted
-- XGetKeyboardMapping omitted

----------------------------------------------------------------
-- Icons
----------------------------------------------------------------

-- | interface to the X11 library function @XGetIconName()@.
getIconName :: Display -> Window -> IO String
getIconName display w =
        alloca $ \ icon_name_return -> do
        throwIfZero "getIconName" $
                xGetIconName display w icon_name_return
        c_icon_name <- peek icon_name_return
        peekCString c_icon_name
foreign import ccall unsafe "HsXlib.h XGetIconName"
        xGetIconName :: Display -> Window -> Ptr CString -> IO Status

-- | interface to the X11 library function @XSetIconName()@.
setIconName :: Display -> Window -> String -> IO ()
setIconName display w icon_name =
        withCString icon_name $ \ c_icon_name ->
        xSetIconName display w c_icon_name
foreign import ccall unsafe "HsXlib.h XSetIconName"
        xSetIconName :: Display -> Window -> CString -> IO ()

----------------------------------------------------------------
-- Cursors
----------------------------------------------------------------

-- | interface to the X11 library function @XDefineCursor()@.
foreign import ccall unsafe "HsXlib.h XDefineCursor"
        defineCursor       :: Display -> Window -> Cursor -> IO ()

-- | interface to the X11 library function @XUndefineCursor()@.
foreign import ccall unsafe "HsXlib.h XUndefineCursor"
        undefineCursor     :: Display -> Window -> IO ()

-- | interface to the X11 library function @XCreatePixmapCursor()@.
createPixmapCursor :: Display -> Pixmap -> Pixmap -> Color -> Color ->
        Dimension -> Dimension -> IO Cursor
createPixmapCursor display source mask fg_color bg_color x y =
        with fg_color $ \ fg_color_ptr ->
        with bg_color $ \ bg_color_ptr ->
        xCreatePixmapCursor display source mask fg_color_ptr bg_color_ptr x y
foreign import ccall unsafe "HsXlib.h XCreatePixmapCursor"
        xCreatePixmapCursor :: Display -> Pixmap -> Pixmap ->
                Ptr Color -> Ptr Color -> Dimension -> Dimension -> IO Cursor

-- | interface to the X11 library function @XCreateGlyphCursor()@.
createGlyphCursor  :: Display -> Font   -> Font -> Glyph -> Glyph ->
        Color -> Color -> IO Cursor
createGlyphCursor display source_font mask_font source_char mask_char
                fg_color bg_color =
        with fg_color $ \ fg_color_ptr ->
        with bg_color $ \ bg_color_ptr ->
        xCreateGlyphCursor display source_font mask_font source_char mask_char
                fg_color_ptr bg_color_ptr
foreign import ccall unsafe "HsXlib.h XCreateGlyphCursor"
        xCreateGlyphCursor  :: Display -> Font   -> Font -> Glyph -> Glyph ->
                Ptr Color -> Ptr Color -> IO Cursor

-- | interface to the X11 library function @XCreateFontCursor()@.
foreign import ccall unsafe "HsXlib.h XCreateFontCursor"
        createFontCursor   :: Display -> Glyph  -> IO Cursor

-- | interface to the X11 library function @XFreeCursor()@.
foreign import ccall unsafe "HsXlib.h XFreeCursor"
        freeCursor         :: Display -> Font   -> IO ()

-- | interface to the X11 library function @XRecolorCursor()@.
recolorCursor      :: Display -> Cursor -> Color -> Color -> IO ()
recolorCursor display cursor fg_color bg_color =
        with fg_color $ \ fg_color_ptr ->
        with bg_color $ \ bg_color_ptr ->
        xRecolorCursor display cursor fg_color_ptr bg_color_ptr
foreign import ccall unsafe "HsXlib.h XRecolorCursor"
        xRecolorCursor      :: Display -> Cursor -> Ptr Color -> Ptr Color -> IO ()

----------------------------------------------------------------
-- Window Manager stuff
----------------------------------------------------------------

-- XConfigureWMWindow omitted (can't find documentation)
-- XReconfigureWMWindow omitted (can't find documentation)
-- XWMGeometry omitted (can't find documentation)
-- XGetWMColormapWindows omitted (can't find documentation)
-- XSetWMColormapWindows omitted (can't find documentation)
-- XGetWMProtocols omitted

-- AC, 1/9/2000: Added definition for XSetWMProtocols

-- | interface to the X11 library function @XSetWMProtocols()@.
setWMProtocols :: Display -> Window -> [Atom] -> IO ()
setWMProtocols display w protocols =
        withArray protocols $ \ protocol_array ->
        xSetWMProtocols display w protocol_array (fromIntegral $ length protocols)
foreign import ccall unsafe "HsXlib.h XSetWMProtocols"
        xSetWMProtocols :: Display -> Window -> Ptr Atom -> CInt -> IO ()

----------------------------------------------------------------
-- Set Window Attributes
----------------------------------------------------------------

-- ToDo: generate this kind of stuff automatically.

allocaSetWindowAttributes :: (Ptr SetWindowAttributes -> IO a) -> IO a
allocaSetWindowAttributes = allocaBytes #{size XSetWindowAttributes}

---------------- Access to individual fields ----------------

set_background_pixmap :: Ptr SetWindowAttributes -> Pixmap -> IO ()
set_background_pixmap = #{poke XSetWindowAttributes,background_pixmap}

set_background_pixel :: Ptr SetWindowAttributes -> Pixel -> IO ()
set_background_pixel = #{poke XSetWindowAttributes,background_pixel}

set_border_pixmap :: Ptr SetWindowAttributes -> Pixmap -> IO ()
set_border_pixmap = #{poke XSetWindowAttributes,border_pixmap}

set_border_pixel :: Ptr SetWindowAttributes -> Pixel -> IO ()
set_border_pixel = #{poke XSetWindowAttributes,border_pixel}

set_bit_gravity :: Ptr SetWindowAttributes -> BitGravity -> IO ()
set_bit_gravity = #{poke XSetWindowAttributes,bit_gravity}

set_win_gravity :: Ptr SetWindowAttributes -> WindowGravity -> IO ()
set_win_gravity = #{poke XSetWindowAttributes,win_gravity}

set_backing_store :: Ptr SetWindowAttributes -> BackingStore -> IO ()
set_backing_store = #{poke XSetWindowAttributes,backing_store}

set_backing_planes :: Ptr SetWindowAttributes -> Pixel -> IO ()
set_backing_planes = #{poke XSetWindowAttributes,backing_planes}

set_backing_pixel :: Ptr SetWindowAttributes -> Pixel -> IO ()
set_backing_pixel = #{poke XSetWindowAttributes,backing_pixel}

set_save_under :: Ptr SetWindowAttributes -> Bool -> IO ()
set_save_under = #{poke XSetWindowAttributes,save_under}

set_event_mask :: Ptr SetWindowAttributes -> EventMask -> IO ()
set_event_mask = #{poke XSetWindowAttributes,event_mask}

set_do_not_propagate_mask :: Ptr SetWindowAttributes -> EventMask -> IO ()
set_do_not_propagate_mask = #{poke XSetWindowAttributes,do_not_propagate_mask}

set_override_redirect :: Ptr SetWindowAttributes -> Bool -> IO ()
set_override_redirect = #{poke XSetWindowAttributes,override_redirect}

set_colormap :: Ptr SetWindowAttributes -> Colormap -> IO ()
set_colormap = #{poke XSetWindowAttributes,colormap}

set_cursor :: Ptr SetWindowAttributes -> Cursor -> IO ()
set_cursor = #{poke XSetWindowAttributes,cursor}

----------------------------------------------------------------
-- Drawing
----------------------------------------------------------------

-- | interface to the X11 library function @XDrawPoint()@.
foreign import ccall unsafe "HsXlib.h XDrawPoint"
        drawPoint      :: Display -> Drawable -> GC -> Position -> Position -> IO ()

-- | interface to the X11 library function @XDrawPoints()@.
drawPoints :: Display -> Drawable -> GC -> [Point] -> CoordinateMode -> IO ()
drawPoints display d gc points mode =
        withArrayLen points $ \ npoints point_array ->
        xDrawPoints display d gc point_array (fromIntegral npoints) mode
foreign import ccall unsafe "HsXlib.h XDrawPoints"
        xDrawPoints     :: Display -> Drawable -> GC -> Ptr Point -> CInt ->
                                CoordinateMode -> IO ()

-- | interface to the X11 library function @XDrawLine()@.
foreign import ccall unsafe "HsXlib.h XDrawLine"
        drawLine       :: Display -> Drawable -> GC -> Position -> Position ->
                                Position -> Position -> IO ()

-- | interface to the X11 library function @XDrawLines()@.
drawLines :: Display -> Drawable -> GC -> [Point] -> CoordinateMode -> IO ()
drawLines display d gc points mode =
        withArrayLen points $ \ npoints point_array ->
        xDrawLines display d gc point_array (fromIntegral npoints) mode
foreign import ccall unsafe "HsXlib.h XDrawLines"
        xDrawLines      :: Display -> Drawable -> GC -> Ptr Point -> CInt ->
                                CoordinateMode -> IO ()

-- | interface to the X11 library function @XDrawSegments()@.
drawSegments :: Display -> Drawable -> GC -> [Segment] -> IO ()
drawSegments display d gc segments =
        withArrayLen segments $ \ nsegments segment_array ->
        xDrawSegments display d gc segment_array (fromIntegral nsegments)
foreign import ccall unsafe "HsXlib.h XDrawSegments"
        xDrawSegments   :: Display -> Drawable -> GC -> Ptr Segment -> CInt -> IO ()

-- | interface to the X11 library function @XDrawRectangle()@.
foreign import ccall unsafe "HsXlib.h XDrawRectangle"
        drawRectangle  :: Display -> Drawable -> GC -> Position -> Position -> Dimension -> Dimension -> IO ()

-- | interface to the X11 library function @XDrawRectangles()@.
drawRectangles :: Display -> Drawable -> GC -> [Rectangle] -> IO ()
drawRectangles display d gc rectangles =
        withArrayLen rectangles $ \ nrectangles rectangle_array ->
        xDrawRectangles display d gc rectangle_array (fromIntegral nrectangles)
foreign import ccall unsafe "HsXlib.h XDrawRectangles"
        xDrawRectangles :: Display -> Drawable -> GC -> Ptr Rectangle -> CInt -> IO ()

-- | interface to the X11 library function @XDrawArc()@.
foreign import ccall unsafe "HsXlib.h XDrawArc"
        drawArc        :: Display -> Drawable -> GC -> Position -> Position ->
                        Dimension -> Dimension -> Angle -> Angle -> IO ()

-- | interface to the X11 library function @XDrawArcs()@.
drawArcs :: Display -> Drawable -> GC -> [Arc] -> IO ()
drawArcs display d gc arcs =
        withArrayLen arcs $ \ narcs arc_array ->
        xDrawArcs display d gc arc_array (fromIntegral narcs)
foreign import ccall unsafe "HsXlib.h XDrawArcs"
        xDrawArcs       :: Display -> Drawable -> GC -> Ptr Arc -> CInt -> IO ()

-- | interface to the X11 library function @XFillRectangle()@.
foreign import ccall unsafe "HsXlib.h XFillRectangle"
        fillRectangle  :: Display -> Drawable -> GC -> Position -> Position ->
                                Dimension -> Dimension -> IO ()

-- | interface to the X11 library function @XFillRectangles()@.
fillRectangles :: Display -> Drawable -> GC -> [Rectangle] -> IO ()
fillRectangles display d gc rectangles =
        withArrayLen rectangles $ \ nrectangles rectangle_array ->
        xFillRectangles display d gc rectangle_array (fromIntegral nrectangles)
foreign import ccall unsafe "HsXlib.h XFillRectangles"
        xFillRectangles :: Display -> Drawable -> GC -> Ptr Rectangle -> CInt -> IO ()

-- | interface to the X11 library function @XFillPolygon()@.
fillPolygon :: Display -> Drawable -> GC -> [Point] -> PolygonShape -> CoordinateMode -> IO ()
fillPolygon display d gc points shape mode =
        withArrayLen points $ \ npoints point_array ->
        xFillPolygon display d gc point_array (fromIntegral npoints) shape mode
foreign import ccall unsafe "HsXlib.h XFillPolygon"
        xFillPolygon    :: Display -> Drawable -> GC -> Ptr Point -> CInt -> PolygonShape -> CoordinateMode -> IO ()

-- | interface to the X11 library function @XFillArc()@.
foreign import ccall unsafe "HsXlib.h XFillArc"
        fillArc        :: Display -> Drawable -> GC -> Position -> Position ->
                        Dimension -> Dimension -> Angle -> Angle -> IO ()

-- | interface to the X11 library function @XFillArcs()@.
fillArcs :: Display -> Drawable -> GC -> [Arc] -> IO ()
fillArcs display d gc arcs =
        withArrayLen arcs $ \ narcs arc_array ->
        xFillArcs display d gc arc_array (fromIntegral narcs)
foreign import ccall unsafe "HsXlib.h XFillArcs"
        xFillArcs       :: Display -> Drawable -> GC -> Ptr Arc -> CInt -> IO ()

-- | interface to the X11 library function @XCopyArea()@.
foreign import ccall unsafe "HsXlib.h XCopyArea"
        copyArea       :: Display -> Drawable -> Drawable -> GC -> Position -> Position -> Dimension -> Dimension -> Position -> Position -> IO ()

-- | interface to the X11 library function @XCopyPlane()@.
foreign import ccall unsafe "HsXlib.h XCopyPlane"
        copyPlane      :: Display -> Drawable -> Drawable -> GC -> Position -> Position -> Dimension -> Dimension -> Position -> Position -> Pixel -> IO ()

-- draw characters over existing background

-- | interface to the X11 library function @XDrawString()@.
drawString :: Display -> Drawable -> GC -> Position -> Position -> String -> IO ()
drawString display d gc x y str =
        withCStringLen str $ \ (c_str, len) ->
        xDrawString display d gc x y c_str (fromIntegral len)
foreign import ccall unsafe "HsXlib.h XDrawString"
        xDrawString     :: Display -> Drawable -> GC -> Position -> Position -> CString -> CInt -> IO ()

-- draw characters over a blank rectangle of current background colour

-- | interface to the X11 library function @XDrawImageString()@.
drawImageString :: Display -> Drawable -> GC -> Position -> Position -> String -> IO ()
drawImageString display d gc x y str =
        withCStringLen str $ \ (c_str, len) ->
        xDrawImageString display d gc x y c_str (fromIntegral len)
foreign import ccall unsafe "HsXlib.h XDrawImageString"
        xDrawImageString :: Display -> Drawable -> GC -> Position -> Position -> CString -> CInt -> IO ()

-- XDrawString16 omitted (16bit chars not supported)
-- XDrawImageString16 omitted (16bit chars not supported)
-- XDrawText omitted (XTextItem not supported)
-- XDrawText16 omitted (XTextItem not supported)

----------------------------------------------------------------
-- Cut and paste buffers
----------------------------------------------------------------

-- | interface to the X11 library function @XStoreBuffer()@.
storeBuffer :: Display -> String -> CInt -> IO ()
storeBuffer display bytes buffer =
        withCStringLen bytes $ \ (c_bytes, nbytes) ->
        throwIfZero "storeBuffer" $
                xStoreBuffer display c_bytes (fromIntegral nbytes) buffer
foreign import ccall unsafe "HsXlib.h XStoreBuffer"
        xStoreBuffer :: Display -> CString -> CInt -> CInt -> IO Status

-- | interface to the X11 library function @XStoreBytes()@.
storeBytes :: Display -> String -> IO ()
storeBytes display bytes =
        withCStringLen bytes $ \ (c_bytes, nbytes) ->
        throwIfZero "storeBytes" $
                xStoreBytes display c_bytes (fromIntegral nbytes)
foreign import ccall unsafe "HsXlib.h XStoreBytes"
        xStoreBytes :: Display -> CString -> CInt -> IO Status

-- | interface to the X11 library function @XFetchBuffer()@.
fetchBuffer :: Display -> CInt -> IO String
fetchBuffer display buffer =
        alloca $ \ nbytes_return -> do
        c_bytes <- throwIfNull "fetchBuffer" $
                xFetchBuffer display nbytes_return buffer
        nbytes <- peek nbytes_return
        bytes <- peekCStringLen (c_bytes, (fromIntegral nbytes))
        _ <- xFree c_bytes
        return bytes
foreign import ccall unsafe "HsXlib.h XFetchBuffer"
        xFetchBuffer :: Display -> Ptr CInt -> CInt -> IO CString

-- | interface to the X11 library function @XFetchBytes()@.
fetchBytes :: Display -> IO String
fetchBytes display =
        alloca $ \ nbytes_return -> do
        c_bytes <- throwIfNull "fetchBytes" $
                xFetchBytes display nbytes_return
        nbytes <- peek nbytes_return
        bytes <- peekCStringLen (c_bytes, (fromIntegral nbytes))
        _ <- xFree c_bytes
        return bytes
foreign import ccall unsafe "HsXlib.h XFetchBytes"
        xFetchBytes :: Display -> Ptr CInt -> IO CString

-- | interface to the X11 library function @XRotateBuffers()@.
rotateBuffers :: Display -> CInt -> IO ()
rotateBuffers display rot =
        throwIfZero "rotateBuffers" $
                xRotateBuffers display rot
foreign import ccall unsafe "HsXlib.h XRotateBuffers"
        xRotateBuffers :: Display -> CInt -> IO Status

----------------------------------------------------------------
-- Window properties
----------------------------------------------------------------

newtype XTextProperty = XTextProperty (Ptr XTextProperty)
#if __GLASGOW_HASKELL__
        deriving (Eq, Ord, Show, Typeable, Data)
#else
        deriving (Eq, Ord, Show)
#endif

-- | interface to the X11 library function @XSetTextProperty()@.
setTextProperty :: Display -> Window -> String -> Atom -> IO ()
setTextProperty display w value property =
        withCStringLen value $ \ (c_value, value_len) ->
        allocaBytes #{size XTextProperty} $ \ text_prop -> do
        #{poke XTextProperty,value} text_prop c_value
        #{poke XTextProperty,encoding} text_prop sTRING
        #{poke XTextProperty,format} text_prop (8::CInt)
        #{poke XTextProperty,nitems} text_prop (fromIntegral value_len::Word32)
        xSetTextProperty display w text_prop property
foreign import ccall unsafe "HsXlib.h XSetTextProperty"
        xSetTextProperty :: Display -> Window -> Ptr XTextProperty -> Atom -> IO ()

-- %fun XSetStandardProperties :: Display -> Window -> String -> String -> Pixmap -> [String] -> XSizeHints -> IO ()
-- %code Status err = XSetStandardProperties(arg1,arg2,arg3,arg4,arg5,arg6,arg6_size,&arg7)
-- %fail { Success != err }{ BadStatus(err,XSetStandardProperties) }

----------------------------------------------------------------
-- Canned handling of output parameters
----------------------------------------------------------------

outParameters2 :: (Storable a, Storable b) =>
        (IO r -> IO ()) -> (Ptr a -> Ptr b -> IO r) -> IO (a,b)
outParameters2 check fn =
        alloca $ \ a_return ->
        alloca $ \ b_return -> do
        check (fn a_return b_return)
        a <- peek a_return
        b <- peek b_return
        return (a,b)

outParameters3 :: (Storable a, Storable b, Storable c) =>
        (IO r -> IO ()) -> (Ptr a -> Ptr b -> Ptr c -> IO r) -> IO (a,b,c)
outParameters3 check fn =
        alloca $ \ a_return ->
        alloca $ \ b_return ->
        alloca $ \ c_return -> do
        check (fn a_return b_return c_return)
        a <- peek a_return
        b <- peek b_return
        c <- peek c_return
        return (a,b,c)

outParameters4 :: (Storable a, Storable b, Storable c, Storable d) =>
        (IO r -> IO ()) -> (Ptr a -> Ptr b -> Ptr c -> Ptr d -> IO r) ->
        IO (a,b,c,d)
outParameters4 check fn =
        alloca $ \ a_return ->
        alloca $ \ b_return ->
        alloca $ \ c_return ->
        alloca $ \ d_return -> do
        check (fn a_return b_return c_return d_return)
        a <- peek a_return
        b <- peek b_return
        c <- peek c_return
        d <- peek d_return
        return (a,b,c,d)

outParameters7 :: (Storable a, Storable b, Storable c, Storable d, Storable e, Storable f, Storable g) =>
        (IO r -> IO ()) -> (Ptr a -> Ptr b -> Ptr c -> Ptr d -> Ptr e -> Ptr f -> Ptr g -> IO r) ->
        IO (a,b,c,d,e,f,g)
outParameters7 check fn =
        alloca $ \ a_return ->
        alloca $ \ b_return ->
        alloca $ \ c_return ->
        alloca $ \ d_return ->
        alloca $ \ e_return ->
        alloca $ \ f_return ->
        alloca $ \ g_return -> do
        check (fn a_return b_return c_return d_return e_return f_return g_return)
        a <- peek a_return
        b <- peek b_return
        c <- peek c_return
        d <- peek d_return
        e <- peek e_return
        f <- peek f_return
        g <- peek g_return
        return (a,b,c,d,e,f,g)

----------------------------------------------------------------
-- End
----------------------------------------------------------------