экспериментальная версия: хитрое переключение между окнами и focusFol…

…lowsMouse

.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-<R>", windows W.focusDown)
---                       , ("M-S-<R>", windows W.swapDown)
---                       , ("M-<L>", windows W.focusUp)
---                       , ("M-S-<L>", windows W.swapUp)
+                      , ("M-C-a", dumpStack)
+                      , ("M-<Tab>", 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
+