From 786b3a7dd2f45934b90ac432d20271e4e469cc86 Mon Sep 17 00:00:00 2001 From: Nicolas Pouillard Date: Sun, 19 Apr 2009 10:52:39 +0200 Subject: New module: XMonad.Actions.TopicSpace Ignore-this: 4c20592ea6ca74f38545c5a1a002ef91 darcs-hash:20090419085239-eb2e9-b81c0e529e0ea8664b1ab557472df72706c9d185.gz --- XMonad/Actions/TopicSpace.hs | 331 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 331 insertions(+) create mode 100644 XMonad/Actions/TopicSpace.hs (limited to 'XMonad/Actions') diff --git a/XMonad/Actions/TopicSpace.hs b/XMonad/Actions/TopicSpace.hs new file mode 100644 index 0000000..b60114a --- /dev/null +++ b/XMonad/Actions/TopicSpace.hs @@ -0,0 +1,331 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.TopicSpace +-- Copyright : (c) Nicolas Pouillard +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Nicolas Pouillard +-- 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 + -- cgit v1.2.3