blob: 6b63475651f3c5441f7198d144a3e260a1554b0b (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonadContrib.Decoration
-- Copyright : (c) David Roundy <droundy@darcs.net>
-- License : BSD-style (see LICENSE)
--
-- Maintainer : David Roundy <droundy@darcs.net>
-- Stability : unstable
-- Portability : unportable
--
-- A module to be used to easily define decorations.
--
-----------------------------------------------------------------------------
module XMonadContrib.Decoration (
-- * Usage
-- $usage
newDecoration
) where
import Data.Bits ( (.|.) )
import Control.Monad.Reader ( asks )
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 ( UnDoLayout(UnDoLayout) )
-- $usage
-- You can use this module for writing other extensions.
-- See, for instance, "XMonadContrib.Tabbed"
newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel -> String
-> (Display -> Window -> GC -> FontStruct -> X ()) -> X () -> X Window
newDecoration decfor (Rectangle x y w h) th fg bg fn 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
let hook :: SomeMessage -> X Bool
hook sm | Just e <- fromMessage sm = handle_event e >> return True
| Just UnDoLayout == fromMessage sm = io (destroyWindow d win) >> return False
| otherwise = 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 fn draw
| thisw == decfor && t == propertyNotify = withGC win fn draw
handle_event _ = return ()
addLayoutMessageHook hook
return win
-- FIXME: withGC should use bracket (but can't, unless draw is an IO thing)
withGC :: Drawable -> String -> (Display -> Drawable -> GC -> FontStruct -> X ()) -> X ()
withGC w fn f = withDisplay $ \d -> do gc <- io $ createGC d w
let fontname = if fn == ""
then "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
else fn
font <- io $ loadQueryFont d fontname
io $ setFont d gc (fontFromFontStruct font)
f d w gc font
io $ freeGC d gc
io $ freeFont d font
|
