mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
372 lines
14 KiB
Haskell
372 lines
14 KiB
Haskell
{-# LANGUAGE DeriveDataTypeable #-}
|
|
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonad.Actions.TopicSpace
|
|
-- Copyright : (c) Nicolas Pouillard
|
|
-- License : BSD-style (see LICENSE)
|
|
--
|
|
-- Maintainer : Nicolas Pouillard <nicolas.pouillard@gmail.com>
|
|
-- Stability : unstable
|
|
-- Portability : unportable
|
|
--
|
|
-- Turns your workspaces into a more topic oriented system.
|
|
-----------------------------------------------------------------------------
|
|
|
|
module XMonad.Actions.TopicSpace
|
|
(
|
|
-- * Overview
|
|
-- $overview
|
|
|
|
-- * Usage
|
|
-- $usage
|
|
Topic
|
|
, Dir
|
|
, TopicConfig(..)
|
|
, def
|
|
, getLastFocusedTopics
|
|
, setLastFocusedTopic
|
|
, reverseLastFocusedTopics
|
|
, pprWindowSet
|
|
, topicActionWithPrompt
|
|
, topicAction
|
|
, currentTopicAction
|
|
, switchTopic
|
|
, switchNthLastFocused
|
|
, switchNthLastFocusedExclude
|
|
, shiftNthLastFocused
|
|
, currentTopicDir
|
|
, checkTopicConfig
|
|
, (>*>)
|
|
)
|
|
where
|
|
|
|
import XMonad
|
|
|
|
import Data.List
|
|
import Data.Maybe (fromMaybe, isNothing, listToMaybe, fromJust)
|
|
import Data.Ord
|
|
import qualified Data.Map as M
|
|
import Control.Applicative (liftA2)
|
|
import Control.Monad (when,unless,replicateM_)
|
|
import System.IO
|
|
|
|
import qualified XMonad.StackSet as W
|
|
|
|
import XMonad.Prompt
|
|
import XMonad.Prompt.Workspace
|
|
|
|
import XMonad.Hooks.UrgencyHook
|
|
import XMonad.Hooks.DynamicLog (PP(..))
|
|
import qualified XMonad.Hooks.DynamicLog as DL
|
|
|
|
import XMonad.Util.Run (spawnPipe)
|
|
import qualified XMonad.Util.ExtensibleState as XS
|
|
|
|
-- $overview
|
|
-- This module allows to organize your workspaces on a precise topic basis. So
|
|
-- instead of having a workspace called `work' you can setup one workspace per
|
|
-- task. Here we call these workspaces, topics. The great thing with
|
|
-- topics is that one can attach a directory that makes sense to each
|
|
-- particular topic. One can also attach an action which will be triggered
|
|
-- when switching to a topic that does not have any windows in it. So you can
|
|
-- attach your mail client to the mail topic, some terminals in the right
|
|
-- directory to the xmonad topic... This package also provides a nice way to
|
|
-- display your topics in an historical way using a custom `pprWindowSet'
|
|
-- function. You can also easily switch to recent topics using this history
|
|
-- of last focused topics.
|
|
|
|
-- $usage
|
|
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
|
--
|
|
-- > import qualified Data.Map as M
|
|
-- > import qualified XMonad.StackSet as W
|
|
-- >
|
|
-- > import XMonad.Actions.TopicSpace
|
|
--
|
|
-- You will then have to
|
|
--
|
|
-- * Define new a new 'TopicConfig'
|
|
--
|
|
-- * Add the appropriate keybindings
|
|
--
|
|
-- * Replace the @workspaces@ field in your 'XConfig' with a list of your
|
|
-- topics names
|
|
--
|
|
-- Let us go through a full example together. Given the following topic names
|
|
--
|
|
-- > -- The list of all topics/workspaces of your xmonad configuration.
|
|
-- > -- The order is important, new topics must be inserted
|
|
-- > -- at the end of the list if you want hot-restarting
|
|
-- > -- to work.
|
|
-- > myTopics :: [Topic]
|
|
-- > myTopics =
|
|
-- > [ "dashboard" -- the first one
|
|
-- > , "admin", "build", "cleaning", "conf", "darcs", "haskell", "irc"
|
|
-- > , "mail", "movie", "music", "talk", "text", "tools", "web", "xmonad"
|
|
-- > , "yi", "documents", "twitter", "pdf"
|
|
-- > ]
|
|
--
|
|
-- we can define a 'TopicConfig' like this
|
|
--
|
|
-- > myTopicConfig :: TopicConfig
|
|
-- > myTopicConfig = def
|
|
-- > { topicDirs = M.fromList $
|
|
-- > [ ("conf", "w/conf")
|
|
-- > , ("dashboard", "Desktop")
|
|
-- > , ("yi", "w/dev-haskell/yi")
|
|
-- > , ("darcs", "w/dev-haskell/darcs")
|
|
-- > , ("haskell", "w/dev-haskell")
|
|
-- > , ("xmonad", "w/dev-haskell/xmonad")
|
|
-- > , ("tools", "w/tools")
|
|
-- > , ("movie", "Movies")
|
|
-- > , ("talk", "w/talks")
|
|
-- > , ("music", "Music")
|
|
-- > , ("documents", "w/documents")
|
|
-- > , ("pdf", "w/documents")
|
|
-- > ]
|
|
-- > , defaultTopicAction = const $ spawnShell >*> 3
|
|
-- > , defaultTopic = "dashboard"
|
|
-- > , topicActions = M.fromList $
|
|
-- > [ ("conf", spawnShell >> spawnShellIn "wd/ertai/private")
|
|
-- > , ("darcs", spawnShell >*> 3)
|
|
-- > , ("yi", spawnShell >*> 3)
|
|
-- > , ("haskell", spawnShell >*> 2 >>
|
|
-- > spawnShellIn "wd/dev-haskell/ghc")
|
|
-- > , ("xmonad", spawnShellIn "wd/x11-wm/xmonad" >>
|
|
-- > spawnShellIn "wd/x11-wm/xmonad/contrib" >>
|
|
-- > spawnShellIn "wd/x11-wm/xmonad/utils" >>
|
|
-- > spawnShellIn ".xmonad" >>
|
|
-- > spawnShellIn ".xmonad")
|
|
-- > , ("mail", mailAction)
|
|
-- > , ("irc", ssh somewhere)
|
|
-- > , ("admin", ssh somewhere >>
|
|
-- > ssh nowhere)
|
|
-- > , ("dashboard", spawnShell)
|
|
-- > , ("twitter", spawnShell)
|
|
-- > , ("web", spawn browserCmd)
|
|
-- > , ("movie", spawnShell)
|
|
-- > , ("documents", spawnShell >*> 2 >>
|
|
-- > spawnShellIn "Documents" >*> 2)
|
|
-- > , ("pdf", spawn pdfViewerCmd)
|
|
-- > ]
|
|
-- > }
|
|
--
|
|
-- Above we have used the `spawnShell` and `spawnShellIn` helper functions; here
|
|
-- they are:
|
|
--
|
|
-- > spawnShell :: X ()
|
|
-- > spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
|
|
-- >
|
|
-- > spawnShellIn :: Dir -> X ()
|
|
-- > spawnShellIn dir = spawn $ "urxvt '(cd ''" ++ dir ++ "'' && " ++ myShell ++ " )'"
|
|
-- > -- Some terminals support a working-directory option directly:
|
|
-- > -- spawnShellIn dir = spawn $ "alacritty --working-directory " ++ dir
|
|
--
|
|
-- Next, we define some other other useful helper functions. Note that some of
|
|
-- these function make use of the 'workspacePrompt' function. You will also
|
|
-- have to have an already defined 'XPConfig' (here called @myXPConfig@).
|
|
--
|
|
-- > goto :: Topic -> X ()
|
|
-- > goto = switchTopic myTopicConfig
|
|
-- >
|
|
-- > promptedGoto :: X ()
|
|
-- > promptedGoto = workspacePrompt myXPConfig goto
|
|
-- >
|
|
-- > promptedShift :: X ()
|
|
-- > promptedShift = workspacePrompt myXPConfig $ windows . W.shift
|
|
-- >
|
|
-- > -- Toggle between the two most recently used topics while filtering
|
|
-- > -- out the scratchpad topic.
|
|
-- > toggleTopic :: X ()
|
|
-- > toggleTopic = switchNthLastFocusedExclude ["NSP"] myTopicConfig 1
|
|
--
|
|
-- Hopefully you've gotten a general feeling of how to define these kind of
|
|
-- small helper functions using what's provided in this module.
|
|
--
|
|
-- Adding the appropriate keybindings works as it normally would:
|
|
--
|
|
-- > -- extend your keybindings
|
|
-- > myKeys conf@XConfig{modMask=modm} =
|
|
-- > [ ((modm , xK_n ), spawnShell) -- %! Launch terminal
|
|
-- > , ((modm , xK_a ), currentTopicAction myTopicConfig)
|
|
-- > , ((modm , xK_g ), promptedGoto)
|
|
-- > , ((modm .|. shiftMask, xK_g ), promptedShift)
|
|
-- > , ((modm .|. shiftMask, xK_space ), toggleTopic)
|
|
-- > {- more keys ... -}
|
|
-- > ]
|
|
-- > ++
|
|
-- > -- Switching to recently used topics
|
|
-- > [ ((modm, k), switchNthLastFocused myTopicConfig i)
|
|
-- > | (i, k) <- zip [1..] workspaceKeys]
|
|
--
|
|
-- If you want a more "default" experience with regards to @M-1@ through @M-9@
|
|
-- (i.e. switch to the first nine topics in `myTopics` instead of switching to
|
|
-- the last used ones), you can replace the last list above with the following
|
|
-- (using "EZConfig" syntax):
|
|
--
|
|
-- > -- The following does two things:
|
|
-- > -- 1. Switch topics (no modifier)
|
|
-- > -- 2. Move focused window to topic N (shift modifier)
|
|
-- > [ ("M-" ++ m ++ k, f i)
|
|
-- > | (i, k) <- zip myTopics (map show [1 .. 9 :: Int])
|
|
-- > , (f, m) <- [(goto, ""), (windows . W.shift, "S-")]
|
|
-- > ]
|
|
--
|
|
-- We can now put the whole configuration together with the following (while
|
|
-- also checking that we haven't made any mistakes):
|
|
--
|
|
-- > myConfig = do
|
|
-- > checkTopicConfig myTopics myTopicConfig
|
|
-- > return $ def
|
|
-- > { workspaces = myTopics
|
|
-- > , keys = myKeys
|
|
-- > }
|
|
-- >
|
|
-- > main :: IO ()
|
|
-- > main = xmonad =<< myConfig
|
|
|
|
-- | An alias for @flip replicateM_@
|
|
(>*>) :: Monad m => m a -> Int -> m ()
|
|
(>*>) = flip replicateM_
|
|
infix >*>
|
|
|
|
-- | 'Topic' is just an alias for 'WorkspaceId'
|
|
type Topic = WorkspaceId
|
|
|
|
-- | 'Dir' is just an alias for 'FilePath' but should point to a directory.
|
|
type Dir = FilePath
|
|
|
|
-- | Here is the topic space configuration area.
|
|
data TopicConfig = TopicConfig { topicDirs :: M.Map Topic Dir
|
|
-- ^ This mapping associate a directory to each topic.
|
|
, topicActions :: M.Map Topic (X ())
|
|
-- ^ This mapping associate an action to trigger when
|
|
-- switching to a given topic which workspace is empty.
|
|
, defaultTopicAction :: Topic -> X ()
|
|
-- ^ This is the default topic action.
|
|
, defaultTopic :: Topic
|
|
-- ^ This is the default (= fallback) topic.
|
|
, maxTopicHistory :: Int
|
|
-- ^ This setups the maximum depth of topic history, usually
|
|
-- 10 is a good default since we can bind all of them using
|
|
-- numeric keypad.
|
|
}
|
|
|
|
instance Default TopicConfig where
|
|
def = TopicConfig { topicDirs = M.empty
|
|
, topicActions = M.empty
|
|
, defaultTopicAction = const (ask >>= spawn . terminal . config)
|
|
, defaultTopic = "1"
|
|
, maxTopicHistory = 10
|
|
}
|
|
|
|
newtype PrevTopics = PrevTopics { getPrevTopics :: [String] } deriving (Read,Show,Typeable)
|
|
instance ExtensionClass PrevTopics where
|
|
initialValue = PrevTopics []
|
|
extensionType = PersistentExtension
|
|
|
|
-- | Return the (possibly empty) list of last focused topics.
|
|
getLastFocusedTopics :: X [String]
|
|
getLastFocusedTopics = XS.gets getPrevTopics
|
|
|
|
-- | Given a 'TopicConfig', a topic, and a predicate to select topics that one
|
|
-- wants to keep, this function will filter the list of last focused topics
|
|
-- according to the predicate and cons the topic in front of that list.
|
|
setLastFocusedTopic :: Topic -> (Topic -> Bool) -> X ()
|
|
setLastFocusedTopic w predicate =
|
|
XS.modify $ PrevTopics
|
|
. seqList . nub . (w:) . filter predicate
|
|
. getPrevTopics
|
|
where seqList xs = length xs `seq` xs
|
|
|
|
-- | Reverse the list of "last focused topics"
|
|
reverseLastFocusedTopics :: X ()
|
|
reverseLastFocusedTopics =
|
|
XS.modify $ PrevTopics . reverse . getPrevTopics
|
|
|
|
-- | 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 highlight topics with urgent windows.
|
|
pprWindowSet :: TopicConfig -> PP -> X String
|
|
pprWindowSet tg pp = do
|
|
winset <- gets windowset
|
|
urgents <- readUrgents
|
|
let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset
|
|
maxDepth = maxTopicHistory tg
|
|
setLastFocusedTopic (W.tag . W.workspace . W.current $ winset)
|
|
(`notElem` empty_workspaces)
|
|
lastWs <- getLastFocusedTopics
|
|
let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic])
|
|
add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic
|
|
pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }
|
|
sortWindows = take maxDepth . sortBy (comparing $ depth . W.tag)
|
|
return $ DL.pprWindowSet sortWindows urgents pp' winset
|
|
|
|
-- | Given a prompt configuration and a topic configuration, trigger the action associated with
|
|
-- the topic given in prompt.
|
|
topicActionWithPrompt :: XPConfig -> TopicConfig -> X ()
|
|
topicActionWithPrompt xp tg = workspacePrompt xp (liftA2 (>>) (switchTopic tg) (topicAction tg))
|
|
|
|
-- | Given a configuration and a topic, trigger the action associated with the given topic.
|
|
topicAction :: TopicConfig -> Topic -> X ()
|
|
topicAction tg topic = fromMaybe (defaultTopicAction tg topic) $ M.lookup topic $ topicActions tg
|
|
|
|
-- | Trigger the action associated with the current topic.
|
|
currentTopicAction :: TopicConfig -> X ()
|
|
currentTopicAction tg = topicAction tg =<< gets (W.tag . W.workspace . W.current . windowset)
|
|
|
|
-- | Switch to the given topic.
|
|
switchTopic :: TopicConfig -> Topic -> X ()
|
|
switchTopic tg topic = do
|
|
-- Switch to topic and add it to the last seen topics
|
|
windows $ W.greedyView topic
|
|
setLastFocusedTopic topic (const True)
|
|
|
|
-- If applicable, execute the topic action
|
|
wins <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset)
|
|
when (null wins) $ topicAction tg topic
|
|
|
|
-- | Switch to the Nth last focused topic or fall back to the 'defaultTopic'.
|
|
switchNthLastFocused :: TopicConfig -> Int -> X ()
|
|
switchNthLastFocused = switchNthLastFocusedExclude []
|
|
|
|
-- | Like 'switchNthLastFocused', but also filter out certain topics.
|
|
switchNthLastFocusedExclude :: [Topic] -> TopicConfig -> Int -> X ()
|
|
switchNthLastFocusedExclude excludes tc depth = do
|
|
lastWs <- filter (`notElem` excludes) <$> getLastFocusedTopics
|
|
switchTopic tc $ (lastWs ++ repeat (defaultTopic tc)) !! depth
|
|
|
|
-- | Shift the focused window to the Nth last focused topic, or fall back to doing nothing.
|
|
shiftNthLastFocused :: Int -> X ()
|
|
shiftNthLastFocused n = do
|
|
ws <- fmap (listToMaybe . drop n) getLastFocusedTopics
|
|
whenJust ws $ windows . W.shift
|
|
|
|
-- | Return the directory associated with the current topic, or return the empty
|
|
-- string if the topic could not be found.
|
|
currentTopicDir :: TopicConfig -> X String
|
|
currentTopicDir tg = do
|
|
topic <- gets (W.tag . W.workspace . W.current . windowset)
|
|
return . fromMaybe "" . M.lookup topic $ topicDirs tg
|
|
|
|
-- | Check the given topic configuration for duplicate or undefined topics.
|
|
checkTopicConfig :: [Topic] -> TopicConfig -> IO ()
|
|
checkTopicConfig tags tg = do
|
|
-- tags <- gets $ map W.tag . workspaces . windowset
|
|
|
|
let
|
|
seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)
|
|
dups = tags \\ nub tags
|
|
diffTopic = seenTopics \\ sort tags
|
|
check lst msg = unless (null lst) $ xmessage $ msg ++ " (tags): " ++ show lst
|
|
|
|
check diffTopic "Seen but missing topics/workspaces"
|
|
check dups "Duplicate topics/workspaces"
|
|
|
|
-- | Display the given message using the @xmessage@ program.
|
|
xmessage :: String -> IO ()
|
|
xmessage s = do
|
|
h <- spawnPipe "xmessage -file -"
|
|
hPutStr h s
|
|
hClose h
|