From 562c8b68fbc14265494cbb94a560549de6de0c5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximilian=20Ke=C3=9Fler?= Date: Tue, 19 Jul 2022 21:34:01 +0200 Subject: [PATCH] make working directories of topics persistent (where not explictly given from initial config) --- src/XMonad/Custom/TopicSpace.hs | 115 +++++++++++++++++++++++++++----- 1 file changed, 98 insertions(+), 17 deletions(-) diff --git a/src/XMonad/Custom/TopicSpace.hs b/src/XMonad/Custom/TopicSpace.hs index 3cd1b60..a301de8 100644 --- a/src/XMonad/Custom/TopicSpace.hs +++ b/src/XMonad/Custom/TopicSpace.hs @@ -8,6 +8,8 @@ module XMonad.Custom.TopicSpace ( , spawnInTopicDir , setTopicDir , promptSetTopicDir + , updateTopicConfig + , currentTopicConfig ) where @@ -52,7 +54,7 @@ import qualified XMonad.StackSet as W import XMonad import XMonad.Actions.TopicSpace import XMonad.Prompt -import XMonad.Prompt.Workspace +import XMonad.Prompt.Directory (directoryPrompt) -- | An alias for topicNames. @@ -72,34 +74,115 @@ inHomeTI = inHome simpleTI :: Topic -> TopicItem simpleTI n = TI n "~/." (pure ()) - --------------------------------------------t -- X state implementation and tools -- | Store config in X extensible state --- We do this by wrapping into a store type to avoid --- orphan instance declarations -data StoreTopicConfig = StoreTopicConfig TopicConfig -instance ExtensionClass StoreTopicConfig where - initialValue = StoreTopicConfig def +-- We want to store the associated directories as persistent (surviving restarts of XMonad) +-- Thus, we actually have to split the data of TopicConfig up into the directory mapping +-- and the rest (associated actions etc) + + + +-- | Management for storage of the associated topic dirs + +-- | associated directories +type DirTopicConfig = Map Topic Dir + +data StoreDirTopicConfig = StoreDirTopicConfig DirTopicConfig deriving (Read, Eq, Show) + +-- | Make this new type storable +instance ExtensionClass StoreDirTopicConfig where + initialValue = StoreDirTopicConfig empty + extensionType = PersistentExtension + +-- | Unwrap a stored dir topic config +unwrapDirTopicConfig :: StoreDirTopicConfig -> DirTopicConfig +unwrapDirTopicConfig (StoreDirTopicConfig tc) = tc + +-- | store new DirTopicConfig +updateDirTopicConfig :: DirTopicConfig -> X () +updateDirTopicConfig = XS.put . StoreDirTopicConfig + +-- | retrieve current value of DirTopicConfig +currentDirTopicConfig :: X DirTopicConfig +currentDirTopicConfig = fmap unwrapDirTopicConfig XS.get + + +-- | All other associated data + + +-- | This is just copied from XMonad.Actions.TopicSpace, but with the directory map left out +-- Also, maxTopicHistory is left out, since this field is deprecated anyways +data ShallowTopicConfig = ShallowTopicConfig { sTopicActions :: Map Topic (X ()) + -- ^ This mapping associates an action to trigger when + -- switching to a given topic which workspace is empty. + , sDefaultTopicAction :: Topic -> X () + -- ^ This is the default topic action. + , sDefaultTopic :: Topic + -- ^ This is the default (= fallback) topic. + } +instance Default ShallowTopicConfig where + def = shallowTopicConfig def + + + +data StoreShallowTopicConfig = StoreShallowTopicConfig ShallowTopicConfig +instance ExtensionClass StoreShallowTopicConfig where + initialValue = StoreShallowTopicConfig def -- | Unwrap a stored topic config -topicConfig :: StoreTopicConfig -> TopicConfig -topicConfig (StoreTopicConfig tc) = tc +unwrapShallowTopicConfig :: StoreShallowTopicConfig -> ShallowTopicConfig +unwrapShallowTopicConfig (StoreShallowTopicConfig tc) = tc + +-- | Update currently stored ShallowTopicConfig +updateShallowTopicConfig :: ShallowTopicConfig -> X () +updateShallowTopicConfig = XS.put . StoreShallowTopicConfig + +-- | Retrieve current value of ShallowTopicConfig +currentShallowTopicConfig :: X ShallowTopicConfig +currentShallowTopicConfig = fmap unwrapShallowTopicConfig XS.get + + + +-- | Easy methods for mergin/splitting TopicConfigs + + +dirTopicConfig :: TopicConfig -> DirTopicConfig +dirTopicConfig = topicDirs + +shallowTopicConfig :: TopicConfig -> ShallowTopicConfig +shallowTopicConfig tc = ShallowTopicConfig (topicActions tc) (defaultTopicAction tc) (defaultTopic tc) + +combineConfigs :: DirTopicConfig -> ShallowTopicConfig -> TopicConfig +combineConfigs dirs s = def { topicDirs = dirs + , topicActions = sTopicActions s + , defaultTopicAction = sDefaultTopicAction s + , defaultTopic = sDefaultTopic s + } -- | Update the value of the topic config in the X state updateTopicConfig :: TopicConfig -> X () -updateTopicConfig = XS.put . StoreTopicConfig +updateTopicConfig c = (updateDirTopicConfig $ dirTopicConfig c) + >> (updateShallowTopicConfig $ shallowTopicConfig c) -- | Retrieve the current topic config from the X state currentTopicConfig :: X TopicConfig -currentTopicConfig = fmap topicConfig XS.get +currentTopicConfig = do + dir <- currentDirTopicConfig + shallow <- currentShallowTopicConfig + return $ combineConfigs dir shallow -- | Put initial topic Config into X state at startup -- Add this to the XConfig startupHook +-- working directories of topics with no explicit directory set +-- are restored from the last XMonad run topicStartupHook :: TopicConfig -> X () -topicStartupHook = updateTopicConfig +topicStartupHook tc = do + lastDirs <- currentDirTopicConfig + updateDirTopicConfig $ union (topicDirs tc) lastDirs + updateShallowTopicConfig $ shallowTopicConfig tc ------------------------------------------- @@ -125,11 +208,9 @@ spawnInTopicDir cmd = do setTopicDir :: Dir -> X () setTopicDir dir = do ws <- gets (W.currentTag . windowset) - tc <- currentTopicConfig - updateTopicConfig tc { - topicDirs = insert ws dir $ topicDirs tc - } + dtc <- currentDirTopicConfig + updateDirTopicConfig $ insert ws dir dtc -- | Prompt for the new working directory promptSetTopicDir :: XPConfig -> X () -promptSetTopicDir xpc = workspacePrompt xpc setTopicDir +promptSetTopicDir xpc = directoryPrompt xpc "Set working dir:" setTopicDir