Updates from work.

Ilya Portnov [2011-05-14 05:10:44]
Updates from work.
Filename
lib/AppGroups.hs
lib/CommonFunctions.hs
lib/FixedBoxes.hs
lib/GroupsSetup.hs
lib/KeyBindings.hs
lib/Layouts.hs
lib/Mouse.hs
lib/Themes.hs
xmonad.hs
diff --git a/lib/AppGroups.hs b/lib/AppGroups.hs
index a729395..c7f9e8a 100644
--- a/lib/AppGroups.hs
+++ b/lib/AppGroups.hs
@@ -34,6 +34,7 @@ data App = On App Key          -- ^ Bind App to Key
          | Float App           -- ^ run App in floating window
          | App :-> String      -- ^ move App to given workspace
          | Named App String    -- ^ Give a name for this App
+         | NoFocus App         -- ^ Do not give focus for such windows on open

 -- | Container for different conditions
 data Cond = forall c. Condition c => C c
@@ -127,6 +128,7 @@ query (Fullscreen app) = query app
 query (app :-> _)      = query app
 query (Float app)      = query app
 query (Named app _)    = query app
+query (NoFocus app)    = query app

 hookAction :: App -> (Query Bool -> ManageHook)
 hookAction (On app _)       = hookAction app
@@ -137,9 +139,11 @@ hookAction (Fullscreen app) = hookAction app
 hookAction (_ :-> wksp)     = (--> moveJump wksp)
 hookAction (Float app)      = (--> doFloat)
 hookAction (Named app _)    = hookAction app
+hookAction (NoFocus app)    = \qry -> qry --> (appHook app >> doF W.focusDown)

 appHook :: App -> ManageHook
 appHook (Fullscreen app) = query app --> doFullscreen
+appHook (NoFocus app)    = query app --> (appHook app >> doF W.focusDown)
 appHook app              = hookAction app (query app)

 groupName :: App -> String
@@ -151,6 +155,7 @@ groupName (Fullscreen app) = groupName app
 groupName (_ :-> wksp)     = wksp
 groupName (Float app)      = groupName app
 groupName (Named _ name)   = name
+groupName (NoFocus app)    = groupName app

 runApp :: App -> X ()
 runApp (On app _)       = runApp app
@@ -160,6 +165,7 @@ runApp (Group _)        = return ()
 runApp (Fullscreen app) = runApp app
 runApp (app :-> _)      = runApp app
 runApp (Named app _)    = runApp app
+runApp (NoFocus app)    = runApp app

 apps2hooks :: Apps -> [ManageHook]
 apps2hooks lst = map appHook lst
@@ -169,6 +175,7 @@ apps2keys gsconfig apps = mapMaybe hotkey apps
   where
     hotkey (On app key)  = Just (key, selectWithQuery gsconfig (query app) (runApp app))
     hotkey (Named app _) = hotkey app
+    hotkey (NoFocus app) = hotkey app
     hotkey _             = Nothing

 selectWithQuery :: GSConfig Window -> Query Bool -> X () -> X ()
diff --git a/lib/CommonFunctions.hs b/lib/CommonFunctions.hs
index f3edc5d..eee993b 100644
--- a/lib/CommonFunctions.hs
+++ b/lib/CommonFunctions.hs
@@ -20,8 +20,42 @@ import XMonad.Prompt.Input
 import XMonad.Actions.DynamicWorkspaces
 import XMonad.Actions.GridSelect

+-- import FixedBoxes
 import Themes

+-- Get / set an atom on the root window
+
+setRootAtom :: String -> String -> X ()
+setRootAtom name value = withDisplay (io . setRootAtom' name value)
+    where setRootAtom' atom name d = do
+                                       a <- internAtom d atom False
+                                       rw <- rootWindow d $ defaultScreen d
+                                       setTextProperty d rw name a
+
+getRootAtom :: String -> X [String]
+getRootAtom name = withDisplay (io . getRootAtom' name)
+    where getRootAtom' atom d = do
+            a <- internAtom d atom False
+            rw <- rootWindow d $ defaultScreen d
+            tp <- getTextProperty d rw a
+            wcTextPropertyToTextList d tp
+
+getMouseMode :: X Bool
+getMouseMode = do
+  xs <- getRootAtom "MOUSE_MODE"
+  return $ case xs of
+            ["TRUE"] -> True
+            _        -> False
+
+toggleMouseMode :: X ()
+toggleMouseMode = do
+  mode <- getMouseMode
+  case mode of
+    True ->  setRootAtom "MOUSE_MODE" "FALSE"
+    False -> setRootAtom "MOUSE_MODE" "TRUE"
+
+------------------------------------------------------------------------
+--
 doWithAnyBut ::  Property -> (Window -> X ()) -> Window -> X ()
 doWithAnyBut prop action w = do
     hasProp <- hasProperty prop w
@@ -88,6 +122,12 @@ showOSD text = spawn $ "echo " ++ text ++ " | osd_cat -p bottom -A center -f '-*
 promptOSD :: X()
 promptOSD = inputPrompt myXPConfig "Text" ?+ showOSD

+-- promptBox :: X ()
+-- promptBox = inputPrompt myXPConfig "Move to box" ?+ moveToBox
+--
+-- moveToBox :: String -> X ()
+-- moveToBox name = withFocused $ \w -> sendMessage (Place name w)
+
 publishShot :: String -> X()
 publishShot name = do
                      spawn $ "/usr/local/bin/publish-screen "++name
@@ -197,3 +237,10 @@ unmapEventHook :: Event -> X All
 unmapEventHook e@(UnmapEvent {}) = removeEmptyWorkspace >> return (All True)
 unmapEventHook _ = return (All True)

+caseLayoutOf :: [(String, X a)] -> X a -> X a
+caseLayoutOf pairs def = do
+  layout <- getLayout
+  case lookup layout pairs of
+    Nothing -> def
+    Just x  -> x
+
diff --git a/lib/FixedBoxes.hs b/lib/FixedBoxes.hs
new file mode 100644
index 0000000..232ff85
--- /dev/null
+++ b/lib/FixedBoxes.hs
@@ -0,0 +1,116 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-}
+module FixedBoxes where
+
+import Control.Monad
+import Control.Arrow (second)
+import Data.Ord (comparing)
+import Data.Function (on)
+import Data.Maybe
+import Data.List
+
+import XMonad
+import XMonad.Util.XUtils (fi)
+import qualified XMonad.StackSet as W
+
+data Box = Box {
+  boxname :: String,
+  boxX :: Rational,
+  boxY :: Rational,
+  boxW :: Rational,
+  boxH :: Rational }
+  deriving (Eq, Show, Read)
+
+data BoxMessage a = Place String a
+                  | Unbox a
+  deriving (Eq, Typeable)
+
+instance (Eq a, Typeable a) => Message (BoxMessage a)
+
+data FixedBoxes l back a = FixedBoxes (back a) [(Box, Maybe (W.Stack a), l a)]
+  deriving (Read, Show)
+
+fixedBoxes :: (LayoutClass l a, LayoutClass back a) => [Box] -> l a -> back a -> FixedBoxes l back a
+fixedBoxes boxes l back = FixedBoxes back (map (\box -> (box, Nothing, l)) boxes)
+
+instance (LayoutClass l a, LayoutClass back a, Read a, Show a, Eq a, Typeable a) => LayoutClass (FixedBoxes l back) a where
+  runLayout wksp rect = boxedLayout wksp rect
+  pureMessage = boxedMessage
+
+snd3 (a,b,c) = b
+
+boxedLayout :: (Eq a, LayoutClass back a, LayoutClass l a)
+            => W.Workspace WorkspaceId (FixedBoxes l back a) a
+            -> Rectangle
+            -> X ([(a, Rectangle)], Maybe (FixedBoxes l back a))
+boxedLayout wksp@(W.Workspace tag (FixedBoxes back boxes) stack) rect = do
+  let ws      = W.integrate' stack
+      w       = W.focus `fmap` stack
+      unboxed = tryFocus w `fmap` unboxedWindows (map snd3 boxes) ws
+  (backWs, backL) <- runLayout (W.Workspace tag back unboxed) rect
+  boxed <- mapM (runSubLayout w tag rect) boxes
+  let boxedWs = concat $ map fst boxed
+      boxedLs = map snd boxed
+      l' = FixedBoxes (fromMaybe back backL) $ zipWith (mergeLayouts w) boxedLs boxes
+  return (boxedWs ++ backWs, Just l')
+
+mergeLayouts :: (Eq a) => a -> Maybe (l a) -> (Box, Maybe (W.Stack a), l a) -> (Box, Maybe (W.Stack a), l a)
+mergeLayouts w ml (box, stack, l) = (box, tryFocus w `fmap` stack, fromMaybe l ml)
+
+tryFocus :: (Eq a) => (Maybe a) -> W.Stack a -> W.Stack a
+tryFocus Nothing  stack = stack
+tryFocus (Just w) stack@(W.Stack focus up down)
+  | w == focus    = stack
+  | w `elem` up   = W.Stack w (delete w up) down
+  | w `elem` down = W.Stack w up (delete w down)
+  | otherwise     = stack
+
+runSubLayout :: (LayoutClass layout a, Eq a)
+             => Maybe a
+             -> WorkspaceId
+             -> Rectangle
+             -> (Box, Maybe (W.Stack a), layout a)
+             -> X ([(a, Rectangle)], Maybe (layout a))
+runSubLayout w tag rect (box, stack, l) = do
+--   let stack' = tryFocus w `fmap` stack
+  (res, ml) <- runLayout (W.Workspace tag l stack) (box2rect rect box)
+  return (res, Just $ fromMaybe l ml)
+
+box2rect :: Rectangle -> Box -> Rectangle
+box2rect (Rectangle x y w h) (Box _ bx by bw bh) = Rectangle x' y' (round w') (round h')
+  where
+    x' = fi x + round (fi w* bx)
+    y' = fi y + round (fi h* by)
+    w' = fi w* bw
+    h' = fi h* bh
+
+unboxedWindows :: (Eq a) => [Maybe (W.Stack a)] -> [a] -> Maybe (W.Stack a)
+unboxedWindows stacks ws =
+  let boxed   = concatMap W.integrate' stacks
+      unboxed = ws \\ boxed
+  in  W.differentiate unboxed
+
+boxedMessage :: (Eq a, Typeable a) => FixedBoxes l back a -> SomeMessage -> Maybe (FixedBoxes l back a)
+boxedMessage (FixedBoxes back boxes) m
+  | Just (Place name w) <- fromMessage m = Just $ FixedBoxes back (place boxes name w)
+  | Just (Unbox w)      <- fromMessage m = Just $ FixedBoxes back (unbox boxes w)
+  | otherwise                            = Nothing
+
+place :: (Eq a) => [(Box, Maybe (W.Stack a), l)] -> String -> a -> [(Box, Maybe (W.Stack a), l)]
+place boxes name w = place' [] boxes
+  where
+    place' acc [] = acc
+    place' acc ((box, stack, l):other)
+      | boxname box == name = place' ((box, add w stack, l):acc) other
+      | otherwise           = place' ((box, stack,       l):acc) other
+
+unbox :: (Eq a) => [(Box, Maybe (W.Stack a), l)] -> a -> [(Box, Maybe (W.Stack a), l)]
+unbox boxes w = map (second3 $ del w) boxes
+
+second3 f (a,b,c) = (a, f b, c)
+
+add :: a -> Maybe (W.Stack a) -> Maybe (W.Stack a)
+add w stack = W.differentiate $ w: (W.integrate' stack)
+
+del :: (Eq a) => a -> Maybe (W.Stack a) -> Maybe (W.Stack a)
+del w stack = W.differentiate $ delete w $ W.integrate' stack
+
diff --git a/lib/GroupsSetup.hs b/lib/GroupsSetup.hs
index 60228f8..960d0da 100644
--- a/lib/GroupsSetup.hs
+++ b/lib/GroupsSetup.hs
@@ -11,25 +11,25 @@ regex = C . Regex
 defaultFM = "konqueror --profile filemanagement"

 myApps =
-  [ "firefox" ::: [C "Epiphany-browser",
-                   C "Firefox", C "Opera"]                 :-> "inet"  `On` "M1-!" `Named` "internet",
-    "thunderbird" ::: [C "Thunderbird", C "Evolution"]     :-> "mail"  `On` "M1-,",
+  [ NoFocus $ "firefox" ::: [C "Epiphany-browser",
+                   C "Firefox", C "Opera"]                 :-> "inet"  `On` "M1-x w" `Named` "internet",
+    "thunderbird" ::: [C "Thunderbird", C "Evolution"]     :-> "mail"  `On` "M1-x y",
     Group         [C "Inkscape", C "Eog",
-                   C "Gwenview", C "Dia", C "Shutter"]     :-> "graphics" `On` "M1-/",
-    Group         [regex "Gimp"]                           :-> "gimp"  `On` "M1-g",
-    "gnome-terminal" ::: [C "Gnome-terminal", C "Konsole"] :-> "term"  `On` "M1-;",
+                   C "Gwenview", C "Dia", C "Shutter"]     :-> "graphics" `On` "M1-x d",
+    Group         [regex "Gimp"]                           :-> "gimp"  `On` "M1-x g",
+    "gnome-terminal" ::: [C "Gnome-terminal", C "Konsole"] :-> "term"  `On` "M1-x t",
     textEditors :>> [C "Gedit", C "Leafpad",
-          C "Gvim", C "Kate", C "KWrite", C "Emacs"]       :-> "text"  `On` "M1-#",
-    recent ["doc"] ::: [regex "libreoffice", C "TeXmacs"]  :-> "office" `On` "M1-o",
-    recent ["pdf","djvu"] ::: [C "Evince", C "Okular"]     :-> "docs"  `On` "M1-:",
+          C "Gvim", C "Kate", C "KWrite", C "Emacs"]       :-> "text"  `On` "M1-x e",
+    recent ["doc"] ::: [regex "libreoffice", C "TeXmacs"]  :-> "office" `On` "M1-x o",
+    recent ["pdf","djvu"] ::: [C "Evince", C "Okular"]     :-> "docs"  `On` "M1-x k",
     defaultFM ::: [C "Nautilus", C "Dolphin",
-                   C "Konqueror", C "Krusader"]            :-> "files" `On` "M1-*",
-    Group         [C "Amarok", C "Rhythmbox", C "Totem"]   :-> "music" `On` "M1-p",
-    Group         [C "MPlayer"]                            :-> "video" `On` "M1-<F8>",
-    Group         [C "Wxmaxima"]                           :-> "math"  `On` "M1-?",
-    "pidgin"  ::: [C "Pidgin", C "Kopete"]                 :-> "im"    `On` "M1-%",
+                   C "Konqueror", C "Krusader"]            :-> "files" `On` "M1-x f",
+    Group         [C "Amarok", C "Rhythmbox", C "Totem"]   :-> "music" `On` "M1-x a",
+    Group         [C "MPlayer"]                            :-> "video" `On` "M1-x v",
+    Group         [C "Wxmaxima"]                           :-> "math"  `On` "M1-x g",
+    "pidgin"  ::: [C "Pidgin", C "Kopete"]                 :-> "im"    `On` "M1-x i",
     Group         [regex "Qt Jambi",
-                   regex (Title "Инстанция")]              :-> "RX Explorer" `On` "M1-s",
+                   regex (Title "Инстанция")]              :-> "RX Explorer" `On` "M1-x s",
     Group         [regex (Title "RadixWare Designer"),
-                   regex (Title "RadixWare Manager")]      :-> "RX Designer" `On` "M1-r" ]
+                   regex (Title "RadixWare Manager")]      :-> "RX Designer" `On` "M1-x r" ]

diff --git a/lib/KeyBindings.hs b/lib/KeyBindings.hs
index 95e765d..ea15b2a 100644
--- a/lib/KeyBindings.hs
+++ b/lib/KeyBindings.hs
@@ -20,6 +20,7 @@ import XMonad.Actions.GridSelect
 import XMonad.Actions.FindEmptyWorkspace
 import XMonad.Actions.GroupNavigation
 import XMonad.Actions.PerWorkspaceKeys
+import XMonad.Actions.DynamicWorkspaces

 import XMonad.Layout.MultiToggle
 import XMonad.Layout.MultiToggle.Instances
@@ -35,6 +36,7 @@ import CommonFunctions
 import Themes
 import AppGroups
 import GroupsSetup
+import Mouse

 workspaceOrder = ["inet","text","files","im","term"]

@@ -58,12 +60,7 @@ myKeys conf@(XConfig {XMonad.modMask = modMask}) = (M.fromList $
         , (f, m) <- [(gotoWorkspace, 0), (moveToWorkspace, shiftMask)]] )
     `M.union` planeKeys modMask (Lines 1) Circular

-addKeys = [("M-s n",          spawn "screenslide start"),
-          ("M-s s",          spawn "screenslide slide"),
-          ("M-s b",          spawn "screenslide browse-save"),
-          ("M-s t",          promptOSD),
-
---           ("M1-<F2>",         gnomeRun),
+addKeys = [ -- ("M1-<F2>",         gnomeRun),
           ("M1-<F2>",         spawn "gmrun"),
           ("<Pause>",         spawn "qwerty.py -a -f -g 640x400"),
           ("M-v",             vimsessions),
@@ -85,22 +82,21 @@ addKeys = [("M-s n",          spawn "screenslide start"),
           ("M-u",             chooseLayout "autogrid"),
           ("M-<Up>",          withFocused (sendMessage . maximizeRestore)),
           ("M-<Down>",        withFocused minimizeWindow),
-          ("M-<Right>",        withFocused (sendMessage . RestoreMinimizedWin)),
+          ("M-<Right>",       withFocused (sendMessage . RestoreMinimizedWin)),

           ("M-M1-m",          sendMessage $ Toggle MIRROR),
           ("M-b",             sendMessage $ ToggleStruts),
-          ("M-t",             trashWindow),

           -- Focus urgent window
           ("M-<F12>",         focusUrgent),

           -- Bring any window to current workspace
-          ("M1-w",            windowPromptGoto myXPConfig),
+          ("M1-w",            windowPromptBring myXPConfig),
           ("M1-z",            goToSelected myGSConfig),
-          ("M1-x",            selectAppGroup myGSConfig myGSConfig myApps),
+          ("M-x",             selectAppGroup myGSConfig myGSConfig myApps),
+--           ("M-p",             promptBox),

-          ("M1-e",            viewEmptyWorkspace),
-          ("M1-S-e",          windows $ emptyCurrentWorkspace),
+          ("M1-e",            addWorkspace "new"),
           ("M-<Backspace>",   nextMatch History (return True)),

           -- Resize viewed windows to the correct size
@@ -108,40 +104,32 @@ addKeys = [("M-s n",          spawn "screenslide start"),

           -- Move focus to the next window
           ("M1-<Tab>",        windows W.focusDown),
-          ("M-j",             bindOn [("inet", Ex.focusDown), ("", windows W.focusDown)]),
-          ("M-k",             bindOn [("inet", Ex.focusUp),   ("", windows W.focusUp)]  ),
-
---        ("M-<Left>",        sendMessage $ Nav.Go Nav.L  ),
---        ("M-<Right>",       sendMessage $ Nav.Go Nav.R  ),
---        ("M-<Up>",          sendMessage $ Nav.Go Nav.U  ),
---        ("M-<Down>",        sendMessage $ Nav.Go Nav.D  ),
+          ("M1-k",            sendButtonPress 4),
+          ("M1-j",            sendButtonPress 5),
+          ("M-j",             caseLayoutOf [("tabgrid", Ex.focusDown)] (windows W.focusDown)),
+          ("M-k",             caseLayoutOf [("tabgrid", Ex.focusUp)]   (windows W.focusUp)  ),

           -- Rotate windows list
-          ("M-C-j",           bindOn [("inet", Ex.focusGroupDown),
-                                      ("",     rotateWindows)] ),
-          ("M-C-k",           bindOn [("inet", Ex.focusGroupUp),
-                                      ("",     rotateWindows')] ),
+          ("M-C-j",           caseLayoutOf [("tabgrid", Ex.focusGroupDown)] rotateWindows ),
+          ("M-C-k",           caseLayoutOf [("tabgrid", Ex.focusGroupUp)]   rotateWindows'),

           -- Swap the focused window and the master window
-          ("M-<Return>",      bindOn [("inet", Ex.swapGroupMaster),
-                                      ("",     dwmpromote)]),
+          ("M-<Return>",      caseLayoutOf [("tabgrid", Ex.swapGroupMaster)] dwmpromote),

           -- Swap the focused window with the next window
-          ("M-S-j",           bindOn [("inet", Ex.swapDown),
-                                      ("",     windows W.swapDown)]),
-          ("M-S-k",           bindOn [("inet", Ex.swapUp),
-                                      ("",     windows W.swapUp)]),
+          ("M-S-j",           caseLayoutOf [("tabgrid", Ex.swapDown)] (windows W.swapDown)),
+          ("M-S-k",           caseLayoutOf [("tabgrid", Ex.swapUp)]   (windows W.swapUp)),

           -- Tab/Untab
-          ("M-M1-j",          bindOn [("inet", Ex.moveToGroupDown False),
-                                      ("",     sendMessage $ pushWindow Nav.D)]),
-          ("M-M1-l",          bindOn [("inet", Ex.moveToGroupUp   False),
-                                      ("",     sendMessage $ pushWindow Nav.R)]),
+          ("M-M1-j",          caseLayoutOf [("tabgrid", Ex.moveToGroupDown False)]
+                                  (sendMessage $ pushWindow Nav.D)),
+          ("M-M1-l",          caseLayoutOf [("tabgrid", Ex.moveToGroupUp   False)]
+                                  (sendMessage $ pushWindow Nav.R)),
           ("M-M1-k",          sendMessage $ pushWindow Nav.U),
           ("M-M1-h",          sendMessage $ pushWindow Nav.L),

-          ("M-M1-u",          bindOn [("inet", Ex.splitGroup),
-                                      ("",     withFocused (sendMessage . UnMerge))]),
+          ("M-M1-u",          caseLayoutOf [("tabgrid", Ex.splitGroup)]
+                                  (withFocused (sendMessage . UnMerge))),

           -- Shrink/expand the master area
           ("M-e",             sendMessage Shrink),
@@ -188,7 +176,7 @@ myMouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList $
     -- mod-button3, Set the window to floating mode and resize by dragging
     , ((modMask, button3), (\w -> focus w >> mouseResizeWindow w))

-    , ((modMask, button4), const rotateWindows)
-    , ((modMask, button5), const rotateWindows')
+--    , ((modMask, button4), const rotateWindows)
+--    , ((modMask, button5), const rotateWindows')
     ]

diff --git a/lib/Layouts.hs b/lib/Layouts.hs
index 5ff0f17..495e9fe 100644
--- a/lib/Layouts.hs
+++ b/lib/Layouts.hs
@@ -38,6 +38,7 @@ import XMonad.Layout.Groups

 import qualified XMonad.Layout.WindowNavigation as Nav

+-- import FixedBoxes
 import Themes

 ----------------------------------------------------
@@ -47,8 +48,15 @@ tWithIM = withIM (1%6) ((Role "buddy_list") `Or` (Role "MainWindow") `Or` (Role

 isGfxPanel = (Role "gimp-toolbox") `Or` (Role "Brush selector") `Or` (Role "toolbox_window") `Or` (Role "Layers")

-imlayout = addTabs shrinkText deco $ subLayout [] Simplest autogrid2
-tabgrid  = group (tabbed shrinkText deco) (Mirror $ Tall 1 (1/100) (2/3))
+imlayout = (addTabs shrinkText deco $ subLayout [] Simplest autogrid2) ||| (tabbed shrinkText deco)
+-- imlayout = fixedBoxes boxes (tabbed shrinkText deco) $ Grid 2
+tabgrid  = named "tabgrid" $ group (tabbed shrinkText deco) (Mirror $ Tall 1 (1/100) (2/3))
+
+-- boxes :: [Box]
+-- boxes = [Box "one" 0 0 0.5 0.5,
+--          Box "two" 0 0.5 0.5 0.5,
+--          Box "three" 0.5 0 0.5 0.5,
+--          Box "four" 0.5 0.5 0.5 0.5]

 grid = named "grid" $ Grid (2)
 vgrid = Grid (1/2)
@@ -73,17 +81,6 @@ onebig = named "onebig" $ (OneBig (3/4) (3/4))

 minimax = maximize . minimize

-deco = defaultTheme {activeColor = myFocusedBorderColor,
-                     activeTextColor = "#000000",
-                     inactiveColor = "#E6DCD1",
-                     inactiveTextColor = "#000000",
-                     decoHeight = 24,
-                     fontName = "xft:Arial-12"}
-
-decoB = defaultThemeWithButtons {activeColor = myFocusedBorderColor,
-                     activeTextColor = "#000000",
-                     fontName = "xft:Arial-10"}
-
 withButtons = buttonDeco shrinkText decoB

 draggable layout = windowSwitcherDecorationWithButtons shrinkText decoB (draggingVisualizer $ layout)
diff --git a/lib/Mouse.hs b/lib/Mouse.hs
new file mode 100644
index 0000000..db863e5
--- /dev/null
+++ b/lib/Mouse.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+module Mouse
+  (sendButtonPress,
+   movePointer)
+  where
+
+import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Types
+import Graphics.X11.Xlib.Misc
+import Foreign
+import Foreign.C.Types
+
+import XMonad
+import XMonad.Util.XUtils (fi)
+import qualified XMonad.StackSet as W
+
+-- XTestFakeButtonEvent(display, button, is_press, delay)
+foreign import ccall unsafe "X11/extensions/XTest.h XTestFakeButtonEvent"
+    xFakeButtonEvent :: Display -> Button -> Bool -> Time -> IO Status
+
+foreign import ccall unsafe "X11/extensions/XTest.h XTestFakeMotionEvent"
+    xFakeMotionEvent :: Display -> CInt -> CInt -> CInt -> Time -> IO Status
+
+fakeMotion :: CInt -> CInt -> X ()
+fakeMotion x y = do
+  sid <- withWindowSet (return . W.screen . W.current)
+  withDisplay $ \dpy -> do
+    io $ xFakeMotionEvent dpy (fromIntegral sid) x y 0
+  return ()
+
+sendButtonPress :: Button -> X ()
+sendButtonPress button = do
+  root <- asks theRoot
+  withDisplay $ \dpy -> do
+    (_,_,_,rootx,rooty,_,_,_) <- io $ queryPointer dpy root
+    fakeMotion rootx rooty
+    io $ xFakeButtonEvent dpy button True 0
+    io $ xFakeButtonEvent dpy button False 0
+  return ()
+
+movePointer :: Int -> Int -> X ()
+movePointer dx dy = do
+  root <- asks theRoot
+  withDisplay $ \dpy -> do
+    (_,_,_,x,y,_,_,_) <- io $ queryPointer dpy root
+    io $ warpPointer dpy root none 0 0 0 0 (fi $ x + fi dx) (fi $ y + fi dy)
+  return ()
diff --git a/lib/Themes.hs b/lib/Themes.hs
index e164e2b..d1e11e3 100644
--- a/lib/Themes.hs
+++ b/lib/Themes.hs
@@ -3,18 +3,22 @@ module Themes where
 import qualified Data.Map as M

 import XMonad
+import XMonad.Layout.Decoration
+import XMonad.Layout.DecorationAddons
 import XMonad.Prompt
 import XMonad.Actions.GridSelect

+myFont = "xft:Ubuntu-10"
+
 myXPConfig = defaultXPConfig {
-  font = "xft:Arial-10",
+  font    = myFont,
   bgColor = myFocusedBorderColor,
   fgColor = "#000000" }

 myGSConfig :: HasColorizer a => GSConfig a
 myGSConfig = defaultGSConfig {
   gs_navigate = myNavigation,
-  gs_font = "xft:Arial-10" }
+  gs_font     = myFont }

 myNavigation :: TwoD a (Maybe a)
 myNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler
@@ -43,6 +47,17 @@ myNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler
                                  ((8192,key), action)]


+deco = defaultTheme {activeColor = myFocusedBorderColor,
+                     activeTextColor = "#000000",
+                     inactiveColor = "#E6DCD1",
+                     inactiveTextColor = "#000000",
+                     decoHeight = 24,
+                     fontName = myFont}
+
+decoB = defaultThemeWithButtons {activeColor = myFocusedBorderColor,
+                     activeTextColor = "#000000",
+                     fontName = myFont}
+
 -----------------------------------------------------------------------
 -- Some general settings
 myWorkspaces    = ["main"]
diff --git a/xmonad.hs b/xmonad.hs
index f77eeda..b69cfd9 100644
--- a/xmonad.hs
+++ b/xmonad.hs
@@ -1,3 +1,5 @@
+module Main where
+
 import Data.Monoid (mappend)

 import XMonad
@@ -8,6 +10,7 @@ import XMonad.Util.EZConfig (additionalKeysP)
 import XMonad.Config.Kde (kde4Config)

 import XMonad.Actions.GroupNavigation (historyHook)
+import XMonad.Actions.UpdatePointer

 -- Import hooks to support EWMH and other compatibility hooks
 import XMonad.Hooks.EwmhDesktops (ewmh)
@@ -54,5 +57,6 @@ main =  do
                                 baseLogHook
                                 historyHook
                                 setWMName "LG3D"
+                                updatePointer (Relative 0.5 0.5)
     } `additionalKeysP` (addKeys ++ apps2keys myGSConfig myApps)
ViewGit