Personal tools

Xmonad/Config archive/adamvo's xmonad.hs

From HaskellWiki

< Xmonad | Config archive(Difference between revisions)
Jump to: navigation, search
m (simplify mosaic)
(Remove NamedAction stuff, it is too ugly)
Line 53: Line 53:
 
import XMonad.Prompt.Workspace(workspacePrompt)
 
import XMonad.Prompt.Workspace(workspacePrompt)
 
import XMonad.Prompt.XMonad(xmonadPrompt)
 
import XMonad.Prompt.XMonad(xmonadPrompt)
import XMonad.Util.NamedActions(sendMessage', (^++^), addDescrKeys,
 
addName, separator, spawn', submapName, subtitle, xMessage)
 
 
import XMonad.Util.Run(spawnPipe)
 
import XMonad.Util.Run(spawnPipe)
 
import Graphics.X11.Xinerama(getScreenInfo)
 
import Graphics.X11.Xinerama(getScreenInfo)
Line 70: Line 68:
 
import Data.Ratio((%))
 
import Data.Ratio((%))
 
import System.IO(IO, Handle, hPutStrLn)
 
import System.IO(IO, Handle, hPutStrLn)
  +
import XMonad.Util.EZConfig
   
 
main :: IO ()
 
main :: IO ()
Line 82: Line 81:
 
=<< getScreens
 
=<< getScreens
   
myConfig hs = addDescrKeys ((mod4Mask, xK_d), xMessage) myKeys $ defaultConfig
+
myConfig hs = let c = defaultConfig {
{ layoutHook = myLayout
+
layoutHook = myLayout
 
, focusedBorderColor = "#ff0000"
 
, focusedBorderColor = "#ff0000"
 
, terminal = "urxvt"
 
, terminal = "urxvt"
Line 95: Line 94:
 
, fmap (isInfixOf "Gran Paradiso") className --> doShift "web"
 
, fmap (isInfixOf "Gran Paradiso") className --> doShift "web"
 
]
 
]
}
+
} in additionalKeys c (myKeys c)
   
 
myXPConfig :: XPConfig
 
myXPConfig :: XPConfig
Line 114: Line 113:
 
-------------------- Keys ------------------------------------
 
-------------------- Keys ------------------------------------
 
myKeys c@(XConfig { modMask = modm }) =
 
myKeys c@(XConfig { modMask = modm }) =
[ subtitle "FloatSnap" ] ^++^
 
 
[ ((modm, xK_Left), withFocused $ snapMove L Nothing)
 
[ ((modm, xK_Left), withFocused $ snapMove L Nothing)
 
, ((modm, xK_Right), withFocused $ snapMove R Nothing)
 
, ((modm, xK_Right), withFocused $ snapMove R Nothing)
Line 123: Line 121:
 
, ((modm .|. shiftMask, xK_Up), withFocused $ snapShrink D Nothing)
 
, ((modm .|. shiftMask, xK_Up), withFocused $ snapShrink D Nothing)
 
, ((modm .|. shiftMask, xK_Down), withFocused $ snapGrow D Nothing)
 
, ((modm .|. shiftMask, xK_Down), withFocused $ snapGrow D Nothing)
] ^++^
 
   
[ subtitle "SubLayouts"
+
,((modm .|. controlMask, xK_o), withFocused $ sendMessage . UnMerge)
,((modm .|. controlMask, xK_o), addName "unmerge the current window"
+
,((modm .|. shiftMask .|. controlMask, xK_o), withFocused $ sendMessage . UnMergeAll)
$ withFocused $ sendMessage . UnMerge)
+
,((modm .|. controlMask, xK_m), withFocused $ sendMessage . MergeAll)
,((modm .|. shiftMask .|. controlMask, xK_o), addName "disband the current group"
+
,((modm .|. controlMask, xK_period), onGroup W.focusDown')
$ withFocused $ sendMessage . UnMergeAll)
+
,((modm .|. controlMask, xK_comma), onGroup W.focusUp')
,((modm .|. controlMask, xK_m), addName "make one big group"
 
$ withFocused $ sendMessage . MergeAll)
 
,((modm .|. controlMask, xK_period), addName "focus down within the group" $ onGroup W.focusDown')
 
,((modm .|. controlMask, xK_comma), addName "focus up within the group" $ onGroup W.focusUp')
 
   
, subtitle "Mosaic"
+
,((modm, xK_semicolon), sendMessage Taller)
,((modm, xK_semicolon), addName "Taller" $ sendMessage Taller)
+
,((modm, xK_o), sendMessage Wider)
,((modm, xK_o), addName "Wider" $ sendMessage Wider)
 
   
, subtitle "Submaps"
+
,((modm, xK_x), submap $ M.fromList subMaps)
,((modm, xK_x), submapName $ subMaps)
+
,((modm, xK_s), submap $ defaultSublMap c)
,((modm, xK_s), addName "send a normal action to a sublayout" $ submap $ defaultSublMap c)
 
   
, subtitle "Focus"
+
,((modm, xK_period), moveTo Next NonEmptyWS)
,((modm, xK_period), addName "view next nonempty ws" $ moveTo Next NonEmptyWS)
+
,((modm, xK_comma ), moveTo Prev NonEmptyWS)
,((modm, xK_comma ), addName "view previous nonempty ws" $ moveTo Prev NonEmptyWS)
+
,((modm .|. shiftMask, xK_period), focusDown)
,((modm .|. shiftMask, xK_period), addName "focusDown" focusDown)
+
,((modm .|. shiftMask, xK_comma ), focusUp)
,((modm .|. shiftMask, xK_comma ), addName "focusUp" focusUp)
 
   
, subtitle "TopicSpace"
+
,((modm .|. shiftMask, xK_a), currentTopicAction myTopicConfig)
,((modm .|. shiftMask, xK_a), addName "run the topic's action" $ currentTopicAction myTopicConfig)
+
,((modm, xK_a), goToSelected defaultGSConfig)
,((modm, xK_a), addName "gridselect a window" $ goToSelected defaultGSConfig)
+
,((modm, xK_Tab), switchNthLastFocused myTopicConfig 1)
,((modm, xK_Tab), addName "view the last workspace" $ switchNthLastFocused myTopicConfig 1)
+
,((modm, xK_g ), promptedGoto)
,((modm, xK_g ), addName "go to topic" promptedGoto)
 
   
, separator
+
,((modm, xK_Return), dwmpromote)
,((modm, xK_Return), addName "promote to master" $ dwmpromote)
+
,((modm .|. shiftMask, xK_Return), spawnShell)
,((modm .|. shiftMask, xK_Return), addName "terminal" spawnShell)
+
,((modm .|. shiftMask, xK_g ), promptedShift)
,((modm .|. shiftMask, xK_g ), addName "shift to topic" promptedShift)
+
,((modm, xK_q), spawn "~/.xmonad/xmonad-recomp.lhs && xmonad --restart")
,((modm, xK_q), addName "Recompile XMonad in background" $ spawn "~/.xmonad/xmonad-recomp.lhs && xmonad --restart")
+
,((modm .|. shiftMask, xK_q), spawn "xmonad --recompile && xmonad --restart")
,((modm .|. shiftMask, xK_q), addName "Force recompile XMonad" $ spawn "xmonad --recompile && xmonad --restart")
+
,((0, xK_Print), spawn "scrot")
,((0, xK_Print), addName "screenshot" $ spawn "scrot")
 
   
 
]
 
]
^++^ [subtitle "WindowNavigation"] ^++^
+
++
concatMap (\(m,(n,f)) -> lrud (modm .|. m) (\d -> addName (n ++ ' ':show d) $ f d))
+
concatMap (\(m,f) -> lrud (modm .|. m) f)
[(shiftMask, ("swap",sendMessage . Swap))
+
[(shiftMask, (sendMessage . Swap))
,(controlMask, ("pull group",sendMessage . pullGroup))
+
,(controlMask, (sendMessage . pullGroup))
,(0, ("change focus", sendMessage . Go))
+
,(0, (sendMessage . Go))
 
]
 
]
^++^ [subtitle "Media Keys"] ^++^ mediaKeys
+
++ mediaKeys ++
^++^ [subtitle "Workspaces"] ^++^
+
[((m .|. modm, key), screenWorkspace sc >>= flip whenJust (windows . f)) |
[((m .|. modm, key), addName (unwords [d,"workspace",show sc]) $ screenWorkspace sc >>= flip whenJust (windows . f)) |
+
(f, m) <- [(W.view, 0), (W.shift, shiftMask)],
(f, m, d) <- [(W.view, 0, "view"), (W.shift, shiftMask, "shift to")],
 
 
(key, sc) <- zip [xK_w, xK_f, xK_p] ([0 .. ])]
 
(key, sc) <- zip [xK_w, xK_f, xK_p] ([0 .. ])]
^++^
+
++
[ ((modm, k), addName (unwords ["view the last",show i,"topic"]) $ switchNthLastFocused myTopicConfig i)
+
[ ((modm, k), switchNthLastFocused myTopicConfig i)
 
| (i, k) <- zip [1..] [xK_1 .. xK_9]]
 
| (i, k) <- zip [1..] [xK_1 .. xK_9]]
   
Line 177: Line 174:
 
cmds = zipWith ($) (repeat cmd) [L,R,U,D]
 
cmds = zipWith ($) (repeat cmd) [L,R,U,D]
   
subMaps = [((0, xK_o), addName "run or raise prompt" $ runOrRaisePrompt myXPConfig),
+
subMaps = [((0, xK_o), runOrRaisePrompt myXPConfig),
((0, xK_p), addName "shell prompt" $ shellPrompt myXPConfig),
+
((0, xK_p), shellPrompt myXPConfig),
((0, xK_x), addName "xmonad prompt" $ xmonadPrompt myXPConfig),
+
((0, xK_x), xmonadPrompt myXPConfig),
((0, xK_z), addName "ssh prompt" $ sshPrompt myXPConfig),
+
((0, xK_z), sshPrompt myXPConfig),
((shiftMask, xK_w), addName "window gotoPrompt" $ windowPromptGoto myXPConfig),
+
((shiftMask, xK_w), windowPromptGoto myXPConfig),
((0, xK_w), addName "search wikipedia" $ promptSearch myXPConfig wikipedia),
+
((0, xK_w), promptSearch myXPConfig wikipedia),
((0, xK_s), addName "search multi" $ promptSearch myXPConfig multi),
+
((0, xK_s), promptSearch myXPConfig multi),
((0, xK_m), addName "search mathworld" $ promptSearch myXPConfig mathworld),
+
((0, xK_m), promptSearch myXPConfig mathworld),
((0, xK_d), addName "change dir" $ changeDir myXPConfig),
+
((0, xK_d), changeDir myXPConfig),
((0, xK_b), sendMessage' ToggleStruts),
+
((0, xK_b), sendMessage ToggleStruts),
((0, xK_f), addName "sink" $ withFocused $ windows . W.sink),
+
((0, xK_f), withFocused $ windows . W.sink),
((0, xK_v), addName "refresh" refresh),
+
((0, xK_v), refresh),
((0, xK_c), addName "terminal" $ asks config >>= spawnHere ?spawner . terminal),
+
((0, xK_c), asks config >>= spawnHere ?spawner . terminal),
((0, xK_k), addName "close window" kill)
+
((0, xK_k), kill)
 
]
 
]
   
 
mediaKeys = [((0, xF86XK_AudioPlay), mpcAct "toggle"),
 
mediaKeys = [((0, xF86XK_AudioPlay), mpcAct "toggle"),
((0, xF86XK_AudioStop), addName "HostPrompt" hostPrompt),
+
((0, xF86XK_AudioStop), hostPrompt),
 
((0, xF86XK_AudioNext), mpcAct "next"),
 
((0, xF86XK_AudioNext), mpcAct "next"),
 
((0, xF86XK_AudioPrev), mpcAct "prev"),
 
((0, xF86XK_AudioPrev), mpcAct "prev"),
((0, xF86XK_AudioMute), addName "toggle mute" $ spawn " -t"),
+
((0, xF86XK_AudioMute), spawn " -t"),
((shiftMask, xF86XK_AudioMute), addName "toggle external speakers" $ spawn "~/bin/speakers.sh"),
+
((shiftMask, xF86XK_AudioMute), spawn "~/bin/speakers.sh"),
((0, xF86XK_AudioLowerVolume), spawn' "ossmix vmix0-outvol -- -1"),
+
((0, xF86XK_AudioLowerVolume), spawn "ossmix vmix0-outvol -- -1"),
((shiftMask, xF86XK_AudioLowerVolume), spawn' "ossmix vmix0-outvol -- -0.1"),
+
((shiftMask, xF86XK_AudioLowerVolume), spawn "ossmix vmix0-outvol -- -0.1"),
((0, xF86XK_AudioRaiseVolume), spawn' "ossmix vmix0-outvol +1"),
+
((0, xF86XK_AudioRaiseVolume), spawn "ossmix vmix0-outvol +1"),
((shiftMask, xF86XK_AudioRaiseVolume), spawn' "ossmix vmix0-outvol +0.1"),
+
((shiftMask, xF86XK_AudioRaiseVolume), spawn "ossmix vmix0-outvol +0.1"),
((0, xF86XK_Sleep), spawn' "sudo sh -c 'echo mem > /sys/power/state'")]
+
((0, xF86XK_Sleep), spawn "sudo sh -c 'echo mem > /sys/power/state'")]
where mpcAct c = addName ("mpc " ++ c) $ do
+
where mpcAct c = do
 
h <- io $ readIORef ?mpdHost
 
h <- io $ readIORef ?mpdHost
 
spawn $ unwords ["export MPD_HOST="++h,";","mpc",c]
 
spawn $ unwords ["export MPD_HOST="++h,";","mpc",c]

Revision as of 15:53, 28 May 2009

{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}
{-# LANGUAGE ImplicitParams, NoMonomorphismRestriction #-}
module Main where
 
import XMonad
import qualified XMonad.StackSet as W
import qualified Data.Map as M
 
-- Update these with:  ghc -ddump-minimal-imports
import XMonad.Actions.CycleWS(WSType(NonEmptyWS), WSDirection(..),
                              moveTo)
import XMonad.Actions.DwmPromote(dwmpromote)
import XMonad.Actions.FloatSnap(Direction(..), snapGrow, snapMove,
                                snapShrink)
import XMonad.Actions.GridSelect(defaultGSConfig, goToSelected)
import XMonad.Actions.Search(mathworld, wikipedia, multi,
                             promptSearch)
import XMonad.Actions.SpawnOn(spawnOn, Spawner, manageSpawn,
                              mkSpawner, spawnHere)
import XMonad.Actions.Submap(submap)
import XMonad.Actions.TopicSpace(TopicConfig(..), Topic, (>*>),
                                 checkTopicConfig, currentTopicAction, currentTopicDir,
                                 pprWindowSet, switchNthLastFocused, switchTopic)
import XMonad.Hooks.DynamicLog(PP(ppSep, ppCurrent, ppHidden,
                                  ppVisible, ppLayout, ppTitle, ppUrgent),
                               dynamicLogString, defaultPP, xmobarColor, wrap)
import XMonad.Hooks.EwmhDesktops(ewmhDesktopsEventHook,
                                 ewmhDesktopsLogHook)
import XMonad.Hooks.ManageDocks(ToggleStruts(ToggleStruts),
                                avoidStruts, manageDocks)
import XMonad.Hooks.UrgencyHook(NoUrgencyHook(..), withUrgencyHook)
import XMonad.Layout.BoringWindows(boringAuto, focusDown, focusUp)
import XMonad.Layout.LayoutHints(layoutHintsToCentre)
import XMonad.Layout.Mosaic(Aspect(Wider, Taller), mosaic)
import XMonad.Layout.Named(named)
import XMonad.Layout.NoBorders(Ambiguity(Screen), lessBorders,
                               noBorders)
import XMonad.Layout.Simplest(Simplest(..))
import XMonad.Layout.SubLayouts(GroupMsg(UnMergeAll, UnMerge,
                                         MergeAll),
                                defaultSublMap, onGroup, pullGroup, subLayout)
import XMonad.Layout.Tabbed(defaultTheme, addTabs, shrinkText)
import XMonad.Layout.WindowNavigation(Navigate(Swap, Go),
                                      configurableNavigation, navigateColor)
import XMonad.Layout.WorkspaceDir(changeDir, workspaceDir)
import XMonad.Prompt(XPConfig(font), XPrompt(showXPrompt),
                     greenXPConfig, mkXPrompt)
import XMonad.Prompt.RunOrRaise(runOrRaisePrompt)
import XMonad.Prompt.Shell(shellPrompt)
import XMonad.Prompt.Ssh(sshPrompt)
import XMonad.Prompt.Window(windowPromptGoto)
import XMonad.Prompt.Workspace(workspacePrompt)
import XMonad.Prompt.XMonad(xmonadPrompt)
import XMonad.Util.Run(spawnPipe)
import Graphics.X11.Xinerama(getScreenInfo)
import Graphics.X11.ExtraTypes.XF86(xF86XK_AudioLowerVolume,
                                    xF86XK_AudioMute, xF86XK_AudioNext, xF86XK_AudioPlay,
                                    xF86XK_AudioPrev, xF86XK_AudioRaiseVolume, xF86XK_AudioStop,
                                    xF86XK_Sleep)
import Data.Map(fromList)
import Control.Monad(Monad(return, (>>=), (>>)), Functor(..),
                     (=<<), mapM, sequence, zipWithM_)
import Data.IORef(newIORef, readIORef, writeIORef)
import Data.List((++), zip, map, concatMap, repeat, zipWith, nub,
                 isPrefixOf, intercalate, isInfixOf)
import Data.Maybe(catMaybes)
import Data.Ratio((%))
import System.IO(IO, Handle, hPutStrLn)
import XMonad.Util.EZConfig
 
main :: IO ()
main = do
    sp <- mkSpawner
    mpdHost <- newIORef "localhost"
    let ?spawner = sp
        ?mpdHost = mpdHost
    checkTopicConfig myTopics myTopicConfig
    xmonad . withUrgencyHook NoUrgencyHook . myConfig
        =<< mapM xmobarScreen
        =<< getScreens
 
myConfig hs = let c = defaultConfig {
      layoutHook = myLayout
    , focusedBorderColor = "#ff0000"
    , terminal = "urxvt"
    , modMask = mod4Mask
    , logHook = ewmhDesktopsLogHook >> myLogHook hs
    , handleEventHook = ewmhDesktopsEventHook
    , workspaces = myTopics
    , manageHook = composeAll
        [ manageSpawn ?spawner
        , manageDocks
        , fmap (isInfixOf "Gran Paradiso") className  --> doShift "web"
        ]
    } in additionalKeys c (myKeys c)
 
myXPConfig :: XPConfig
myXPConfig = greenXPConfig { font = "xft:Profont:pixelsize=15:autohint=true" }
 
-------------------- Layout ----------------------------------
myLayout = workspaceDir "~" $ avoidStruts
         $ named "M" mos ||| named "F" (noBorders Full)
    where mos = lessBorders Screen
            $ addTabs shrinkText defaultTheme
            $ configurableNavigation (navigateColor "#ffff00")
            $ boringAuto
            $ subLayout [] (Simplest ||| Tall 1 (1%6) 0.5)
            $ layoutHintsToCentre
            $ mosaic 1.5 [5,4,2]
--------------------------------------------------------------
 
-------------------- Keys ------------------------------------
myKeys c@(XConfig { modMask = modm }) =
    [ ((modm,               xK_Left),  withFocused $ snapMove L Nothing)
    , ((modm,               xK_Right), withFocused $ snapMove R Nothing)
    , ((modm,               xK_Up),    withFocused $ snapMove U Nothing)
    , ((modm,               xK_Down),  withFocused $ snapMove D Nothing)
    , ((modm .|. shiftMask, xK_Left),  withFocused $ snapShrink R Nothing)
    , ((modm .|. shiftMask, xK_Right), withFocused $ snapGrow R Nothing)
    , ((modm .|. shiftMask, xK_Up),    withFocused $ snapShrink D Nothing)
    , ((modm .|. shiftMask, xK_Down),  withFocused $ snapGrow D Nothing)
 
    ,((modm .|. controlMask, xK_o), withFocused $ sendMessage . UnMerge)
    ,((modm .|. shiftMask .|. controlMask, xK_o), withFocused $ sendMessage . UnMergeAll)
    ,((modm .|. controlMask, xK_m), withFocused $ sendMessage . MergeAll)
    ,((modm .|. controlMask, xK_period), onGroup W.focusDown')
    ,((modm .|. controlMask, xK_comma), onGroup W.focusUp')
 
    ,((modm, xK_semicolon), sendMessage Taller)
    ,((modm, xK_o), sendMessage Wider)
 
    ,((modm, xK_x), submap $ M.fromList subMaps)
    ,((modm, xK_s), submap $ defaultSublMap c)
 
    ,((modm, xK_period), moveTo Next NonEmptyWS)
    ,((modm, xK_comma ), moveTo Prev NonEmptyWS)
    ,((modm .|. shiftMask, xK_period), focusDown)
    ,((modm .|. shiftMask, xK_comma ), focusUp)
 
    ,((modm .|. shiftMask, xK_a), currentTopicAction myTopicConfig)
    ,((modm, xK_a), goToSelected defaultGSConfig)
    ,((modm, xK_Tab), switchNthLastFocused myTopicConfig 1)
    ,((modm, xK_g     ), promptedGoto)
 
    ,((modm, xK_Return), dwmpromote)
    ,((modm .|. shiftMask, xK_Return), spawnShell)
    ,((modm .|. shiftMask, xK_g     ), promptedShift)
    ,((modm, xK_q), spawn "~/.xmonad/xmonad-recomp.lhs && xmonad --restart")
    ,((modm .|. shiftMask, xK_q), spawn "xmonad --recompile && xmonad --restart")
    ,((0, xK_Print),  spawn "scrot")
 
    ]
    ++
    concatMap (\(m,f) -> lrud (modm .|. m) f)
        [(shiftMask, (sendMessage . Swap))
        ,(controlMask,  (sendMessage . pullGroup))
        ,(0, (sendMessage . Go))
        ]
    ++ mediaKeys ++
    [((m .|. modm, key), screenWorkspace sc >>= flip whenJust (windows . f)) |
        (f, m) <- [(W.view, 0), (W.shift, shiftMask)],
        (key, sc) <- zip [xK_w, xK_f, xK_p] ([0 .. ])]
    ++
    [ ((modm, k), switchNthLastFocused myTopicConfig i)
    | (i, k) <- zip [1..] [xK_1 .. xK_9]]
 
-- helper for windowNavigation keys
--    note: with colemak neiu are placed where jkli are with qwerty layout
lrud :: a -> (Direction -> b) -> [((a, KeySym), b)]
lrud m cmd = zip ks cmds
    where
      ks = zip (repeat m) [xK_n,xK_i,xK_u,xK_e]
      cmds = zipWith ($) (repeat cmd) [L,R,U,D]
 
subMaps = [((0, xK_o),  runOrRaisePrompt myXPConfig),
           ((0, xK_p),  shellPrompt myXPConfig),
           ((0, xK_x), xmonadPrompt myXPConfig),
           ((0, xK_z), sshPrompt myXPConfig),
           ((shiftMask, xK_w), windowPromptGoto myXPConfig),
           ((0, xK_w), promptSearch myXPConfig wikipedia),
           ((0, xK_s), promptSearch myXPConfig multi),
           ((0, xK_m), promptSearch myXPConfig mathworld),
           ((0, xK_d), changeDir myXPConfig),
           ((0, xK_b), sendMessage ToggleStruts),
           ((0, xK_f), withFocused $ windows . W.sink),
           ((0, xK_v), refresh),
           ((0, xK_c), asks config >>= spawnHere ?spawner . terminal),
           ((0, xK_k), kill)
           ]
 
mediaKeys = [((0, xF86XK_AudioPlay), mpcAct "toggle"),
             ((0, xF86XK_AudioStop), hostPrompt),
             ((0, xF86XK_AudioNext), mpcAct "next"),
             ((0, xF86XK_AudioPrev), mpcAct "prev"),
             ((0, xF86XK_AudioMute),  spawn " -t"),
             ((shiftMask, xF86XK_AudioMute),  spawn "~/bin/speakers.sh"),
             ((0, xF86XK_AudioLowerVolume),         spawn "ossmix vmix0-outvol -- -1"),
             ((shiftMask, xF86XK_AudioLowerVolume), spawn "ossmix vmix0-outvol -- -0.1"),
             ((0, xF86XK_AudioRaiseVolume),         spawn "ossmix vmix0-outvol +1"),
             ((shiftMask, xF86XK_AudioRaiseVolume), spawn "ossmix vmix0-outvol +0.1"),
             ((0, xF86XK_Sleep), spawn "sudo sh -c 'echo mem > /sys/power/state'")]
    where mpcAct c = do
            h <- io $ readIORef ?mpdHost
            spawn $ unwords ["export MPD_HOST="++h,";","mpc",c]
 
-- Prompt for host
data HostPrompt = HostPrompt
instance XPrompt HostPrompt where showXPrompt _ = "Pick MPD Host: "
hostPrompt = mkXPrompt HostPrompt myXPConfig (return . compl) (io . writeIORef ?mpdHost)
    where compl s = nub $ filter (s `isPrefixOf`) ["localhost","dell"]
 
--------------------------------------------------------------
 
-------------------- Support for per-screen xmobars ---------
-- Some parts of this will merged into contrib sometime
getScreens :: IO [Int]
getScreens = withDisplay' $ fmap (enumFromTo 0 . pred . length) . getScreenInfo
    where withDisplay' f = do
            x <- openDisplay ""
            res <- f x
            closeDisplay x
            return res
 
-- | Output to each handle what would be seen when viewing the screen with that
-- index. If the workspace is focused use the first PP, otherwise use the
-- second PP.
multiPP :: PP -> PP -> [Handle] -> X ()
multiPP = multiPP' dynamicLogString
 
multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()
multiPP' dynlStr focusPP unfocusPP handles = do
    state <- get
    let takeLength = zipWith const
        viewWs n = put state { windowset = W.view n $ windowset state }
        focused = W.tag . W.workspace . W.current $ windowset state
        choosePP w = if w == focused then focusPP else unfocusPP
    io . zipWithM_ hPutStrLn handles
            =<< mapM (\w -> viewWs w >> dynlStr (choosePP w)) . catMaybes
            =<< mapM screenWorkspace ([0..] `takeLength` handles)
    put state
 
mergePPOutputs :: PP -> [PP -> X String] -> X String
mergePPOutputs pp = fmap (intercalate (ppSep pp)) . sequence . map ($ pp)
 
onlyTitle :: PP -> PP
onlyTitle pp = defaultPP { ppCurrent = const "", ppHidden = const "", ppVisible = const "", ppLayout = ppLayout pp, ppTitle = ppTitle pp }
 
-- | Requires a recent addition to xmobar (>0.9.2)
xmobarScreen :: Int -> IO Handle
xmobarScreen = spawnPipe . ("xmobar -x " ++) . show
 
myLogHook ::  (?spawner::Spawner) => [Handle] -> X ()
myLogHook = multiPP'
    (flip mergePPOutputs [pprWindowSet myTopicConfig,dynamicLogString . onlyTitle])
    myPP { ppTitle = xmobarColor "orange" "" }
    myPP { ppTitle = const "" }
 
myPP :: PP
myPP = defaultPP
     { ppCurrent = xmobarColor "white" ""
     , ppSep = " : "
     , ppLayout = xmobarColor "green" ""
     , ppVisible = xmobarColor "white" "" . wrap "(" ")"
     , ppUrgent = xmobarColor "red" "" . ("^"++)}
--------------------------------------------------------------
 
-------------------- X.Actions.TopicSpace --------------------
myTopics :: [Topic]
myTopics =
  [ "dashboard" -- the first one
  , "admin", "build", "cleaning", "conf", "darcs", "haskell", "irc"
  , "mail", "movie", "music", "talk", "text", "tools", "web"
  , "yi", "documents", "pdf", "xmobar", "xmonad-conf", "xmonad-newconfig", "xmonad-contrib"
  , "gtk-gnutella", "gitit"
  ]
 
myTopicConfig ::  (?spawner::Spawner) => TopicConfig
myTopicConfig = TopicConfig
  { topicDirs = M.fromList $
      [ ("conf", "conf")
      , ("dashboard", "./")
      , ("yi", "wip/dev-haskell/yi")
      , ("darcs", "wip/dev-haskell/darcs")
      , ("haskell", "haskell")
      , ("xmonad-conf", ".xmonad")
      , ("xmonad-newconfig", "wip/x11-wm/xmonad/core/xmonad-newconfig")
      , ("xmonad-contrib", "wip/x11-wm/xmonad/contrib/XMonadContrib/XMonad")
      , ("xmobar", "wip/x11-wm/xmobar")
      , ("tools", "wip/tools")
      , ("movie", "media/movie")
      , ("music", "media/music")
      , ("documents", "doc")
      , ("pdf", "ref")
      , ("gtk-gnutella", ".gtk-gnutella-downloads")
      , ("gitit", "wip/gitit")
      ]
  , defaultTopicAction = const $ spawnShell >*> 2
  , defaultTopic = "dashboard"
  , maxTopicHistory = 10
  , topicActions = M.fromList $
      [ ("haskell",    spawnShell >*> 2 >>
                       spawnShellIn "wip/dev-haskell/ghc")
      , ("xmonad-conf", spawnShellIn ".xmonad/lib/XMonad/Layout" >>
                        spawn "urxvt -e vim ~/.xmonad/xmonad.hs")
      , ("xmonad-contrib", spawnShell >*> 2)
      , ("xmonad-newconfig", spawn "urxvt -e vim ~/wip/x11-wm/xmonad/core/xmonad-newconfig/XMonad/ConfigMonad.hs")
      , ("xmobar",     spawnShellIn "wip/x11-wm/xmobar/Plugins" >*> 2)
      , ("music",      spawn "urxvt -e ncmpc" >> spawn "urxvt -e ncmpc -h 192.168.1.2")
      , ("mail",       spawn "urxvt -e mutt")
      , ("irc",        spawn "urxvt -e ssh aavogt@engage.uwaterloo.ca")
      , ("dashboard",  spawnShell)
      , ("web",        spawn "firefox")
      , ("movie",      spawnShell)
      , ("pdf",        spawn "okular >&| /dev/null")
      , ("gtk-gnutella", spawn "gtk-gnutella")
      , ("gitit", mapM_ (spawnOn ?spawner "gitit") ["firefox http://localhost:5001"] >> spawnShell)
      ]
  }
 
-- From the sample config in TopicSpace, these should probably be exported from that module
spawnShell ::  (?spawner::Spawner) => X ()
spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
 
spawnShellIn ::  (?spawner::Spawner) => [Char] -> X ()
spawnShellIn dir = asks (terminal . config) >>= \term -> spawnHere ?spawner $ "cd " ++ dir ++ " && " ++ term ++ " "
 
goto ::  (?spawner::Spawner) => Topic -> X ()
goto = switchTopic myTopicConfig
 
promptedGoto ::  (?spawner::Spawner) => X ()
promptedGoto = workspacePrompt myXPConfig goto
 
promptedShift ::  X ()
promptedShift = workspacePrompt myXPConfig  $ windows . W.shift