module GetWindowProperty(getWindowPropertyK,getGeometryK) where
import Command
import Event
--import Font(FontStruct)
--import Fudget
--import Geometry(Line, Point, Rect, Size(..))
--import LayoutRequest(LayoutRequest)
--import Path(Path(..))
import Xrequest
--import Xtypes

getWindowPropertyK :: Int
-> Atom
-> Bool
-> Atom
-> Cont (K b c) (Atom, Int, Int, Int, String)
getWindowPropertyK Int
offset Atom
prop Bool
delete Atom
req_type =
    let gotit :: XResponse -> Maybe (Atom, Int, Int, Int, String)
gotit (GotWindowProperty Atom
typ Int
format Int
nitems Int
after String
str) =
            (Atom, Int, Int, Int, String)
-> Maybe (Atom, Int, Int, Int, String)
forall a. a -> Maybe a
Just (Atom
typ, Int
format, Int
nitems, Int
after, String
str)
        gotit XResponse
_ = Maybe (Atom, Int, Int, Int, String)
forall a. Maybe a
Nothing
    in  XRequest
-> (XResponse -> Maybe (Atom, Int, Int, Int, String))
-> Cont (K b c) (Atom, Int, Int, Int, String)
forall a b c. XRequest -> (XResponse -> Maybe a) -> Cont (K b c) a
xrequestK (Int -> Atom -> Bool -> Atom -> XRequest
GetWindowProperty Int
offset Atom
prop Bool
delete Atom
req_type) XResponse -> Maybe (Atom, Int, Int, Int, String)
gotit

getGeometryK :: Cont (K b c) (Rect, Int, Int)
getGeometryK = XRequest
-> (XResponse -> Maybe (Rect, Int, Int))
-> Cont (K b c) (Rect, Int, Int)
forall a b c. XRequest -> (XResponse -> Maybe a) -> Cont (K b c) a
xrequestK XRequest
GetGeometry
   (\XResponse
r -> case XResponse
r of GotGeometry Rect
r Int
bw Int
d -> (Rect, Int, Int) -> Maybe (Rect, Int, Int)
forall a. a -> Maybe a
Just (Rect
r,Int
bw,Int
d); XResponse
_ -> Maybe (Rect, Int, Int)
forall a. Maybe a
Nothing)