mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 11:30:22 -07:00
New module: XMonad.Actions.TopicSpace
This commit is contained in:
Nicolas Pouillard
parent
5ad49783f2
commit
0234f94be3
331
XMonad/Actions/TopicSpace.hs
Normal file
331
XMonad/Actions/TopicSpace.hs
Normal file
@ -0,0 +1,331 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- 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.
|
||||
--
|
||||
-- This module allow 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 will 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 that will be triggered
|
||||
-- when switching to a topic that does not have any windows in it. So one can
|
||||
-- attach our mail client to the mail topic, some terminals in the right
|
||||
-- directory for the xmonad topic... This package also provides a nice way to
|
||||
-- display your topics in a historical way using a custom `pprWindowSet'
|
||||
-- function. You can also easily switch to recents topics using this history
|
||||
-- of last focused topics.
|
||||
--
|
||||
-- Here is an example of configuration using TopicSpace:
|
||||
--
|
||||
-- @
|
||||
-- myTopicConfig :: TopicConfig
|
||||
-- myTopicConfig = TopicConfig
|
||||
-- { allTopics =
|
||||
-- [ \"dashboard\" -- the first one
|
||||
-- , \"admin\", \"build\", \"cleaning\", \"conf\", \"darcs\", \"haskell\", \"irc\"
|
||||
-- , \"mail\", \"movie\", \"music\", \"talk\", \"text\", \"tools\", \"web\", \"xmonad\"
|
||||
-- , \"yi\", \"documents\", \"twitter\", \"pdf\"
|
||||
-- ]
|
||||
-- , 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\"
|
||||
-- , maxTopicHistory = 10
|
||||
-- , 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)
|
||||
-- ]
|
||||
-- }
|
||||
-- @
|
||||
--
|
||||
-- @
|
||||
-- -- extend your keybindings
|
||||
-- myKeys =
|
||||
-- [ ((modMask , xK_n ), spawnShell) -- %! Launch terminal
|
||||
-- , ((modMask , xK_a ), currentTopicAction myTopicConfig)
|
||||
-- , ((modMask , xK_g ), promptedGoto)
|
||||
-- , ((modMask .|. shiftMask, xK_g ), promptedShift)
|
||||
-- ...
|
||||
-- ]
|
||||
-- ++
|
||||
-- [ ((modMask, k), switchNthLastFocused defaultTopic i)
|
||||
-- | (i, k) <- zip [1..] workspaceKeys]
|
||||
-- @
|
||||
--
|
||||
-- @
|
||||
-- spawnShell :: X ()
|
||||
-- spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
|
||||
-- @
|
||||
--
|
||||
-- @
|
||||
-- spawnShellIn :: Dir -> X ()
|
||||
-- spawnShellIn dir = spawn $ \"urxvt '(cd ''\" ++ dir ++ \"'' && \" ++ myShell ++ \" )'\"
|
||||
-- @
|
||||
--
|
||||
-- @
|
||||
-- goto :: Topic -> X ()
|
||||
-- goto = switchTopic myTopicConfig
|
||||
-- @
|
||||
--
|
||||
-- @
|
||||
-- promptedGoto :: X ()
|
||||
-- promptedGoto = workspacePrompt myXPConfig goto
|
||||
-- @
|
||||
--
|
||||
-- @
|
||||
-- promptedShift :: X ()
|
||||
-- promptedShift = workspacePrompt myXPConfig $ windows . W.shift
|
||||
-- @
|
||||
--
|
||||
-- @
|
||||
-- myConfig = do
|
||||
-- checkTopicConfig myTopicConfig
|
||||
-- myLogHook <- makeMyLogHook
|
||||
-- return $ defaultConfig
|
||||
-- { borderWidth = 1 -- Width of the window border in pixels.
|
||||
-- , workspaces = allTopics myTopicConfig
|
||||
-- , layoutHook = myModifiers myLayouts
|
||||
-- , manageHook = myManageHook
|
||||
-- , logHook = myLogHook
|
||||
-- , handleEventHook = myHandleEventHook
|
||||
-- , terminal = myTerminal -- The preferred terminal program.
|
||||
-- , normalBorderColor = \"#3f3c6d\"
|
||||
-- , focusedBorderColor = \"#4f66ff\"
|
||||
-- , XMonad.modMask = mod1Mask
|
||||
-- , keys = myKeys
|
||||
-- , mouseBindings = myMouseBindings
|
||||
-- }
|
||||
-- @
|
||||
--
|
||||
-- @
|
||||
-- main :: IO ()
|
||||
-- main = xmonad =<< myConfig
|
||||
-- @
|
||||
module XMonad.Actions.TopicSpace
|
||||
( Topic
|
||||
, Dir
|
||||
, TopicConfig(..)
|
||||
, getLastFocusedTopics
|
||||
, setLastFocusedTopic
|
||||
, pprWindowSet
|
||||
, topicActionWithPrompt
|
||||
, topicAction
|
||||
, currentTopicAction
|
||||
, switchTopic
|
||||
, switchNthLastFocused
|
||||
, currentTopicDir
|
||||
, checkTopicConfig
|
||||
, (>*>)
|
||||
)
|
||||
where
|
||||
|
||||
import XMonad
|
||||
|
||||
import Data.List
|
||||
import Data.Maybe (fromMaybe, isNothing)
|
||||
import Data.Ord
|
||||
import qualified Data.Map as M
|
||||
import Graphics.X11.Xlib
|
||||
import Control.Monad ((=<<),liftM2,when,unless,replicateM_)
|
||||
import System.IO
|
||||
import Foreign.C.String (castCCharToChar,castCharToCChar)
|
||||
|
||||
import XMonad.Operations
|
||||
import Control.Applicative ((<$>))
|
||||
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)
|
||||
|
||||
-- | 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 points to a directory.
|
||||
type Dir = FilePath
|
||||
|
||||
-- | Here is the topic space configuration area.
|
||||
data TopicConfig = TopicConfig { allTopics :: [Topic]
|
||||
-- ^ You have to give a list of topics,
|
||||
-- this must the be same list than the workspaces field 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.
|
||||
, 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 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.
|
||||
}
|
||||
|
||||
-- | 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 = getStringListProp "_XMONAD_LAST_FOCUSED_WORKSPACES"
|
||||
|
||||
-- | 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
|
||||
-- of last focused topics.
|
||||
setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X ()
|
||||
setLastFocusedTopic tg w predicate =
|
||||
getLastFocusedTopics >>=
|
||||
setStringListProp "_XMONAD_LAST_FOCUSED_WORKSPACES"
|
||||
. take (maxTopicHistory tg) . nub . (w:) . filter predicate
|
||||
|
||||
-- | 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 highlighting 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 tg (W.tag . W.workspace . W.current $ winset)
|
||||
(`notElem` empty_workspaces)
|
||||
lastWs <- getLastFocusedTopics
|
||||
let depth topic = elemIndex topic lastWs
|
||||
add_depth proj topic = proj pp $ maybe topic (((topic++":")++) . show) $ depth topic
|
||||
pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }
|
||||
sortWindows = take (maxDepth - 1) . sortBy (comparing $ fromMaybe maxDepth . depth . W.tag)
|
||||
return $ DL.pprWindowSet sortWindows urgents pp' winset
|
||||
|
||||
-- | Given a prompt configuration and a topic configuration, triggers the action associated with
|
||||
-- the topic given in prompt.
|
||||
topicActionWithPrompt :: XPConfig -> TopicConfig -> X ()
|
||||
topicActionWithPrompt xp tg = workspacePrompt xp (liftM2 (>>) (switchTopic tg) (topicAction tg))
|
||||
|
||||
-- | Given a configuration and a topic, triggers 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
|
||||
windows $ W.greedyView topic
|
||||
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 failback to the 'defaultTopic'.
|
||||
switchNthLastFocused ::TopicConfig -> Int -> X ()
|
||||
switchNthLastFocused tg depth = do
|
||||
lastWs <- getLastFocusedTopics
|
||||
switchTopic tg $ (lastWs ++ repeat (defaultTopic tg)) !! depth
|
||||
|
||||
-- | Returns the directory associated with current topic returns the empty string otherwise.
|
||||
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 duplicates topics or undefined topics.
|
||||
checkTopicConfig :: TopicConfig -> IO ()
|
||||
checkTopicConfig tg = do
|
||||
unless (null diffTopic) $ xmessage $ "Seen but missing workspaces (tags): " ++ show diffTopic
|
||||
unless (null dups) $ xmessage $ "Duplicate workspaces (tags): " ++ show dups
|
||||
where
|
||||
seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)
|
||||
dups = tags \\ nub tags
|
||||
diffTopic = seenTopics \\ sort tags
|
||||
tags = allTopics tg
|
||||
|
||||
type StringProp = String
|
||||
|
||||
withStringProp :: StringProp -> (Display -> Window -> Atom -> X a) -> X a
|
||||
withStringProp prop f =
|
||||
withDisplay $ \dpy -> do
|
||||
rootw <- asks theRoot
|
||||
a <- io $ internAtom dpy prop False
|
||||
f dpy rootw a
|
||||
|
||||
-- | Get the name of a string property and returns it as a 'Maybe'.
|
||||
getStringProp :: StringProp -> X (Maybe String)
|
||||
getStringProp prop =
|
||||
withStringProp prop $ \dpy rootw a -> do
|
||||
p <- io $ getWindowProperty8 dpy a rootw
|
||||
return $ map castCCharToChar <$> p
|
||||
|
||||
-- | Set the value of a string property.
|
||||
setStringProp :: StringProp -> String -> X ()
|
||||
setStringProp prop string =
|
||||
withStringProp prop $ \dpy rootw a ->
|
||||
io $ changeProperty8 dpy rootw a a propModeReplace $ map castCharToCChar string
|
||||
|
||||
-- | Given a property name, returns its contents as a list. It uses the empty
|
||||
-- list as default value.
|
||||
getStringListProp :: StringProp -> X [String]
|
||||
getStringListProp prop = return . maybe [] words =<< getStringProp prop
|
||||
|
||||
-- | Given a property name and a list, sets the value of this property with
|
||||
-- the list given as argument.
|
||||
setStringListProp :: StringProp -> [String] -> X ()
|
||||
setStringListProp prop = setStringProp prop . unwords
|
||||
|
||||
-- | Display the given message using the @xmessage@ program.
|
||||
xmessage :: String -> IO ()
|
||||
xmessage s = do
|
||||
h <- spawnPipe "xmessage -file -"
|
||||
hPutStr h s
|
||||
hClose h
|
||||
|
||||
@ -102,6 +102,7 @@ library
|
||||
XMonad.Actions.Submap
|
||||
XMonad.Actions.SwapWorkspaces
|
||||
XMonad.Actions.TagWindows
|
||||
XMonad.Actions.TopicSpace
|
||||
XMonad.Actions.UpdatePointer
|
||||
XMonad.Actions.Warp
|
||||
XMonad.Actions.WindowNavigation
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user