add Decoration module to be used to easily define decorations.

darcs-hash:20070610153939-72aca-da6f87330a2bd71cd2545884ffd9f4f78f2e70c9.gz

1 files changed, 37 insertions, 0 deletions

diff --git a/Decoration.hs b/Decoration.hs
new file mode 100644
index 0000000..0b399ad
--- /dev/null
+++ b/Decoration.hs
@@ -0,0 +1,37 @@
+module XMonadContrib.Decoration ( newDecoration ) where
+
+import qualified Data.Map as M
+
+import Control.Monad.Reader ( asks )
+import Control.Monad.State ( modify, gets )
+import Graphics.X11.Xlib ( Window, Rectangle(Rectangle), Pixel
+                         , createSimpleWindow, mapWindow, destroyWindow
+                         , buttonPress )
+import Graphics.X11.Xlib.Extras ( Event(AnyEvent,ButtonEvent), ev_subwindow, ev_event_type, ev_window )
+
+import XMonad
+import Operations ( ModifyWindows(ModifyWindows) )
+import qualified StackSet as W
+
+newDecoration :: Rectangle -> Int -> Pixel -> Pixel -> X () -> X () -> X Window
+newDecoration (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 $ mapWindow d win
+       let 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}) | thisw == win = draw
+           handle_event _ = return ()
+       modify $ \s -> s { layouts = M.insert n (modl l,ls) (layouts s) }
+       return win