{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} module TabbedFix (historyLayout, runAllPending) where import Control.DeepSeq (force) import qualified Data.List as L import XMonad import XMonad.Layout.LayoutModifier (LayoutModifier, ModifiedLayout (ModifiedLayout), modifyLayout) import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as ES newtype PendingActions = PendingActions [X ()] instance ExtensionClass PendingActions where initialValue = PendingActions [] addAction :: X () -> X () addAction x = ES.modify (\(PendingActions xs) -> PendingActions (x:xs)) runAllPending :: X () runAllPending = do PendingActions actions <- ES.get ES.put (PendingActions []) sequence_ actions newtype FocusHistory = FocusHistory { getFocusHistory :: [Window] } deriving (Read, Show, Typeable) instance ExtensionClass FocusHistory where initialValue = FocusHistory [] extensionType = PersistentExtension data FocusLayout a = FocusLayout deriving (Read,Show,Typeable) historyLayout :: l Window -> ModifiedLayout FocusLayout l Window historyLayout = ModifiedLayout FocusLayout instance LayoutModifier FocusLayout Window where modifyLayout _ workspace rectangle = do oldWindow <- getFocused history <- getFocusHistory <$> ES.get newWindow <- windowHistoryHook oldWindow case newWindow of Nothing -> runLayout workspace rectangle Just window -> do let oldstack = W.stack workspace let mw = L.find (`elem` W.integrate' oldstack) history let newstack = if window `elem` (W.integrate' oldstack) then until ((window ==) . W.focus) W.focusUp' <$> oldstack else case mw of Just window' -> until ((window' ==) . W.focus) W.focusUp' <$> oldstack Nothing -> oldstack modifyWindowSet (W.focusWindow window) addAction $ do maybe (return ()) makeBorderNormal oldWindow windows id runLayout workspace {W.stack = newstack} rectangle windowHistoryHook :: Maybe Window -> X (Maybe Window) windowHistoryHook Nothing = return Nothing windowHistoryHook (Just window') = do history <- getFocusHistory <$> ES.get currentWindowSet <- gets $ W.index . windowset withWindowSet $ \allWindows -> case history of [] -> do ES.put $ FocusHistory [window'] return Nothing (prev:xs) | prev == window' -> return Nothing -- Previous focus was removed from ws, focus on previous existing window in current ws | prev `notElem` currentWindowSet -> do let history' = filter (`W.member` allWindows) xs ES.put (FocusHistory $ force history') return $ L.find (`elem` currentWindowSet) history' -- Add current focus to history | otherwise -> do ES.put $ FocusHistory $ force $ window' : L.delete window' history return Nothing makeBorderRed :: Window -> X () makeBorderRed w = withDisplay $ \d -> io $ do setWindowBorder d w 0xff0000 -- wz1000: palo: btw, you will need to change the color in makeBorderNormal to your unfocused border color makeBorderNormal :: Window -> X () makeBorderNormal w = withDisplay $ \d -> io $ do setWindowBorder d w 0x2b2b2b makeBorderFocused :: Window -> X () makeBorderFocused w = withDisplay $ \d -> io $ do setWindowBorder d w 0xcccccc getFocused :: X (Maybe Window) getFocused = withWindowSet (return . W.peek)