aboutsummaryrefslogblamecommitdiffstats
path: root/XMonad/Actions/TopicSpace.hs
blob: b60114ae087cb1f8517a8b4cfc16e11ff8e7109a (plain) (tree)










































































































































































































































































































































                                                                                                   
-----------------------------------------------------------------------------
-- |
-- 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