112 lines
4 KiB
Haskell
112 lines
4 KiB
Haskell
{-# 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
|
|
currentFocusedWindow <- getFocused
|
|
windowHistory <- getFocusHistory <$> ES.get
|
|
newWindow <- windowHistoryHook currentFocusedWindow
|
|
case newWindow of
|
|
Nothing -> runLayout workspace rectangle
|
|
Just window -> do
|
|
let currentStack = W.stack workspace
|
|
let lastFocusedWindow =
|
|
L.find (`elem` W.integrate' currentStack) windowHistory
|
|
let focusWindow windowToFocus =
|
|
until ((windowToFocus ==) . W.focus) W.focusUp' <$> currentStack
|
|
let newstack =
|
|
if window `elem` W.integrate' currentStack
|
|
then focusWindow window
|
|
else case lastFocusedWindow of
|
|
Just window' -> focusWindow window'
|
|
Nothing -> currentStack
|
|
modifyWindowSet (W.focusWindow window)
|
|
addAction $ do
|
|
maybe (return ()) makeBorderNormal currentFocusedWindow
|
|
windows id
|
|
runLayout workspace {W.stack = newstack} rectangle
|
|
|
|
windowHistoryHook :: Maybe Window -> X (Maybe Window)
|
|
windowHistoryHook Nothing = return Nothing
|
|
windowHistoryHook (Just currentFocusedWindow) = do
|
|
currentWindows <- gets $ W.index . windowset
|
|
windowHistory <- getFocusHistory <$> ES.get
|
|
withWindowSet $ \windowSet ->
|
|
case windowHistory of
|
|
[] -> do
|
|
ES.put $ FocusHistory [currentFocusedWindow]
|
|
return Nothing
|
|
(prevFocusedWindow:focusedWindows)
|
|
| prevFocusedWindow == currentFocusedWindow -> return Nothing
|
|
-- Previous focus was removed from windowSet focus on previous existing window in current windowSet
|
|
| prevFocusedWindow `notElem` currentWindows -> do
|
|
let windowHistory' = filter (`W.member` windowSet) focusedWindows
|
|
ES.put (FocusHistory $ force windowHistory')
|
|
return $ L.find (`elem` currentWindows) windowHistory'
|
|
-- Add current focus to windowHistory
|
|
| otherwise -> do
|
|
ES.put $
|
|
FocusHistory $
|
|
force $
|
|
currentFocusedWindow : L.delete currentFocusedWindow windowHistory
|
|
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)
|