From 36d1ebb8b445cce3f8e8ee5b297abc3599be0b6d Mon Sep 17 00:00:00 2001 From: Ilya Portnov Date: Sat, 14 May 2011 11:10:44 +0600 Subject: [PATCH] Updates from work. --- lib/AppGroups.hs | 7 +++ lib/CommonFunctions.hs | 47 +++++++++++++++++++ lib/FixedBoxes.hs | 116 ++++++++++++++++++++++++++++++++++++++++++++++++ lib/GroupsSetup.hs | 32 +++++++------- lib/KeyBindings.hs | 62 ++++++++++--------------- lib/Layouts.hs | 23 ++++----- lib/Mouse.hs | 47 +++++++++++++++++++ lib/Themes.hs | 19 +++++++- xmonad.hs | 4 ++ 9 files changed, 289 insertions(+), 68 deletions(-) create mode 100644 lib/FixedBoxes.hs create mode 100644 lib/Mouse.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-", - 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-", gnomeRun), +addKeys = [ -- ("M1-", gnomeRun), ("M1-", spawn "gmrun"), ("", 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-", withFocused (sendMessage . maximizeRestore)), ("M-", withFocused minimizeWindow), - ("M-", withFocused (sendMessage . RestoreMinimizedWin)), + ("M-", withFocused (sendMessage . RestoreMinimizedWin)), ("M-M1-m", sendMessage $ Toggle MIRROR), ("M-b", sendMessage $ ToggleStruts), - ("M-t", trashWindow), -- Focus urgent window ("M-", 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-", 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-", windows W.focusDown), - ("M-j", bindOn [("inet", Ex.focusDown), ("", windows W.focusDown)]), - ("M-k", bindOn [("inet", Ex.focusUp), ("", windows W.focusUp)] ), - --- ("M-", sendMessage $ Nav.Go Nav.L ), --- ("M-", sendMessage $ Nav.Go Nav.R ), --- ("M-", sendMessage $ Nav.Go Nav.U ), --- ("M-", 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-", bindOn [("inet", Ex.swapGroupMaster), - ("", dwmpromote)]), + ("M-", 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) -- 1.7.2.3