mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-07-30 19:51:51 -07:00
Update A.TopicSpace to use extensible state. No config changes required.
This commit is contained in:
@@ -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
|
||||||
|
Reference in New Issue
Block a user