{-# LANGUAGE DeriveDataTypeable #-}
module XMonad.Hooks.WorkspaceHistory (
workspaceHistoryHook
, workspaceHistory
, workspaceHistoryByScreen
, workspaceHistoryWithScreen
, workspaceHistoryTransaction
) where
import Control.Applicative
import Prelude
import XMonad
import XMonad.StackSet hiding (filter, delete)
import Data.List
import qualified XMonad.Util.ExtensibleState as XS
data WorkspaceHistory = WorkspaceHistory
{ history :: [(ScreenId, WorkspaceId)]
} deriving (Typeable, Read, Show)
instance ExtensionClass WorkspaceHistory where
initialValue = WorkspaceHistory []
extensionType = PersistentExtension
workspaceHistoryHook :: X ()
workspaceHistoryHook = gets windowset >>= (XS.modify . updateLastActiveOnEachScreen)
workspaceHistoryWithScreen :: X [(ScreenId, WorkspaceId)]
workspaceHistoryWithScreen = XS.gets history
workspaceHistoryByScreen :: X [(ScreenId, [WorkspaceId])]
workspaceHistoryByScreen =
map (\wss -> (fst $ head wss, map snd wss)) .
groupBy (\a b -> fst a == fst b) .
sortBy (\a b -> compare (fst a) $ fst b)<$>
workspaceHistoryWithScreen
workspaceHistory :: X [WorkspaceId]
workspaceHistory = nub . map snd <$> XS.gets history
workspaceHistoryTransaction :: X () -> X ()
workspaceHistoryTransaction action = do
startingHistory <- XS.gets history
action
new <- (flip updateLastActiveOnEachScreen $ WorkspaceHistory startingHistory) <$> gets windowset
XS.put new
updateLastActiveOnEachScreen :: WindowSet -> WorkspaceHistory -> WorkspaceHistory
updateLastActiveOnEachScreen StackSet {current = cur, visible = vis} wh =
WorkspaceHistory { history = doUpdate cur $ foldl updateLastForScreen (history wh) $ vis ++ [cur] }
where
firstOnScreen sid = find ((== sid) . fst)
doUpdate Screen {workspace = Workspace { tag = wid }, screen = sid} curr =
let newEntry = (sid, wid) in newEntry:delete newEntry curr
updateLastForScreen curr Screen {workspace = Workspace { tag = wid }, screen = sid} =
let newEntry = (sid, wid)
alreadyCurrent = maybe False (== newEntry) $ firstOnScreen sid curr
in if alreadyCurrent then curr else newEntry:delete newEntry curr