nixos-config/system/desktop/home-manager/xmonad/TabbedFix.hs

{-# 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)