mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
feat: add profiles
This commit is contained in:
mislavzanic
brandon s allbery kf8nh
parent
c8dff5e2dc
commit
bfe2f5b3f9
@ -6,6 +6,11 @@
|
||||
|
||||
### New Modules
|
||||
|
||||
* `XMonad.Actions.Profiles`.
|
||||
|
||||
- Group workspaces by similarity. Usefull when one has lots
|
||||
of workspaces and uses only a couple per unit of work.
|
||||
|
||||
### Bug Fixes and Minor Changes
|
||||
|
||||
* Fix build-with-cabal.sh when XDG_CONFIG_HOME is defined.
|
||||
|
||||
545
XMonad/Actions/Profiles.hs
Normal file
545
XMonad/Actions/Profiles.hs
Normal file
@ -0,0 +1,545 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.Profiles
|
||||
-- Description : Group your workspaces by similarity.
|
||||
-- Copyright : (c) Mislav Zanic
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Mislav Zanic <mislavzanic3@gmail.com>
|
||||
-- Stability : experimental
|
||||
-- Portability : unportable
|
||||
--
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Actions.Profiles
|
||||
( -- * Overview
|
||||
-- $overview
|
||||
|
||||
-- * Usage
|
||||
-- $usage
|
||||
|
||||
-- * Types
|
||||
ProfileId
|
||||
, Profile(..)
|
||||
, ProfileConfig(..)
|
||||
|
||||
-- * Hooks
|
||||
, addProfiles
|
||||
, addProfilesWithHistory
|
||||
|
||||
-- * Switching profiles
|
||||
, switchToProfile
|
||||
|
||||
-- * Workspace navigation and keybindings
|
||||
, wsFilter
|
||||
, bindOn
|
||||
|
||||
-- * Loggers and pretty printers
|
||||
, excludeWSPP
|
||||
, profileLogger
|
||||
|
||||
-- * Prompts
|
||||
, switchProfilePrompt
|
||||
, addWSToProfilePrompt
|
||||
, removeWSFromProfilePrompt
|
||||
, switchProfileWSPrompt
|
||||
, shiftProfileWSPrompt
|
||||
|
||||
-- * Utilities
|
||||
, currentProfile
|
||||
, profileIds
|
||||
, previousProfile
|
||||
, profileHistory
|
||||
, allProfileWindows
|
||||
, profileWorkspaces
|
||||
)where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Data.Map.Strict (Map)
|
||||
import Data.List
|
||||
import qualified Data.Map.Strict as Map
|
||||
|
||||
import Control.DeepSeq
|
||||
|
||||
import XMonad
|
||||
import XMonad.Prelude
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
import XMonad.Actions.CycleWS
|
||||
|
||||
import qualified XMonad.Util.ExtensibleState as XS
|
||||
import XMonad.Util.Loggers (Logger)
|
||||
import XMonad.Prompt.Window (XWindowMap)
|
||||
import XMonad.Actions.WindowBringer (WindowBringerConfig(..))
|
||||
import XMonad.Actions.OnScreen (greedyViewOnScreen)
|
||||
import XMonad.Hooks.Rescreen (addAfterRescreenHook)
|
||||
import XMonad.Hooks.DynamicLog (PP(ppRename))
|
||||
import XMonad.Prompt
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- $overview
|
||||
-- This module allows you to group your workspaces into 'Profile's based on certain similarities.
|
||||
-- The idea is to expand upon the philosophy set by "XMonad.Actions.TopicSpace"
|
||||
-- which states that you can look at a topic/workspace as a
|
||||
-- single unit of work instead of multiple related units of work.
|
||||
-- This comes in handy if you have lots of workspaces with windows open and need only to
|
||||
-- work with a few of them at a time. With 'Profile's, you can focus on those few workspaces that
|
||||
-- require your attention by not displaying, or allowing you to switch to the rest of the workspaces.
|
||||
-- The best example is having a profile for development and a profile for leisure activities.
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- $usage
|
||||
-- To use @Profiles@ you need to add it to your XMonad configuration
|
||||
-- and configure your profiles.
|
||||
--
|
||||
-- First you'll need to handle the imports.
|
||||
--
|
||||
-- > import XMonad.Actions.Profiles
|
||||
-- > import XMonad.Util.EZConfig -- for keybindings
|
||||
-- > import qualified XMonad.StackSet as W
|
||||
-- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO -- for workspace navigation
|
||||
--
|
||||
-- Next you'll need to define your profiles.
|
||||
--
|
||||
-- > myStartingProfile :: ProfileId
|
||||
-- > myStartingProfile = "Work"
|
||||
-- >
|
||||
-- > myProfiles :: [Profile]
|
||||
-- > myProfiles =
|
||||
-- > [ Profile { profileId = "Home"
|
||||
-- > , profileWS = [ "www"
|
||||
-- > , "rss"
|
||||
-- > , "vid"
|
||||
-- > , "vms"
|
||||
-- > , "writing"
|
||||
-- > , "notes"
|
||||
-- > ]
|
||||
-- > }
|
||||
-- > , Profile { profileId = "Work"
|
||||
-- > , profileWS = [ "www"
|
||||
-- > , "slack"
|
||||
-- > , "dev"
|
||||
-- > , "k8s"
|
||||
-- > , "notes"
|
||||
-- > ]
|
||||
-- > }
|
||||
-- > ]
|
||||
--
|
||||
-- So, while using @Home@ 'Profile', you'll only be able to see, navigate to and
|
||||
-- do actions with @["www", "rss", "vid", "vms", "writing", "notes"]@ workspaces.
|
||||
--
|
||||
-- You may also need to define some keybindings. Since @M-1@ .. @M-9@ are
|
||||
-- sensible keybindings for switching workspaces, you'll need to use
|
||||
-- 'bindOn' to have different keybindings per profile.
|
||||
-- Here, we'll use "XMonad.Util.EZConfig" syntax:
|
||||
--
|
||||
-- > myKeys :: [(String, X())]
|
||||
-- > myKeys =
|
||||
-- > [ ("M-p", switchProfilePrompt xpConfig)
|
||||
-- > , ("M-g", switchProfileWSPrompt xpConfig)
|
||||
-- > , ("M1-j", DO.moveTo Next wsFilter)
|
||||
-- > , ("M1-k", DO.moveTo Prev wsFilter)
|
||||
-- > ]
|
||||
-- > <>
|
||||
-- > [ ("M-" ++ m ++ k, bindOn $ map (\x -> (fst x, f $ snd x)) i)
|
||||
-- > | (i, k) <- map (\(x:xs) -> (map fst (x:xs), snd x)) $ sortGroupBy snd tupleList
|
||||
-- > , (f, m) <- [(mby $ windows . W.greedyView, ""), (mby $ windows . W.shift, "S-")]
|
||||
-- > ]
|
||||
-- > where
|
||||
-- > mby f wid = if wid == "" then return () else f wid
|
||||
-- > sortGroupBy f = groupBy (\ x y -> f x == f y) . sortBy (\x y -> compare (f x) (f y))
|
||||
-- > tupleList = concatMap (\p -> zip (map (\wid -> (profileId p, wid)) (profileWS p <> repeat "")) (map show [1..9 :: Int])) myProfiles
|
||||
--
|
||||
-- After that, you'll need to hook @Profiles@ into your XMonad config:
|
||||
--
|
||||
-- > main = xmonad $ addProfiles def { profiles = myProfiles
|
||||
-- > , startingProfile = myStartingProfile
|
||||
-- > }
|
||||
-- > $ def `additionalKeysP` myKeys
|
||||
--
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
type ProfileId = String
|
||||
type ProfileMap = Map ProfileId Profile
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Profile representation.
|
||||
data Profile = Profile
|
||||
{ profileId :: !ProfileId -- ^ Profile name.
|
||||
, profileWS :: ![WorkspaceId] -- ^ A list of workspaces contained within a profile.
|
||||
}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Internal profile state.
|
||||
data ProfileState = ProfileState
|
||||
{ profilesMap :: !ProfileMap
|
||||
, current :: !(Maybe Profile)
|
||||
, previous :: !(Maybe ProfileId)
|
||||
}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | User config for profiles.
|
||||
data ProfileConfig = ProfileConfig
|
||||
{ workspaceExcludes :: ![WorkspaceId] -- ^ A list of workspaces to exclude from the @profileHistoryHook@.
|
||||
, profiles :: ![Profile] -- ^ A list of user-defined profiles.
|
||||
, startingProfile :: !ProfileId -- ^ Profile shown on startup.
|
||||
}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
instance Default ProfileConfig where
|
||||
def = ProfileConfig { workspaceExcludes = []
|
||||
, profiles = []
|
||||
, startingProfile = ""
|
||||
}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
instance ExtensionClass ProfileState where
|
||||
initialValue = ProfileState Map.empty Nothing Nothing
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Internal type for history tracking.
|
||||
-- Main problem with @XMonad.Hooks.HistoryHook@ is that it isn't profile aware.
|
||||
-- Because of that, when switching to a previous workspace, you might switch to
|
||||
-- a workspace
|
||||
newtype ProfileHistory = ProfileHistory
|
||||
{ history :: Map ProfileId [(ScreenId, WorkspaceId)]
|
||||
}
|
||||
deriving (Read, Show)
|
||||
deriving NFData via Map ProfileId [(Int, WorkspaceId)]
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
instance ExtensionClass ProfileHistory where
|
||||
extensionType = PersistentExtension
|
||||
initialValue = ProfileHistory Map.empty
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
newtype ProfilePrompt = ProfilePrompt String
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
instance XPrompt ProfilePrompt where
|
||||
showXPrompt (ProfilePrompt x) = x
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
defaultProfile :: Profile
|
||||
defaultProfile = defaultProfile
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Returns current profile.
|
||||
currentProfile :: X ProfileId
|
||||
currentProfile = profileId . fromMaybe defaultProfile . current <$> XS.get
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Returns previous profile.
|
||||
previousProfile :: X (Maybe ProfileId)
|
||||
previousProfile = XS.gets previous
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Returns the history of viewed workspaces per profile.
|
||||
profileHistory :: X (Map ProfileId [(ScreenId, WorkspaceId)])
|
||||
profileHistory = XS.gets history
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
profileMap :: X ProfileMap
|
||||
profileMap = XS.gets profilesMap
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Returns ids of all profiles.
|
||||
profileIds :: X [ProfileId]
|
||||
profileIds = Map.keys <$> XS.gets profilesMap
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
currentProfileWorkspaces :: X [WorkspaceId]
|
||||
currentProfileWorkspaces = XS.gets current <&> profileWS . fromMaybe defaultProfile
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Hook profiles into XMonad. This function adds a startup hook that
|
||||
-- sets up ProfileState. Also adds an afterRescreenHook for viewing correct
|
||||
-- workspaces when adding new screens.
|
||||
addProfiles :: ProfileConfig -> XConfig a -> XConfig a
|
||||
addProfiles profConf conf = addAfterRescreenHook hook $ conf
|
||||
{ startupHook = profileStartupHook' <> startupHook conf
|
||||
}
|
||||
where
|
||||
profileStartupHook' :: X()
|
||||
profileStartupHook' = profilesStartupHook (profiles profConf) (startingProfile profConf)
|
||||
hook = currentProfile >>= switchWSOnScreens
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Hooks profiles into XMonad and enables Profile history logging.
|
||||
addProfilesWithHistory :: ProfileConfig -> XConfig a -> XConfig a
|
||||
addProfilesWithHistory profConf conf = conf'
|
||||
{ logHook = profileHistoryHookExclude (workspaceExcludes profConf) <> logHook conf
|
||||
}
|
||||
where
|
||||
conf' = addProfiles profConf conf
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
profileHistoryHookExclude :: [WorkspaceId] -> X()
|
||||
profileHistoryHookExclude ews = do
|
||||
cur <- gets $ W.current . windowset
|
||||
vis <- gets $ W.visible . windowset
|
||||
pws <- currentProfileWorkspaces
|
||||
p <- currentProfile
|
||||
|
||||
updateHist p $ workspaceScreenPairs $ filterWS pws $ cur:vis
|
||||
where
|
||||
workspaceScreenPairs wins = zip (W.screen <$> wins) (W.tag . W.workspace <$> wins)
|
||||
filterWS pws = filter ((\wid -> (wid `elem` pws) && (wid `notElem` ews)) . W.tag . W.workspace)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
updateHist :: ProfileId -> [(ScreenId, WorkspaceId)] -> X()
|
||||
updateHist pid xs = profileWorkspaces pid >>= XS.modify' . update
|
||||
where
|
||||
update pws hs = force $ hs { history = doUpdate pws $ history hs }
|
||||
|
||||
doUpdate pws hist = foldl (\acc (sid, wid) -> Map.alter (f pws sid wid) pid acc) hist xs
|
||||
|
||||
f pws sid wid val = case val of
|
||||
Nothing -> pure [(sid, wid)]
|
||||
Just hs -> pure $ let new = (sid, wid) in new:filterWS pws new hs
|
||||
|
||||
filterWS :: [WorkspaceId] -> (ScreenId, WorkspaceId) -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
|
||||
filterWS pws new = filter (\x -> snd x `elem` pws && x /= new)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Adds profiles to ProfileState and sets current profile using .
|
||||
|
||||
profilesStartupHook :: [Profile] -> ProfileId -> X ()
|
||||
profilesStartupHook ps pid = XS.modify go >> switchWSOnScreens pid
|
||||
where
|
||||
go :: ProfileState -> ProfileState
|
||||
go s = s {profilesMap = update $ profilesMap s, current = setCurrentProfile $ Map.fromList $ map entry ps}
|
||||
|
||||
update :: ProfileMap -> ProfileMap
|
||||
update = Map.union (Map.fromList $ map entry ps)
|
||||
|
||||
entry :: Profile -> (ProfileId, Profile)
|
||||
entry p = (profileId p, p)
|
||||
|
||||
setCurrentProfile :: ProfileMap -> Maybe Profile
|
||||
setCurrentProfile s = case Map.lookup pid s of
|
||||
Nothing -> Just $ Profile pid []
|
||||
Just pn -> Just pn
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
setPrevious :: ProfileId -> X()
|
||||
setPrevious name = XS.modify update
|
||||
where
|
||||
update ps = ps { previous = doUpdate ps }
|
||||
doUpdate ps = case Map.lookup name $ profilesMap ps of
|
||||
Nothing -> previous ps
|
||||
Just p -> Just $ profileId p
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
setProfile :: ProfileId -> X ()
|
||||
setProfile p = currentProfile >>= setPrevious >> setProfile' p
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
setProfile' :: ProfileId -> X ()
|
||||
setProfile' name = XS.modify update
|
||||
where
|
||||
update ps = ps { current = doUpdate ps }
|
||||
doUpdate ps = case Map.lookup name $ profilesMap ps of
|
||||
Nothing -> current ps
|
||||
Just p -> Just p
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Switch to a profile.
|
||||
switchToProfile :: ProfileId -> X()
|
||||
switchToProfile pid = setProfile pid >> switchWSOnScreens pid
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Returns the workspace ids associated with a profile id.
|
||||
profileWorkspaces :: ProfileId -> X [WorkspaceId]
|
||||
profileWorkspaces pid = profileMap >>= findPWs
|
||||
where
|
||||
findPWs pm = return . profileWS . fromMaybe defaultProfile $ Map.lookup pid pm
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Prompt for adding a workspace id to a profile.
|
||||
addWSToProfilePrompt :: XPConfig -> X()
|
||||
addWSToProfilePrompt c = do
|
||||
ps <- profileIds
|
||||
mkXPrompt (ProfilePrompt "Add ws to profile:") c (mkComplFunFromList' c ps) f
|
||||
where
|
||||
f :: String -> X()
|
||||
f p = do
|
||||
vis <- gets $ fmap (W.tag . W.workspace) . W.visible . windowset
|
||||
cur <- gets $ W.tag . W.workspace . W.current . windowset
|
||||
hid <- gets $ fmap W.tag . W.hidden . windowset
|
||||
let
|
||||
arr = cur:(vis <> hid)
|
||||
in mkXPrompt (ProfilePrompt "Ws to add to profile:") c (mkComplFunFromList' c arr) (`addWSToProfile` p)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Prompt for switching profiles.
|
||||
switchProfilePrompt :: XPConfig -> X()
|
||||
switchProfilePrompt c = do
|
||||
ps <- profileIds
|
||||
mkXPrompt (ProfilePrompt "Profile: ") c (mkComplFunFromList' c ps) switchToProfile
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Prompt for switching workspaces.
|
||||
switchProfileWSPrompt :: XPConfig -> X ()
|
||||
switchProfileWSPrompt c = mkPrompt =<< currentProfileWorkspaces
|
||||
where
|
||||
mkPrompt pws = mkXPrompt (ProfilePrompt "Switch to workspace:") c (mkComplFunFromList' c pws) mbygoto
|
||||
mbygoto wid = do
|
||||
pw <- profileWorkspaces =<< currentProfile
|
||||
unless (wid `notElem` pw) (windows . W.greedyView $ wid)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Prompt for shifting windows to a different workspace.
|
||||
shiftProfileWSPrompt :: XPConfig -> X ()
|
||||
shiftProfileWSPrompt c = mkPrompt =<< currentProfileWorkspaces
|
||||
where
|
||||
mkPrompt pws = mkXPrompt (ProfilePrompt "Send window to workspace:") c (mkComplFunFromList' c pws) mbyshift
|
||||
mbyshift wid = do
|
||||
pw <- profileWorkspaces =<< currentProfile
|
||||
unless (wid `notElem` pw) (windows . W.shift $ wid)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
addWSToProfile :: WorkspaceId -> ProfileId -> X()
|
||||
addWSToProfile wid pid = XS.modify go
|
||||
where
|
||||
go :: ProfileState -> ProfileState
|
||||
go ps = ps {profilesMap = update $ profilesMap ps, current = update' $ fromMaybe defaultProfile $ current ps}
|
||||
|
||||
update :: ProfileMap -> ProfileMap
|
||||
update mp = case Map.lookup pid mp of
|
||||
Nothing -> mp
|
||||
Just p -> if wid `elem` profileWS p then mp else Map.adjust f pid mp
|
||||
|
||||
f :: Profile -> Profile
|
||||
f p = Profile pid (wid : profileWS p)
|
||||
|
||||
update' :: Profile -> Maybe Profile
|
||||
update' cp = if profileId cp == pid && wid `notElem` profileWS cp then Just (Profile pid $ wid:profileWS cp) else Just cp
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Prompt for removing a workspace from a profile.
|
||||
removeWSFromProfilePrompt :: XPConfig -> X()
|
||||
removeWSFromProfilePrompt c = do
|
||||
ps <- profileIds
|
||||
mkXPrompt (ProfilePrompt "Remove ws from profile:") c (mkComplFunFromList' c ps) f
|
||||
where
|
||||
f :: String -> X()
|
||||
f p = do
|
||||
arr <- profileWorkspaces p
|
||||
mkXPrompt (ProfilePrompt "Ws to remove from profile:") c (mkComplFunFromList' c arr) $
|
||||
\ws -> do
|
||||
cp <- currentProfile
|
||||
ws `removeWSFromProfile` p
|
||||
when (cp == p) $ currentProfile >>= switchWSOnScreens
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
removeWSFromProfile :: WorkspaceId -> ProfileId -> X()
|
||||
removeWSFromProfile wid pid = XS.modify go
|
||||
where
|
||||
go :: ProfileState -> ProfileState
|
||||
go ps = ps {profilesMap = update $ profilesMap ps, current = update' $ fromMaybe defaultProfile $ current ps}
|
||||
|
||||
update :: ProfileMap -> ProfileMap
|
||||
update mp = case Map.lookup pid mp of
|
||||
Nothing -> mp
|
||||
Just p -> if wid `elem` profileWS p then Map.adjust f pid mp else mp
|
||||
|
||||
f :: Profile -> Profile
|
||||
f p = Profile pid (delete wid $ profileWS p)
|
||||
|
||||
update' :: Profile -> Maybe Profile
|
||||
update' cp = if profileId cp == pid && wid `elem` profileWS cp then Just (Profile pid $ delete wid $ profileWS cp) else Just cp
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Pretty printer for a bar. Prints workspace ids of current profile.
|
||||
excludeWSPP :: PP -> X PP
|
||||
excludeWSPP pp = modifyPP <$> currentProfileWorkspaces
|
||||
where
|
||||
modifyPP pws = pp { ppRename = ppRename pp . printTag pws }
|
||||
printTag pws tag = if tag `elem` pws then tag else ""
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | For cycling through workspaces associated with the current.
|
||||
wsFilter :: WSType
|
||||
wsFilter = WSIs $ currentProfileWorkspaces >>= (\ws -> return $ (`elem` ws) . W.tag)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Takes care of placing correct workspaces on their respective screens.
|
||||
-- It does this by reducing the history of a Profile until it gets an array of length
|
||||
-- equal to the number of screens with pairs that have unique workspace ids.
|
||||
switchWSOnScreens :: ProfileId -> X()
|
||||
switchWSOnScreens pid = do
|
||||
hist <- profileHistory
|
||||
vis <- gets $ W.visible . windowset
|
||||
cur <- gets $ W.current . windowset
|
||||
pws <- profileMap <&> (profileWS . fromMaybe (Profile pid []) . Map.lookup pid)
|
||||
case Map.lookup pid hist of
|
||||
Nothing -> switchScreens $ zip (W.screen <$> (cur:vis)) pws
|
||||
Just xs -> compareAndSwitch (f (W.screen <$> cur:vis) xs) (cur:vis) pws
|
||||
where
|
||||
f :: [ScreenId] -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
|
||||
f sids = reorderUniq . reorderUniq . reverse . filter ((`elem` sids) . fst)
|
||||
|
||||
reorderUniq :: (Ord k, Ord v) => [(k,v)] -> [(v,k)]
|
||||
reorderUniq = map (\(x,y) -> (y,x)) . uniq
|
||||
|
||||
uniq :: (Ord k, Ord v) => [(k,v)] -> [(k,v)]
|
||||
uniq = Map.toList . Map.fromList
|
||||
|
||||
viewWS fview sid wid = windows $ fview sid wid
|
||||
|
||||
switchScreens = mapM_ (uncurry $ viewWS greedyViewOnScreen)
|
||||
|
||||
compareAndSwitch hist wins pws | length hist < length wins = switchScreens $ hist <> populateScreens hist wins pws
|
||||
| otherwise = switchScreens hist
|
||||
|
||||
populateScreens hist wins pws = zip (filter (`notElem` map fst hist) $ W.screen <$> wins) (filter (`notElem` map snd hist) pws)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
chooseAction :: (String -> X ()) -> X ()
|
||||
chooseAction f = XS.gets current <&> (profileId . fromMaybe defaultProfile) >>= f
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Create keybindings per profile.
|
||||
bindOn :: [(String, X ())] -> X ()
|
||||
bindOn bindings = chooseAction chooser
|
||||
where
|
||||
chooser profile = case lookup profile bindings of
|
||||
Just action -> action
|
||||
Nothing -> case lookup "" bindings of
|
||||
Just action -> action
|
||||
Nothing -> return ()
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Loggs currentProfile and all profiles with hidden workspaces
|
||||
-- (workspaces that aren't shown on a screen but have windows).
|
||||
profileLogger :: (String -> String) -> (String -> String) -> Logger
|
||||
profileLogger formatFocused formatUnfocused = do
|
||||
hws <- gets $ W.hidden . windowset
|
||||
p <- currentProfile
|
||||
hm <- map fst
|
||||
. filter (\(p', xs) -> any ((`elem` htags hws) . snd) xs || p' == p)
|
||||
. Map.toList <$> profileHistory
|
||||
return $ Just $ foldl (\a b -> a ++ " " ++ b) "" $ format p <$> hm
|
||||
where
|
||||
format p a = if a == p then formatFocused a else formatUnfocused a
|
||||
htags wins = W.tag <$> filter (isJust . W.stack) wins
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | @XWindowMap@ of all windows contained in a profile.
|
||||
allProfileWindows :: XWindowMap
|
||||
allProfileWindows = allProfileWindows' def
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
allProfileWindows' :: WindowBringerConfig -> XWindowMap
|
||||
allProfileWindows' WindowBringerConfig{ windowTitler = titler, windowFilter = include } = do
|
||||
pws <- currentProfileWorkspaces
|
||||
windowSet <- gets windowset
|
||||
Map.fromList . concat <$> mapM keyValuePairs (filter ((`elem` pws) . W.tag) $ W.workspaces windowSet)
|
||||
where keyValuePairs ws = let wins = W.integrate' (W.stack ws)
|
||||
in mapM (keyValuePair ws) =<< filterM include wins
|
||||
keyValuePair ws w = (, w) <$> titler ws w
|
||||
@ -130,6 +130,7 @@ library
|
||||
XMonad.Actions.PhysicalScreens
|
||||
XMonad.Actions.Plane
|
||||
XMonad.Actions.Prefix
|
||||
XMonad.Actions.Profiles
|
||||
XMonad.Actions.Promote
|
||||
XMonad.Actions.RandomBackground
|
||||
XMonad.Actions.RepeatAction
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user