diff --git a/lib/DynamicPerScreenWorkspaces.hs b/lib/DynamicPerScreenWorkspaces.hs deleted file mode 100644 index 66bbf11..0000000 --- a/lib/DynamicPerScreenWorkspaces.hs +++ /dev/null @@ -1,154 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} - -module DynamicPerScreenWorkspaces ( screenWorkspaceStorage - , WorkspaceScreens - , DynamicWorkspaceConfig(..) - , dynamicRescreenHook - , create - , cleanup - , focusWindow - , view - , viewOn - , viewOnCurrent - ) where - -import XMonad hiding (hide) -import qualified XMonad.StackSet as W -import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..)) - -import Control.Arrow ((&&&)) -import Control.Monad -import qualified Data.Map as M -import Data.Maybe - -import Storage - - -data DynamicWorkspaceStoreData = DWSD (M.Map Int ScreenId) - deriving (Typeable, Show, Read) -instance StoreData DynamicWorkspaceStoreData - -screenWorkspaceStorage :: (LayoutClass l a) => l a -> ModifiedLayout (Storage DynamicWorkspaceStoreData) l a -screenWorkspaceStorage = storage (DWSD M.empty) - - -type WorkspaceScreens = Int -> Int -> ScreenId - -data DynamicWorkspaceConfig = DynamicWorkspaceConfig - { defaultWorkspaceScreen :: !WorkspaceScreens - , workspaceTag :: !(Int -> WorkspaceId) - } - -defaultScreenWorkspaces :: DynamicWorkspaceConfig -> Int -> ScreenId -> [Int] -defaultScreenWorkspaces conf n s = filter ((== s) . defaultWorkspaceScreen conf n) [0..] - - -dynamicRescreenHook :: DynamicWorkspaceConfig -> [ScreenDetail] -> X () -dynamicRescreenHook conf sds = do - layout <- asks $ layoutHook . config - windows $ cleanup' . \wset -> let (as,bs) = splitAt (length sds) $ map W.workspace (W.current wset:W.visible wset) - - mkWS i = let tag = workspaceTag conf i - in W.Workspace tag layout Nothing - - mkScreen sid (Just ws) sd = W.Screen ws sid sd - mkScreen sid Nothing sd = W.Screen (mkWS $ nextEmpty' conf (length sds) sid wset) sid sd - - (s:ss) = zipWith3 mkScreen (map S [0..]) (map Just as ++ repeat Nothing) sds - in wset {W.current = s, W.visible = ss, W.hidden = bs ++ W.hidden wset} - -workspaceScreen :: DynamicWorkspaceConfig -> Int -> X ScreenId -workspaceScreen conf i = do - wset <- gets windowset - d <- getStoreData - - let defaultScreen = defaultWorkspaceScreen conf (length $ W.screens wset) i - return $ case d of - Just (DWSD wsscreens) -> do - case (M.lookup i wsscreens) of - Just s -> s - Nothing -> defaultScreen - _ -> - defaultScreen - -hide :: DynamicWorkspaceConfig -> Int -> WindowSet -> X WindowSet -hide conf i wset = gets (W.screens . windowset) >>= foldM (flip hideOn) wset - where - hideOn s | (workspaceTag conf i) == (W.tag $ W.workspace s) = viewNextEmpty conf (W.screen s) - hideOn _ = return - -cleanup' :: WindowSet -> WindowSet -cleanup' wset = wset { W.hidden = hidden' } - where - hidden' = filter (isJust . W.stack) $ W.hidden wset - -viewOn' :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet -viewOn' conf sid i wset = do - let tag = workspaceTag conf i - case W.tagMember tag wset of - False -> viewEmpty conf sid i wset - True -> do - wset' <- hide conf i wset - let mws = W.lookupWorkspace sid wset' - - return $ case mws of - Just ws -> W.view tag . W.view ws $ wset' - Nothing -> wset' - -create' :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet -create' conf sid i wset = do - layout <- asks $ layoutHook . config - let tag = workspaceTag conf i - workspace = W.Workspace tag layout Nothing - - return $ if W.tagMember tag wset then wset else wset { W.hidden = workspace:(W.hidden wset) } - -viewEmpty :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet -viewEmpty conf sid i = create' conf sid i >=> viewOn' conf sid i - -nextEmpty' ::DynamicWorkspaceConfig -> Int -> ScreenId -> WindowSet -> Int -nextEmpty' conf n sid wset = fst $ head $ dropWhile ((`W.tagMember` wset) . snd) $ map (id &&& workspaceTag conf) $ defaultScreenWorkspaces conf n sid - -nextEmpty :: DynamicWorkspaceConfig -> ScreenId -> WindowSet -> Int -nextEmpty conf sid wset = nextEmpty' conf (length $ W.screens wset) sid wset - -viewNextEmpty :: DynamicWorkspaceConfig -> ScreenId -> WindowSet -> X WindowSet -viewNextEmpty conf sid wset = viewEmpty conf sid (nextEmpty conf sid wset) wset - -windows' :: (WindowSet -> X WindowSet) -> X () -windows' f = do - wset <- gets windowset - wset' <- f wset - windows . const $ wset' - -create :: DynamicWorkspaceConfig -> Int -> X () -create conf i = do - sid <- workspaceScreen conf i - windows' $ create' conf sid i - -cleanup :: X () -cleanup = windows cleanup' - -focusWindow :: DynamicWorkspaceConfig -> Window -> X () -focusWindow conf w = do - wset <- gets windowset - let mws = W.findTag w wset - whenJust mws $ \ws -> do - let i = head $ filter ((== ws) . workspaceTag conf) [0..] - sid <- workspaceScreen conf i - windows' $ liftM (cleanup' . W.focusWindow w) . viewOn' conf sid i - -view :: DynamicWorkspaceConfig -> Int -> X () -view conf i = do - sid <- workspaceScreen conf i - windows' $ liftM cleanup' . viewOn' conf sid i - -viewOn :: DynamicWorkspaceConfig -> ScreenId -> Int -> X () -viewOn conf sid i = do - updateStoreData $ \(DWSD m) -> DWSD $ M.insert i sid m - windows' $ liftM cleanup' . viewOn' conf sid i - -viewOnCurrent :: DynamicWorkspaceConfig -> Int -> X () -viewOnCurrent conf i = do - sid <- gets (W.screen . W.current . windowset) - viewOn conf sid i diff --git a/lib/EwmhDesktops.hs b/lib/EwmhDesktops.hs deleted file mode 100644 index 12b1688..0000000 --- a/lib/EwmhDesktops.hs +++ /dev/null @@ -1,247 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : XMonad.Hooks.EwmhDesktops --- Copyright : (c) 2007, 2008 Joachim Breitner --- License : BSD --- --- Maintainer : Joachim Breitner --- Stability : unstable --- Portability : unportable --- --- Makes xmonad use the EWMH hints to tell panel applications about its --- workspaces and the windows therein. It also allows the user to interact --- with xmonad by clicking on panels and window lists. ------------------------------------------------------------------------------ -module EwmhDesktops ( - -- * Usage - -- $usage - ewmh, - ewmhDesktopsStartup, - ewmhDesktopsLogHook, - ewmhDesktopsEventHook, - fullscreenEventHook - ) where - -import Codec.Binary.UTF8.String (encode) -import Data.List -import Data.Maybe -import Data.Monoid - -import XMonad -import Control.Monad -import qualified XMonad.StackSet as W - -import XMonad.Hooks.SetWMName -import XMonad.Util.XUtils (fi) -import XMonad.Util.WorkspaceCompare -import XMonad.Util.WindowProperties (getProp32) - -import DynamicPerScreenWorkspaces - --- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad --- > import XMonad.Hooks.EwmhDesktops --- > --- > main = xmonad $ ewmh defaultConfig --- --- You may also be interested in 'avoidStruts' from XMonad.Hooks.ManageDocks. - - --- | Add EWMH functionality to the given config. See above for an example. -ewmh :: DynamicWorkspaceConfig -> XConfig a -> XConfig a -ewmh dwc c = c { startupHook = startupHook c +++ ewmhDesktopsStartup - , handleEventHook = handleEventHook c +++ ewmhDesktopsEventHook dwc - , logHook = logHook c +++ ewmhDesktopsLogHook } - where x +++ y = mappend x y - --- | --- Initializes EwmhDesktops and advertises EWMH support to the X --- server -ewmhDesktopsStartup :: X () -ewmhDesktopsStartup = setSupported - --- | --- Notifies pagers and window lists, such as those in the gnome-panel --- of the current state of workspaces and windows. -ewmhDesktopsLogHook :: X () -ewmhDesktopsLogHook = withWindowSet $ \s -> do - sort' <- getSortByIndex - let ws = sort' $ W.workspaces s - - -- Number of Workspaces - setNumberOfDesktops (length ws) - - -- Names thereof - setDesktopNames (map W.tag ws) - - let wins = nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ [x] ++ r) . W.stack) $ ws - -- all windows, with focused windows last - winsStacking = nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws - setClientList wins winsStacking - - -- Current desktop - case (elemIndex (W.currentTag s) $ map W.tag ws) of - Nothing -> return () - Just curr -> do - setCurrentDesktop curr - - forM_ (map W.workspace (W.current s : W.visible s) ++ W.hidden s) $ \w -> - case elemIndex (W.tag w) (map W.tag ws) of - Nothing -> return () - Just wn -> forM_ (W.integrate' (W.stack w)) $ \win -> do - setWindowDesktop win wn - - setActiveWindow - - return () - --- | --- Intercepts messages from pagers and similar applications and reacts on them. --- Currently supports: --- --- * _NET_CURRENT_DESKTOP (switching desktops) --- --- * _NET_WM_DESKTOP (move windows to other desktops) --- --- * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed) --- -ewmhDesktopsEventHook :: DynamicWorkspaceConfig -> Event -> X All -ewmhDesktopsEventHook dwc e = handle dwc e >> return (All True) - -handle :: DynamicWorkspaceConfig -> Event -> X () -handle dwc ClientMessageEvent { - ev_window = w, - ev_message_type = mt, - ev_data = d - } = withWindowSet $ \s -> do - sort' <- getSortByIndex - let ws = sort' $ W.workspaces s - - a_cd <- getAtom "_NET_CURRENT_DESKTOP" - a_d <- getAtom "_NET_WM_DESKTOP" - a_aw <- getAtom "_NET_ACTIVE_WINDOW" - a_cw <- getAtom "_NET_CLOSE_WINDOW" - a_ignore <- mapM getAtom ["XMONAD_TIMER"] - if mt == a_cd then do - let n = head d - if 0 <= n && fi n < length ws then - --windows $ W.view (W.tag (ws !! fi n)) - --view dwc $ fi n - return () - else trace $ "Bad _NET_CURRENT_DESKTOP with data[0]="++show n - else if mt == a_d then do - let n = head d - if 0 <= n && fi n < length ws then - windows $ W.shiftWin (W.tag (ws !! fi n)) w - else trace $ "Bad _NET_DESKTOP with data[0]="++show n - else if mt == a_aw then do - --windows $ W.focusWindow w - focusWindow dwc w - else if mt == a_cw then do - killWindow w - else if mt `elem` a_ignore then do - return () - else do - -- The Message is unknown to us, but that is ok, not all are meant - -- to be handled by the window manager - return () -handle _ _ = return () - --- | --- An event hook to handle applications that wish to fullscreen using the --- _NET_WM_STATE protocol. This includes users of the gtk_window_fullscreen() --- function, such as Totem, Evince and OpenOffice.org. -fullscreenEventHook :: Event -> X All -fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do - state <- getAtom "_NET_WM_STATE" - fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN" - wstate <- fromMaybe [] `fmap` getProp32 state win - - let isFull = fromIntegral fullsc `elem` wstate - - -- Constants for the _NET_WM_STATE protocol: - remove = 0 - add = 1 - toggle = 2 - ptype = 4 -- The atom property type for changeProperty - chWstate f = io $ changeProperty32 dpy win state ptype propModeReplace (f wstate) - - when (typ == state && fi fullsc `elem` dats) $ do - when (action == add || (action == toggle && not isFull)) $ do - chWstate (fi fullsc:) - windows $ W.float win $ W.RationalRect 0 0 1 1 - when (action == remove || (action == toggle && isFull)) $ do - chWstate $ delete (fi fullsc) - windows $ W.sink win - - return $ All True - -fullscreenEventHook _ = return $ All True - -setNumberOfDesktops :: (Integral a) => a -> X () -setNumberOfDesktops n = withDisplay $ \dpy -> do - a <- getAtom "_NET_NUMBER_OF_DESKTOPS" - c <- getAtom "CARDINAL" - r <- asks theRoot - io $ changeProperty32 dpy r a c propModeReplace [fromIntegral n] - -setCurrentDesktop :: (Integral a) => a -> X () -setCurrentDesktop i = withDisplay $ \dpy -> do - a <- getAtom "_NET_CURRENT_DESKTOP" - c <- getAtom "CARDINAL" - r <- asks theRoot - io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i] - -setDesktopNames :: [String] -> X () -setDesktopNames names = withDisplay $ \dpy -> do - -- Names thereof - r <- asks theRoot - a <- getAtom "_NET_DESKTOP_NAMES" - c <- getAtom "UTF8_STRING" - let names' = map fromIntegral $ concatMap ((++[0]) . encode) names - io $ changeProperty8 dpy r a c propModeReplace names' - -setClientList :: [Window] -> [Window] -> X () -setClientList wins winsStacking = withDisplay $ \dpy -> do - -- (What order do we really need? Something about age and stacking) - r <- asks theRoot - c <- getAtom "WINDOW" - a <- getAtom "_NET_CLIENT_LIST" - io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral wins) - a' <- getAtom "_NET_CLIENT_LIST_STACKING" - io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral winsStacking) - -setWindowDesktop :: (Integral a) => Window -> a -> X () -setWindowDesktop win i = withDisplay $ \dpy -> do - a <- getAtom "_NET_WM_DESKTOP" - c <- getAtom "CARDINAL" - io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i] - -setSupported :: X () -setSupported = withDisplay $ \dpy -> do - r <- asks theRoot - a <- getAtom "_NET_SUPPORTED" - c <- getAtom "ATOM" - supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN" - ,"_NET_NUMBER_OF_DESKTOPS" - ,"_NET_CLIENT_LIST" - ,"_NET_CLIENT_LIST_STACKING" - ,"_NET_CURRENT_DESKTOP" - ,"_NET_DESKTOP_NAMES" - ,"_NET_ACTIVE_WINDOW" - ,"_NET_WM_DESKTOP" - ,"_NET_WM_STRUT" - ] - io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp) - - setWMName "xmonad" - -setActiveWindow :: X () -setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do - let w = fromMaybe none (W.peek s) - r <- asks theRoot - a <- getAtom "_NET_ACTIVE_WINDOW" - c <- getAtom "WINDOW" - io $ changeProperty32 dpy r a c propModeReplace [fromIntegral w] diff --git a/lib/ProcessWorkspaces.hs b/lib/ProcessWorkspaces.hs index 72f4270..8789c51 100644 --- a/lib/ProcessWorkspaces.hs +++ b/lib/ProcessWorkspaces.hs @@ -4,16 +4,13 @@ module ProcessWorkspaces ( setProcessWorkspace , getProcessWorkspace , doAutoShift , doIgnoreProcessWorkspace - , ignoreProcessWorkspace - , ignoreWinProcessWorkspace , regroupProcess , regroupWinProcess , shiftIgnoreGroup , shiftWinIgnoreGroup , shiftGroup , shiftWinGroup - , handleForgetEmptyWindowGroups - , processWorkspaceManager + , processWorkspaceStorage , spawnOn , spawnOnCurrent ) where @@ -24,20 +21,17 @@ import qualified XMonad.StackSet as W import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..)) import XMonad.Hooks.ManageHelpers (pid) import Graphics.X11.Types (Window) -import Graphics.X11.Xlib.Extras (Event) import System.Posix.Process (getProcessPriority) import System.Posix.Types (ProcessID) import Control.Monad import Data.Maybe -import Data.Monoid import qualified Data.Map as M import Storage - doAutoShift :: ManageHook doAutoShift = do mp <- pid @@ -59,12 +53,6 @@ doIgnoreProcessWorkspace = do liftX $ setProcessWorkspace (fromJust mp) Nothing idHook -ignoreProcessWorkspace :: X () -ignoreProcessWorkspace = withFocused ignoreWinProcessWorkspace - -ignoreWinProcessWorkspace :: Window -> X () -ignoreWinProcessWorkspace w = runQuery doIgnoreProcessWorkspace w >> return () - regroupProcess :: WorkspaceId -> X () regroupProcess ws = withFocused $ regroupWinProcess ws @@ -79,7 +67,7 @@ shiftIgnoreGroup ws = withFocused $ shiftWinIgnoreGroup ws shiftWinIgnoreGroup :: WorkspaceId -> Window -> X () shiftWinIgnoreGroup ws w = do - ignoreWinProcessWorkspace w + runQuery doIgnoreProcessWorkspace w windows $ W.shiftWin ws w shiftGroup :: WorkspaceId -> X () @@ -101,25 +89,13 @@ shiftWinGroup ws w = do _ -> windows $ W.shiftWin ws w -handleForgetEmptyWindowGroups :: Event -> X All -handleForgetEmptyWindowGroups (UnmapEvent {ev_window = w}) = do - mp <- runQuery pid w - when (isJust mp) $ do - wins <- withWindowSet $ return . W.allWindows - hasWindows <- foldM (\b w' -> liftM ((|| b) . (&& (w /= w')) . (== mp)) . runQuery pid $ w') False wins - unless hasWindows $ updateStoreData ((\(ProcessWorkspaceStoreData map) -> ProcessWorkspaceStoreData $ M.delete (fromJust mp) map)) - return $ All True - -handleForgetEmptyWindowGroups _ = return $ All True - data ProcessWorkspaceStoreData = ProcessWorkspaceStoreData (M.Map ProcessID (Maybe WorkspaceId)) deriving (Typeable, Show, Read) instance StoreData ProcessWorkspaceStoreData - -processWorkspaceManager :: (LayoutClass l a) => l a -> ModifiedLayout (Storage ProcessWorkspaceStoreData) l a -processWorkspaceManager = storage (ProcessWorkspaceStoreData M.empty) +processWorkspaceStorage :: (LayoutClass l a) => l a -> ModifiedLayout (Storage ProcessWorkspaceStoreData) l a +processWorkspaceStorage = storage $ ProcessWorkspaceStoreData M.empty setProcessWorkspace :: ProcessID -> Maybe WorkspaceId -> X () setProcessWorkspace pid ws = do diff --git a/lib/Storage.hs b/lib/Storage.hs index 9c70b04..7f68b15 100644 --- a/lib/Storage.hs +++ b/lib/Storage.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, TypeSynonymInstances, MultiParamTypeClasses, FlexibleInstances, PatternGuards, DatatypeContexts #-} +{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, TypeSynonymInstances, MultiParamTypeClasses, FlexibleInstances, PatternGuards #-} module Storage ( StoreData , Storage diff --git a/xmonad.hs b/xmonad.hs index 8fcfa9b..f458ad4 100644 --- a/xmonad.hs +++ b/xmonad.hs @@ -1,5 +1,6 @@ import XMonad import XMonad.Config.Desktop +import XMonad.Config.Gnome import XMonad.Actions.CycleWS import XMonad.Actions.NoBorders import XMonad.Actions.PhysicalScreens @@ -15,12 +16,9 @@ import Control.Monad import Control.Monad.Trans import Data.Maybe import Data.Monoid -import Data.Ratio((%)) -import System.Exit +import Ratio((%)) --import ConfigurableBorders -import DynamicPerScreenWorkspaces -import EwmhDesktops import FullscreenManager import NoBorders import ProcessWorkspaces @@ -28,44 +26,33 @@ import ProcessWorkspaces modm = mod4Mask -main = xmonad $ ewmh dwConfig $ defaultConfig +main = xmonad $ gnomeConfig { modMask = modm , manageHook = myManageHook , layoutHook = desktopLayoutModifiers myLayoutHook , startupHook = myStartupHook , handleEventHook = myEventHook - , logHook = ewmhDesktopsLogHook - , focusedBorderColor = "#008000" - , rescreenHook = dynamicRescreenHook dwConfig - , borderWidth = 0 + , workspaces = myWorkspaces } `additionalKeysP` ( [ ("M-a", sendMessage MirrorShrink) - , ("M-z", sendMessage MirrorExpand) + , ("M-y", sendMessage MirrorExpand) , ("M-", prevWS) , ("M-", nextWS) , ("M-S-", shiftToPrev) , ("M-S-", shiftToNext) , ("M-S-b", withFocused toggleBorder >> refresh) + , ("M1-", kill) , ("M-", viewOrWarp 0) , ("M-", viewOrWarp 1) , ("M-", viewOrWarp 2) , ("M-b", banishScreen LowerRight) - , ("M-f", withFocused $ \w -> windows $ W.float w $ W.RationalRect 0 0 1 1) - , ("M-p", spawnOnCurrent "/home/neoraider/bin/dmemu_run -b") + , ("M-p", spawnOnCurrent "exe=`dmenu_path | /home/neoraider/bin/dmemu -b` && eval \"exec $exe\"") , ("M-g", gets (W.currentTag . windowset) >>= regroupProcess) - , ("M-S-q", io (exitWith ExitSuccess)) - , ("C-M1-l", spawn "xscreensaver-command -lock") - , ("M-`", spawn "xclip -o | qrencode -s 10 -o- | display -geometry +0+0") - , ("", spawn "amixer -q sset Master 5%- unmute") - , ("", spawn "amixer -q sset Master toggle") - , ("", spawn "amixer -q sset Master 5%+ unmute") - , ("M1-", kill) ] - ++ [ ("M-" ++ show n, view dwConfig ws) | (ws, n) <- zip [0..] ([1..9]++[0])] - ++ [ ("M-C-" ++ show n, viewOnCurrent dwConfig ws) | (ws, n) <- zip [0..] ([1..9]++[0])] - ++ [ ("M-S-" ++ show n, create dwConfig ws >> shiftGroup (workspaceTag dwConfig ws) >> cleanup) | (ws, n) <- zip [0..] ([1..9]++[0])] - ++ [ ("M-S-C-" ++ show n, create dwConfig ws >> shiftIgnoreGroup (workspaceTag dwConfig ws) >> cleanup) | (ws, n) <- zip [0..] ([1..9]++[0])] + ++ [ (("M-" ++ show n, windows $ W.greedyView ws)) | (ws, n) <- zip myWorkspaces ([1..9]++[0])] + ++ [ (("M-S-" ++ show n, shiftGroup ws)) | (ws, n) <- zip myWorkspaces ([1..9]++[0])] + ++ [ (("M-C-" ++ show n, shiftIgnoreGroup ws)) | (ws, n) <- zip myWorkspaces ([1..9]++[0])] ) `additionalMouseBindings` [ ((modm, button4), \_ -> sendMessage Shrink) @@ -75,18 +62,7 @@ main = xmonad $ ewmh dwConfig $ defaultConfig ] -dwConfig :: DynamicWorkspaceConfig -dwConfig = DynamicWorkspaceConfig { defaultWorkspaceScreen = defWSScreen - , workspaceTag = show . (+1) - } - -defWSScreen :: WorkspaceScreens -defWSScreen 1 _ = S 0 - -defWSScreen _ i | i `elem` [0..7] = S 0 -defWSScreen _ i | i `elem` [8,9] = S 1 - -defWSScreen n i = S ((i-10) `mod` n) +myWorkspaces = ["Firefox", "Thunderbird", "Emacs", "4", "5", "6", "7", "8", "Chat", "10"] viewOrWarp :: Int -> X () @@ -98,76 +74,56 @@ viewOrWarp n = do whenJust ws $ \w -> windows . W.view $ w when (s == (W.screen . W.current $ wset)) $ warpToScreen s (1%2) (1%2) -setFullscreenSupported :: X () -setFullscreenSupported = withDisplay $ \dpy -> do - r <- asks theRoot - a <- getAtom "_NET_SUPPORTED" - c <- getAtom "ATOM" - f <- getAtom "_NET_WM_STATE_FULLSCREEN" - io $ changeProperty32 dpy r a c propModeAppend [fromIntegral f] - +--myStartupHook :: X () +--myStartupHook = do +-- startupHook gnomeConfig +-- spawn "killall -u `id -un` -q xcompmgr; exec xcompmgr" myStartupHook :: X () myStartupHook = do - startupHook desktopConfig + startupHook gnomeConfig setWMName "LG3D" - setFullscreenSupported +atomProperty :: String -> Query Atom +atomProperty p = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap (fromMaybe 0) $ getAtomProperty d w p) + +getAtomProperty :: Display -> Window -> String -> X (Maybe Atom) +getAtomProperty d w p = do + a <- getAtom p + md <- io $ getWindowProperty32 d a w + return $ fmap fromIntegral $ listToMaybe $ fromMaybe [] md + isUtility :: Query Bool -isUtility = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_UTILITY" - -stackHook :: (Window -> W.Stack Window -> W.Stack Window) -> ManageHook -stackHook f = ask >>= \w -> doF $ \s -> s { W.current = mapScreen w (W.current s) - , W.visible = map (mapScreen w) (W.visible s) - , W.hidden = map (mapWorkspace w) (W.hidden s) - } - where - mapWorkspace w ws = ws { W.stack = fmap (f w) $ W.stack ws } - mapScreen w scr = scr { W.workspace = mapWorkspace w (W.workspace scr) } - -moveDown1 :: ManageHook -moveDown1 = stackHook down - where - down w (W.Stack c u (d:dx)) | c == w = W.Stack c (d:u) dx - down _ stack = stack - -moveUp1 :: ManageHook -moveUp1 = stackHook up - where - up w (W.Stack c (u:ux) d) | c == w = W.Stack c ux (u:d) - up _ stack = stack +isUtility = do + atom__NET_WM_WINDOW_TYPE_UTILITY <- liftX $ getAtom "_NET_WM_WINDOW_TYPE_UTILITY" + atomProperty "_NET_WM_WINDOW_TYPE" =? atom__NET_WM_WINDOW_TYPE_UTILITY myManageHook :: ManageHook myManageHook = composeAll [ isDialog --> doFloat , composeOne - [ className =? "Guake.py" -?> doFloatMaybeFullscreen -- <+> doConfigBorderOff) - --, className =? "Do" -?> (doFloat <+> doConfigBorderOff) - , className =? "MPlayer" -?> doCenterFloat - , className =? "mplayer2" -?> doCenterFloat + [ className =? "Guake.py" -?> (doFloatMaybeFullscreen <+> doIgnoreProcessWorkspace) -- <+> doConfigBorderOff) + --, className =? "Do" -?> (doFloat <+> doConfigBorderOff) + , className =? "Gmpc" -?> doIgnoreProcessWorkspace + , className =? "Liferea" -?> doIgnoreProcessWorkspace , className =? "Gnome-session" -?> doIgnoreProcessWorkspace - --, className =? "Gimp" -?> doFloat - , className =? "jrummikub-JRummikub" -?> doFloat - , className =? "Stjerm" -?> doFloatMaybeFullscreen + , className =? "MPlayer" -?> doCenterFloat + , className =? "Gimp" -?> doFloat , className =? "Display" -?> doFloat - , className =? "Dwarf_Fortress" -?> doFloat , className =? "Wine" -?> doFloat , className =? "Pcsx2" -?> doFloat - , stringProperty "WM_ICON_NAME" =? "ZZogl-pg" -?> doFloat + , stringProperty "WM_ICON_NAME" =? "ZeroGS" -?> doFloat , isFullscreen -?> doFullscreen ] , isUtility =? False --> doAutoShift - , manageHook desktopConfig + , manageHook gnomeConfig ] + ---myUnmanageHook :: ManageHook ---myUnmanageHook = moveUp1 - - -myLayoutHook = screenWorkspaceStorage $ processWorkspaceManager $ manageFullscreen {- $ smartBorders -} (Full ||| tiled ||| Mirror tiled) +myLayoutHook = processWorkspaceStorage $ manageFullscreen $ smartBorders (Full ||| tiled ||| Mirror tiled) where -- default tiling algorithm partitions the screen into two panes tiled = ResizableTall nmaster delta ratio [] @@ -183,6 +139,5 @@ myLayoutHook = screenWorkspaceStorage $ processWorkspaceManager $ manageFullscre myEventHook :: Event -> X All myEventHook ev = do - handleForgetEmptyWindowGroups ev handleFullscreen ev - handleEventHook defaultConfig ev + (handleEventHook gnomeConfig) ev