Update A.TopicSpace to use extensible state. No config changes required.

This commit is contained in:
Adam Vogt
2009-11-07 19:45:02 +00:00
parent 920bf15e04
commit 9cd4fccdc2

View File

@@ -1,3 +1,4 @@
{-# LANGUAGE DeriveDataTypeable #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
-- Module : XMonad.Actions.TopicSpace -- Module : XMonad.Actions.TopicSpace
@@ -43,6 +44,7 @@ import Data.Maybe (fromMaybe, isNothing, listToMaybe)
import Data.Ord import Data.Ord
import qualified Data.Map as M import qualified Data.Map as M
import Control.Monad ((=<<),liftM2,when,unless,replicateM_) import Control.Monad ((=<<),liftM2,when,unless,replicateM_)
import Control.Applicative ((<$>))
import System.IO import System.IO
import XMonad.Operations import XMonad.Operations
@@ -56,7 +58,7 @@ import XMonad.Hooks.DynamicLog (PP(..))
import qualified XMonad.Hooks.DynamicLog as DL import qualified XMonad.Hooks.DynamicLog as DL
import XMonad.Util.Run (spawnPipe) import XMonad.Util.Run (spawnPipe)
import XMonad.Util.StringProp(getStringListProp,setStringListProp) import XMonad.Util.ExtensibleState
-- $overview -- $overview
-- This module allows to organize your workspaces on a precise topic basis. So -- This module allows to organize your workspaces on a precise topic basis. So
@@ -225,19 +227,23 @@ data TopicConfig = TopicConfig { topicDirs :: M.Map Topic Dir
-- numeric keypad. -- numeric keypad.
} }
newtype PrevTopics = PrevTopics { getPrevTopics :: [String] } deriving (Read,Show,Typeable)
instance ExtensionClass PrevTopics where
initialValue = PrevTopics []
extensionType = PersistentExtension
-- | Returns the list of last focused workspaces the empty list otherwise. -- | Returns the list of last focused workspaces the empty list otherwise.
-- This function rely on a reserved property namely _XMONAD_LAST_FOCUSED_WORKSPACES.
getLastFocusedTopics :: X [String] getLastFocusedTopics :: X [String]
getLastFocusedTopics = asks display >>= flip getStringListProp "_XMONAD_LAST_FOCUSED_WORKSPACES" getLastFocusedTopics = getPrevTopics <$> getState
-- | Given a 'TopicConfig', the last focused topic, and a predicate that will -- | Given a 'TopicConfig', the last focused topic, and a predicate that will
-- select topics that one want to keep, this function will set the property -- select topics that one want to keep, this function will set the property
-- of last focused topics. -- of last focused topics.
setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X () setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X ()
setLastFocusedTopic tg w predicate = do setLastFocusedTopic tg w predicate =
disp <- asks display modifyState $ PrevTopics
setStringListProp disp "_XMONAD_LAST_FOCUSED_WORKSPACES" . take (maxTopicHistory tg) . nub . (w:) . filter predicate
. take (maxTopicHistory tg) . nub . (w:) . filter predicate =<< getLastFocusedTopics . getPrevTopics
-- | This function is a variant of 'DL.pprWindowSet' which takes a topic configuration -- | This function is a variant of 'DL.pprWindowSet' which takes a topic configuration
-- and a pretty-printing record 'PP'. It will show the list of topics sorted historically -- and a pretty-printing record 'PP'. It will show the list of topics sorted historically