108 lines
3.6 KiB
Haskell
108 lines
3.6 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
|
|
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)
|