{-# 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 XLockDisplay" 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 ----------------------------------------------------------------