diff options
Diffstat (limited to '')
| -rw-r--r-- | Decoration.hs | 56 |
1 files changed, 28 insertions, 28 deletions
diff --git a/Decoration.hs b/Decoration.hs index e31c93f..d939be6 100644 --- a/Decoration.hs +++ b/Decoration.hs @@ -1,43 +1,43 @@ module XMonadContrib.Decoration ( newDecoration ) where -import qualified Data.Map as M import Data.Bits ( (.|.) ) import Control.Monad.Reader ( asks ) -import Control.Monad.State ( modify, gets ) import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras ( Event(AnyEvent,ButtonEvent), ev_subwindow, ev_event_type, ev_window ) +import XMonadContrib.LayoutHooks + import XMonad import Operations ( ModifyWindows(ModifyWindows) ) -import qualified StackSet as W newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel -> (Display -> Window -> GC -> X ()) -> X () -> X Window -newDecoration decfor (Rectangle x y w h) th fg bg draw click = - do d <- asks display - rt <- asks theRoot - n <- (W.tag . W.workspace . W.current) `fmap` gets windowset - Just (l,ls) <- M.lookup n `fmap` gets layouts - win <- io $ createSimpleWindow d rt x y w h (fromIntegral th) fg bg - io $ selectInput d win $ exposureMask .|. buttonPressMask - io $ mapWindow d win - let draw' = withGC win draw - modml :: (SomeMessage -> X (Maybe Layout)) -> SomeMessage -> X (Maybe Layout) - modml oldml m | Just ModifyWindows == fromMessage m = io (destroyWindow d win) >> oldml m - | Just e <- fromMessage m = handle_event e >> oldml m - | otherwise = fmap modl `fmap` oldml m - modl :: Layout -> Layout - modl oldl = oldl { modifyLayout = modml (modifyLayout oldl) } - handle_event (ButtonEvent {ev_subwindow = thisw,ev_event_type = t}) - | t == buttonPress && thisw == win = click - handle_event (ButtonEvent {ev_window = thisw,ev_event_type = t}) - | t == buttonPress && thisw == win = click - handle_event (AnyEvent {ev_window = thisw, ev_event_type = t}) - | thisw == win && t == expose = draw' - | thisw == decfor && t == propertyNotify = draw' - handle_event _ = return () - modify $ \s -> s { layouts = M.insert n (modl l,ls) (layouts s) } - return win +newDecoration decfor (Rectangle x y w h) th fg bg draw click = do + d <- asks display + rt <- asks theRoot + win <- io $ createSimpleWindow d rt x y w h (fromIntegral th) fg bg + io $ selectInput d win $ exposureMask .|. buttonPressMask + io $ mapWindow d win + + trace $ "created decoration " ++ show win + + let hook :: SomeMessage -> X Bool + hook sm | Just e <- fromMessage sm = handle_event e >> (trace $ "handle even " ++ show win ++ show e) >> return True + | Just ModifyWindows == fromMessage sm = io (destroyWindow d win) >> (trace $ "destroyed decoration " ++ show win) >> return False + | otherwise = (trace $ "something weird " ++ show win) >> return True + + handle_event (ButtonEvent {ev_subwindow = thisw,ev_event_type = t}) + | t == buttonPress && thisw == win = click + handle_event (ButtonEvent {ev_window = thisw,ev_event_type = t}) + | t == buttonPress && thisw == win = click + handle_event (AnyEvent {ev_window = thisw, ev_event_type = t}) + | thisw == win && t == expose = withGC win draw + | thisw == decfor && t == propertyNotify = withGC win draw + handle_event _ = return () + + addLayoutMessageHook hook + + return win -- FIXME: withGC should use bracket (but can't, unless draw is an IO thing) withGC :: Drawable -> (Display -> Drawable -> GC -> X ()) -> X () |