diff --git a/.xmonad/xmonad.hs b/.xmonad/xmonad.hs index d164f48..d242f5e 100644 --- a/.xmonad/xmonad.hs +++ b/.xmonad/xmonad.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveDataTypeable #-} + import XMonad import qualified XMonad.StackSet as W import qualified Data.Map as M @@ -9,16 +11,22 @@ import XMonad.Actions.CopyWindow import XMonad.Layout.PerWorkspace import XMonad.Layout.IM import Data.Ratio ((%)) +import Maybe (maybe, mapMaybe, fromJust) +import Monad (mplus, liftM) +import qualified List import XMonad.Layout.Grid import XMonad.Layout.DwmStyle import XMonad.Layout.Named import XMonad.Layout.Reflect import XMonad.Layout.LayoutHints import XMonad.Layout.SimplestFloat +import qualified XMonad.Util.ExtensibleState as ES +import XMonad.Actions.UpdatePointer --import XMonad.Layout.MagicFocus import XMonad.Actions.CycleWS import XMonad.Actions.CycleRecentWS -- TODO +import XMonad.Actions.CycleWindows import XMonad.Prompt import XMonad.Prompt.XMonad @@ -40,10 +48,10 @@ main = do , keys = \c -> mykeys c `M.union` keys defaultConfig c , manageHook = myManageHook , workspaces = ["1:dev","2:mail","3:web","4:IM","5","6","7","8","9","0"] - , logHook = dynamicLogWithPP $ myXmobarPP xm + , logHook = dynamicLogWithPP (myXmobarPP xm) >> updatePointer (Relative 0.2 0.2) >> updateWList , layoutHook = avoidStruts myLayouts , startupHook = setWMName "LG3D" -- a fix for java applets - , focusFollowsMouse = False + , focusFollowsMouse = True } mykeys conf = @@ -59,21 +67,26 @@ main = do , ("M-,", moveTo Prev NonEmptyWS) , ("M-.", moveTo Next NonEmptyWS) , ("M-p", xmonadPrompt defaultXPConfig) --- , ("M-", windows W.focusDown) --- , ("M-S-", windows W.swapDown) --- , ("M-", windows W.focusUp) --- , ("M-S-", windows W.swapUp) + , ("M-C-a", dumpStack) + , ("M-", myCycleStacks [xK_Alt_L] xK_Tab xK_grave) ] + xxx s@(W.Stack t ls rs) = s : f W.focusUp' (length ls) ++ f W.focusDown' (length rs) where + f p 0 = [] + f p 1 = [p s] + f p n = s : map p (f p (n-1)) + dumpStack :: X () + dumpStack = do + XConf {theRoot = root, display = d} <- ask + stack <- gets $ W.stack . W.workspace . W.current . windowset + m <- gets extensibleState + spawn ("xmessage \"" ++ show stack ++ "\"") myManageHook = composeAll [ className =? "MPlayer" --> doFloat , className =? "mplayer" --> doFloat , className =? "Pidgin" --> moveTo "4:IM" --- , className =? "Xmessage" --> (ask >>= doF . \w -> (\ws -> foldr ($) ws (copyToWss ["4","5"] w) ) . W.shift "6" ) --- , className =? "Pidgin" --> moveTo "im" , className =? "Iceweasel" --> moveTo "3:web" --- , className =? "Emacs" --> moveTo "emacs" ] where moveTo = doF . W.shift @@ -89,3 +102,58 @@ main = do delta = 3/100 imLayout = named "IM" $ avoidStruts $ reflectHoriz $ IM (1%6) (Role "buddy_list") + +-- TODO: use global WList -- all windows in all workspaces +data WList = WList [Window] deriving (Read, Show, Typeable) +instance ExtensionClass WList where + initialValue = WList [] + extensionType = PersistentExtension + +updateWList :: X () +updateWList = do + WList old <- ES.get + + let fromStack (W.Stack t ls rs) = + t : (curr List.\\ (t:old)) ++ (old `List.intersect` curr) + where curr = rs ++ ls + + wlist <- gets $ maybe [] fromStack . W.stack . W.workspace . W.current . windowset + ES.put (WList wlist) + +myCycleStacks :: [KeySym] -> KeySym -> KeySym -> X () +myCycleStacks mods keyNext keyPrev = do + XConf {theRoot = root, display = d} <- ask + stack <- gets $ W.stack . W.workspace . W.current . windowset + updateWList + WList wlist <- ES.get + + let stacks = maybe [] (prio wlist) stack + + evt = allocaXEvent $ + \p -> do maskEvent d (keyPressMask .|. keyReleaseMask) p + KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p + s <- keycodeToKeysym d c 0 + return (t, s) + choose n (t, s) + | t == keyPress && s == keyNext = io evt >>= choose (n+1) + | t == keyPress && s == keyPrev = io evt >>= choose (n-1) + | t == keyPress && s `elem` [xK_0..xK_9] = io evt >>= choose (numKeyToN s) + | t == keyRelease && s `elem` mods = return () + | otherwise = doStack n >> io evt >>= choose n + doStack n = windows . W.modify' . const $ stacks `cycref` n + + io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime + io evt >>= choose 1 + io $ ungrabKeyboard d currentTime + where cycref l i = l !! (i `mod` length l) -- modify' ensures l is never [], but must also be finite + numKeyToN = subtract 48 . read . show + + prio wlist (W.Stack t ls rs) = map f wlist + where + f w = W.Stack w ls' rs' where + Just (ls', rs') = m0 `mplus` m1 `mplus` m2 + m0 = if w == t then Just (ls, rs) else Nothing + m1 = liftM (\(ls1, ls2) -> (ls2, reverse ls1 ++ [t] ++ rs)) $ split ls + m2 = liftM (\(rs1, rs2) -> (reverse rs1 ++ [t] ++ ls, rs2)) $ split rs + split xs = liftM (\n -> (take n xs, drop (n+1) xs)) $ List.findIndex (==w) xs +