aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Actions/TopicSpace.hs
blob: 7e4bf050fdcfb7f84c611577470e7678dd843b2f (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
-----------------------------------------------------------------------------
-- |
-- 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 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.
--
-- Here is an example of configuration using TopicSpace:
--
-- @
-- -- 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\"
--   ]
-- @
--
-- @
--  myTopicConfig :: TopicConfig
--  myTopicConfig = TopicConfig
--    { 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 myTopicConfig 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 myTopics myTopicConfig
--      myLogHook <- makeMyLogHook
--      return $ defaultConfig
--           { borderWidth = 1 -- Width of the window border in pixels.
--           , workspaces = myTopics
--           , 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
  , shiftNthLastFocused
  , currentTopicDir
  , checkTopicConfig
  , (>*>)
  )
where

import XMonad

import Data.List
import Data.Maybe (fromMaybe, isNothing, listToMaybe)
import Data.Ord
import qualified Data.Map as M
import Control.Monad ((=<<),liftM2,when,unless,replicateM_)
import System.IO

import XMonad.Operations
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 XMonad.Util.StringProp(getStringListProp,setStringListProp)

-- | 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 { 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 = asks display >>= flip 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 = do
  disp <- asks display
  setStringListProp disp "_XMONAD_LAST_FOCUSED_WORKSPACES"
    . take (maxTopicHistory tg) . nub . (w:) . filter predicate =<< getLastFocusedTopics

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

-- | Shift the focused window to the Nth last focused topic, or fallback to doing nothing.
shiftNthLastFocused :: Int -> X ()
shiftNthLastFocused n = do
  ws <- fmap (listToMaybe . drop n) getLastFocusedTopics
  whenJust ws $ windows . W.shift

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