module Graphics.X11.XRM
(
RMDatabase,
RMValue(..),
resourceManagerString,
rmGetFileDatabase,
rmPutFileDatabase,
rmGetStringDatabase,
rmLocaleOfDatabase,
rmDestroyDatabase,
rmSetDatabase,
rmGetDatabase,
rmCombineFileDatabase,
rmCombineDatabase,
rmMergeDatabases,
rmGetResource,
rmPutResource,
rmPutStringResource,
rmPutLineResource,
getDefault,
rmValue,
) where
import Graphics.X11.Xlib hiding (resourceManagerString)
import Data.Data
import Foreign
import Foreign.C.String
import Foreign.C.Types
newtype RMDatabase = RMDatabase (Ptr RMDatabase)
deriving (Eq, Ord, Show, Typeable, Data)
data RMValue = RMValue {
rmvalue_size :: CInt,
rmvalue_addr :: IntPtr
}
deriving (Eq, Show)
instance Storable RMValue where
sizeOf _ = (8)
alignment _ = alignment (undefined::CInt)
peek p = do size <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
addr <- (\hsc_ptr -> peekByteOff hsc_ptr 4) p
return (RMValue size addr)
resourceManagerString :: Display -> IO (Maybe String)
resourceManagerString display = do s <- xResourceManagerString display
if s == nullPtr then return Nothing
else Just `fmap` peekCString s
foreign import ccall unsafe "HsXlib.h XResourceManagerString"
xResourceManagerString :: Display -> IO CString
rmGetFileDatabase :: String -> IO (Maybe RMDatabase)
rmGetFileDatabase file = withCString file $ \ c_file -> do
RMDatabase db <- xrmGetFileDatabase c_file
if db == nullPtr
then return Nothing
else return $ Just $ RMDatabase db
foreign import ccall unsafe "HsXlib.h XrmGetFileDatabase"
xrmGetFileDatabase :: CString -> IO RMDatabase
rmPutFileDatabase :: RMDatabase -> String -> IO ()
rmPutFileDatabase db file = withCString file $ \ c_file ->
xrmPutFileDatabase db c_file
foreign import ccall unsafe "HsXlib.h XrmPutFileDatabase"
xrmPutFileDatabase :: RMDatabase -> CString -> IO ()
rmGetStringDatabase :: String -> IO (Maybe RMDatabase)
rmGetStringDatabase s = withCString s $ \ c_s -> do
RMDatabase db <- xrmGetStringDatabase c_s
return $ if db == nullPtr then Nothing
else Just (RMDatabase db)
foreign import ccall unsafe "HsXlib.h XrmGetStringDatabase"
xrmGetStringDatabase :: CString -> IO RMDatabase
rmLocaleOfDatabase :: RMDatabase -> IO String
rmLocaleOfDatabase db = peekCString =<< xrmLocaleOfDatabase db
foreign import ccall unsafe "HsXlib.h XrmLocaleOfDatabase"
xrmLocaleOfDatabase :: RMDatabase -> IO CString
foreign import ccall unsafe "HsXlib.h XrmDestroyDatabase"
rmDestroyDatabase :: RMDatabase -> IO ()
foreign import ccall unsafe "HsXlib.h XrmSetDatabase"
rmSetDatabase :: Display -> RMDatabase -> IO ()
rmGetDatabase :: Display -> IO (Maybe RMDatabase)
rmGetDatabase dpy = do RMDatabase db <- xrmGetDatabase dpy
if db == nullPtr
then return Nothing
else return $ Just $ RMDatabase db
foreign import ccall unsafe "HsXlib.h XrmGetDatabase"
xrmGetDatabase :: Display -> IO RMDatabase
rmCombineFileDatabase :: String -> RMDatabase -> Bool -> IO ()
rmCombineFileDatabase file db override = withCString file $ \ c_file ->
throwIfZero "rmCombineFileDatabase" $
xrmCombineFileDatabase c_file db override
foreign import ccall unsafe "HsXlib.h XrmCombineFileDatabase"
xrmCombineFileDatabase :: CString -> RMDatabase -> Bool -> IO Status
foreign import ccall unsafe "HsXlib.h XrmCombineDatabase"
rmCombineDatabase :: RMDatabase -> RMDatabase -> Bool -> IO ()
foreign import ccall unsafe "HsXlib.h XrmMergeDatabases"
rmMergeDatabases :: RMDatabase -> RMDatabase -> IO ()
rmGetResource :: RMDatabase -> String -> String -> IO (Maybe (String, RMValue))
rmGetResource db name clss = withCString name $ \c_name ->
withCString clss $ \c_clss ->
alloca $ \type_ret ->
alloca $ \val_ret -> do
b <- xrmGetResource db c_name c_clss type_ret val_ret
if b
then do s <- peekCString =<< peek type_ret
v <- peek val_ret
return $ Just (s, v)
else return Nothing
foreign import ccall unsafe "HsXlib.h XrmGetResource"
xrmGetResource :: RMDatabase -> CString -> CString
-> Ptr CString -> Ptr RMValue -> IO Bool
rmPutResource :: RMDatabase -> String -> String -> RMValue -> IO ()
rmPutResource db name clss val = withCString name $ \c_name ->
withCString clss $ \c_clss ->
alloca $ \c_val -> do
poke c_val val
xrmPutResource db c_name c_clss c_val
foreign import ccall unsafe "HsXlib.h XrmPutResource"
xrmPutResource :: RMDatabase -> CString -> CString
-> Ptr RMValue -> IO ()
rmPutStringResource :: RMDatabase -> String -> String -> IO ()
rmPutStringResource db spec val = withCString spec $ \c_spec ->
withCString val $ \c_val ->
xrmPutStringResource db c_spec c_val
foreign import ccall unsafe "HsXlib.h XrmPutStringResource"
xrmPutStringResource :: RMDatabase -> CString -> CString -> IO ()
rmPutLineResource :: RMDatabase -> String -> IO ()
rmPutLineResource db line = withCString line $ \c_line ->
xrmPutLineResource db c_line
foreign import ccall unsafe "HsXlib.h XrmPutLineResource"
xrmPutLineResource :: RMDatabase -> CString -> IO ()
getDefault :: Display -> String -> String -> IO (Maybe String)
getDefault dpy prog opt = withCString prog $ \ c_prog ->
withCString opt $ \ c_opt -> do
s <- xGetDefault dpy c_prog c_opt
if s == nullPtr
then return Nothing
else Just `fmap` peekCString s
foreign import ccall unsafe "HsXlib.h XGetDefault"
xGetDefault :: Display -> CString -> CString -> IO CString
rmValue :: RMValue -> IO String
rmValue val = peekCString $ intPtrToPtr $ rmvalue_addr val