Personal tools

Xmonad/Config archive/adamvo's xmonad.hs

From HaskellWiki

< Xmonad | Config archive(Difference between revisions)
Jump to: navigation, search
(use implicit parameters to pass spawner ioref around)
(use FloatSnap)
Line 1: Line 1:
 
<haskell>
 
<haskell>
 
{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}
 
{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}
{-# LANGUAGE ImplicitParams #-}
+
{-# LANGUAGE ImplicitParams, NoMonomorphismRestriction #-}
 
module Main where
 
module Main where
   
 
import XMonad
 
import XMonad
import Graphics.X11.ExtraTypes.XF86
 
 
 
import qualified XMonad.StackSet as W
 
import qualified XMonad.StackSet as W
 
import qualified Data.Map as M
 
import qualified Data.Map as M
   
 
-- Update these with: ghc -ddump-minimal-imports
 
-- Update these with: ghc -ddump-minimal-imports
import XMonad.Layout.LayoutHints(layoutHints2) -- not in contrib
 
 
import XMonad.Util.NamedActions -- not pushed yet
 
 
import Graphics.X11.Xinerama(getScreenInfo)
 
import Control.Monad(Monad(return, (>>), (>>=)), Functor(..),
 
(=<<), mapM, sequence, zipWithM_)
 
import Control.Applicative((<$>))
 
import Data.List((++), zip, map, concatMap, repeat, zipWith,
 
isPrefixOf, nub, intercalate, isInfixOf)
 
import Data.Maybe(catMaybes, maybeToList)
 
import Data.Ratio((%))
 
import System.IO(IO, Handle, hPutStrLn)
 
import Data.Map(M.fromList)
 
 
import XMonad.Actions.CycleWS(WSType(NonEmptyWS), WSDirection(..),
 
import XMonad.Actions.CycleWS(WSType(NonEmptyWS), WSDirection(..),
moveTo, nextWS, prevWS, shiftToNext, shiftToPrev)
+
moveTo)
 
import XMonad.Actions.DwmPromote(dwmpromote)
 
import XMonad.Actions.DwmPromote(dwmpromote)
  +
import XMonad.Actions.FloatSnap(Direction(..), snapGrow, snapMove,
  +
snapShrink)
 
import XMonad.Actions.GridSelect(defaultGSConfig, goToSelected)
 
import XMonad.Actions.GridSelect(defaultGSConfig, goToSelected)
 
import XMonad.Actions.Search(mathworld, wikipedia, multi,
 
import XMonad.Actions.Search(mathworld, wikipedia, multi,
 
promptSearch)
 
promptSearch)
  +
import XMonad.Actions.SpawnOn(spawnOn, Spawner, manageSpawn,
  +
mkSpawner, spawnHere)
 
import XMonad.Actions.Submap(submap)
 
import XMonad.Actions.Submap(submap)
import XMonad.Actions.TopicSpace(TopicConfig(..), Topic,
+
import XMonad.Actions.TopicSpace(TopicConfig(..), Topic, (>*>),
(>*>), checkTopicConfig, currentTopicAction, currentTopicDir,
+
checkTopicConfig, currentTopicAction, currentTopicDir,
pprWindowSet, switchNthLastFocused, switchTopic,
+
pprWindowSet, switchNthLastFocused, switchTopic)
getStringProp, setStringProp)
+
import XMonad.Hooks.DynamicLog(PP(ppSep, ppCurrent, ppHidden,
import XMonad.Hooks.DynamicLog(PP(ppUrgent, ppTitle, ppLayout,
+
ppVisible, ppLayout, ppTitle, ppUrgent),
ppVisible, ppHidden, ppCurrent, ppSep),
 
 
dynamicLogString, defaultPP, xmobarColor, wrap)
 
dynamicLogString, defaultPP, xmobarColor, wrap)
 
import XMonad.Hooks.EwmhDesktops(ewmhDesktopsEventHook,
 
import XMonad.Hooks.EwmhDesktops(ewmhDesktopsEventHook,
Line 43: Line 31:
 
avoidStruts, manageDocks)
 
avoidStruts, manageDocks)
 
import XMonad.Hooks.UrgencyHook(NoUrgencyHook(..), withUrgencyHook)
 
import XMonad.Hooks.UrgencyHook(NoUrgencyHook(..), withUrgencyHook)
import XMonad.Layout.BoringWindows(boringWindows, focusDown,
+
import XMonad.Layout.BoringWindows(boringAuto, focusDown, focusUp)
focusUp)
+
import XMonad.Layout.LayoutHints(layoutHintsToCentre)
import XMonad.Layout.Mosaic(Mosaic(..),
+
import XMonad.Layout.Mosaic(Aspect(Wider, Taller), mosaic)
Aspect(..))
 
 
import XMonad.Layout.Named(named)
 
import XMonad.Layout.Named(named)
import XMonad.Layout.NoBorders(Ambiguity(Screen), lessBorders, noBorders)
+
import XMonad.Layout.NoBorders(Ambiguity(Screen), lessBorders,
  +
noBorders)
 
import XMonad.Layout.Simplest(Simplest(..))
 
import XMonad.Layout.Simplest(Simplest(..))
 
import XMonad.Layout.SubLayouts(GroupMsg(UnMergeAll, UnMerge,
 
import XMonad.Layout.SubLayouts(GroupMsg(UnMergeAll, UnMerge,
Line 53: Line 41:
 
defaultSublMap, onGroup, pullGroup, subLayout)
 
defaultSublMap, onGroup, pullGroup, subLayout)
 
import XMonad.Layout.Tabbed(defaultTheme, addTabs, shrinkText)
 
import XMonad.Layout.Tabbed(defaultTheme, addTabs, shrinkText)
import XMonad.Layout.WindowNavigation(Direction(..),
+
import XMonad.Layout.WindowNavigation(Navigate(Swap, Go),
Navigate(Swap, Go), configurableNavigation, navigateColor)
+
configurableNavigation, navigateColor)
 
import XMonad.Layout.WorkspaceDir(changeDir, workspaceDir)
 
import XMonad.Layout.WorkspaceDir(changeDir, workspaceDir)
import XMonad.Prompt(XPrompt(..),XPConfig(..),greenXPConfig,mkXPrompt)
+
import XMonad.Prompt(XPConfig(font), XPrompt(showXPrompt),
  +
greenXPConfig, mkXPrompt)
 
import XMonad.Prompt.RunOrRaise(runOrRaisePrompt)
 
import XMonad.Prompt.RunOrRaise(runOrRaisePrompt)
 
import XMonad.Prompt.Shell(shellPrompt)
 
import XMonad.Prompt.Shell(shellPrompt)
Line 63: Line 51:
 
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 XMonad.Actions.SpawnOn
+
import Graphics.X11.ExtraTypes.XF86(xF86XK_AudioLowerVolume,
+
xF86XK_AudioMute, xF86XK_AudioNext, xF86XK_AudioPlay,
-- import XMonad.Layout.Manual
+
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)
   
 
main :: IO ()
 
main :: IO ()
 
main = do
 
main = do
 
sp <- mkSpawner
 
sp <- mkSpawner
  +
mpdHost <- newIORef "localhost"
 
let ?spawner = sp
 
let ?spawner = sp
  +
?mpdHost = mpdHost
 
checkTopicConfig myTopics myTopicConfig
 
checkTopicConfig myTopics myTopicConfig
 
xmonad . withUrgencyHook NoUrgencyHook . myConfig
 
xmonad . withUrgencyHook NoUrgencyHook . myConfig
Line 84: Line 76:
 
, modMask = mod4Mask
 
, modMask = mod4Mask
 
, logHook = ewmhDesktopsLogHook >> myLogHook hs
 
, logHook = ewmhDesktopsLogHook >> myLogHook hs
, startupHook = refresh -- help avoidStruts
 
 
, handleEventHook = ewmhDesktopsEventHook
 
, handleEventHook = ewmhDesktopsEventHook
 
, workspaces = myTopics
 
, workspaces = myTopics
Line 93: Line 84:
 
]
 
]
 
}
 
}
-- where ?spawner = ?spawner
 
   
 
myXPConfig :: XPConfig
 
myXPConfig :: XPConfig
Line 99: Line 89:
   
 
-------------------- Layout ----------------------------------
 
-------------------- Layout ----------------------------------
myLayout = workspaceDir "~"
+
myLayout = workspaceDir "~" $ avoidStruts
$ named "M" mosaic ||| named "F" (noBorders Full)
+
$ named "M" mos ||| named "F" (noBorders Full)
where
+
where mos = lessBorders Screen
mosaic = avoidStruts
+
$ addTabs shrinkText defaultTheme
$ lessBorders Screen
+
$ configurableNavigation (navigateColor "#ffff00")
$ addTabs shrinkText defaultTheme
+
$ boringAuto
$ configurableNavigation (navigateColor "#ffff00")
+
$ subLayout [] (Simplest ||| Tall 1 (1%6) 0.5)
$ boringWindows
+
$ layoutHintsToCentre
$ subLayout [] (Simplest ||| Tall 1 (1%6) 0.5)
+
$ mosaic 1.5 [5,4,2,1,1,1]
$ layoutHints2 -- unfinished modifications to layoutHints: ask if you want this
 
$ Mosaic [5,4,2,1,1,1]
 
-- $ manual 0.5
 
 
 
--------------------------------------------------------------
 
--------------------------------------------------------------
   
 
-------------------- Keys ------------------------------------
 
-------------------- Keys ------------------------------------
myKeys :: (?spawner::Spawner) =>XConfig t -> [((KeyMask, KeySym), NamedAction)]
 
 
myKeys c@(XConfig { modMask = modm }) =
 
myKeys c@(XConfig { modMask = modm }) =
[ subtitle "Resizing"
+
[ subtitle "FloatSnap" ] ^++^
,((modm, xK_h), addName "Shrink" $ sendMessage . SlopeMod $ zipWith (+) (map (/5) [1..]))
+
[ ((modm, xK_Left), withFocused $ snapMove L Nothing)
,((modm, xK_l), addName "Expand" $ sendMessage . SlopeMod $ (\(x:xs) -> max 1 x:xs) . map (max 0.05) . zipWith subtract (map (/5) [1..]))
+
, ((modm, xK_Right), withFocused $ snapMove R Nothing)
,((modm .|. shiftMask, xK_h), addName "Show Less Windows" $ sendMessage $ SlopeMod init)
+
, ((modm, xK_Up), withFocused $ snapMove U Nothing)
,((modm .|. shiftMask, xK_l), addName "Show More Windows" $ sendMessage $ SlopeMod (++[1]))
+
, ((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)
  +
] ^++^
   
, subtitle "SubLayouts"
+
[ subtitle "SubLayouts"
 
,((modm .|. controlMask, xK_o), addName "unmerge the current window"
 
,((modm .|. controlMask, xK_o), addName "unmerge the current window"
 
$ withFocused $ sendMessage . UnMerge)
 
$ withFocused $ sendMessage . UnMerge)
Line 138: Line 127:
   
 
, subtitle "Focus"
 
, subtitle "Focus"
,((modm .|. shiftMask, xK_Right), addName "slide to the next ws" $ shiftToNext >> nextWS)
 
,((modm .|. shiftMask, xK_Left ), addName "slide to the previous ws" $ shiftToPrev >> prevWS)
 
,((modm, xK_Right ), addName "view next nonempty ws" $ moveTo Next NonEmptyWS)
 
,((modm, xK_Left ), addName "view previous nonempty ws" $ moveTo Prev NonEmptyWS)
 
 
,((modm, xK_period), addName "view next nonempty ws" $ moveTo Next NonEmptyWS)
 
,((modm, xK_period), addName "view next nonempty ws" $ moveTo Next NonEmptyWS)
 
,((modm, xK_comma ), addName "view previous nonempty ws" $ moveTo Prev NonEmptyWS)
 
,((modm, xK_comma ), addName "view previous nonempty ws" $ moveTo Prev NonEmptyWS)
Line 185: Line 170:
 
cmds = zipWith ($) (repeat cmd) [L,R,U,D]
 
cmds = zipWith ($) (repeat cmd) [L,R,U,D]
   
subMaps :: (?spawner::Spawner) => [((KeyMask, KeySym), NamedAction)]
 
 
subMaps = [((0, xK_o), addName "run or raise prompt" $ runOrRaisePrompt myXPConfig),
 
subMaps = [((0, xK_o), addName "run or raise prompt" $ runOrRaisePrompt myXPConfig),
 
((0, xK_p), addName "shell prompt" $ shellPrompt myXPConfig),
 
((0, xK_p), addName "shell prompt" $ shellPrompt myXPConfig),
Line 202: Line 186:
 
]
 
]
   
mediaKeys :: [((KeyMask, KeySym), NamedAction)]
 
 
mediaKeys = [((0, xF86XK_AudioPlay), mpcAct "toggle"),
 
mediaKeys = [((0, xF86XK_AudioPlay), mpcAct "toggle"),
((shiftMask, xF86XK_AudioPlay), addName "HostPrompt" hostPrompt),
+
((0, xF86XK_AudioStop), addName "HostPrompt" hostPrompt),
((0, xF86XK_AudioStop), mpcAct "stop"),
 
((0, xF86XK_Forward), mpcAct "next"),
 
((0, xF86XK_Back), mpcAct "prev"),
 
 
((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 "~/bin/ossvol -t"),
+
((0, xF86XK_AudioMute), addName "toggle mute" $ spawn " -t"),
 
((shiftMask, xF86XK_AudioMute), addName "toggle external speakers" $ spawn "~/bin/speakers.sh"),
 
((shiftMask, xF86XK_AudioMute), addName "toggle external speakers" $ spawn "~/bin/speakers.sh"),
((0, xF86XK_AudioLowerVolume), spawn' "~/bin/ossvol -d 1"),
+
((0, xF86XK_AudioLowerVolume), spawn' "ossmix vmix0-outvol -- -1"),
((shiftMask, xF86XK_AudioLowerVolume), spawn' "~/bin/ossvol -d 0.1"),
+
((shiftMask, xF86XK_AudioLowerVolume), spawn' "ossmix vmix0-outvol -- -0.1"),
((0, xF86XK_AudioRaiseVolume), spawn' "~/bin/ossvol -i 1"),
+
((0, xF86XK_AudioRaiseVolume), spawn' "ossmix vmix0-outvol +1"),
((shiftMask, xF86XK_AudioRaiseVolume), spawn' "~/bin/ossvol -i 0.1"),
+
((shiftMask, xF86XK_AudioRaiseVolume), spawn' "ossmix vmix0-outvol +0.1"),
((0, xF86XK_Sleep), spawn' "sudo pm-suspend"),
+
((0, xF86XK_Sleep), spawn' "sudo sh -c 'echo mem > /sys/power/state'")]
((shiftMask, xF86XK_Sleep), spawn' "sudo pm-hibernate")]
 
 
where mpcAct c = addName ("mpc " ++ c) $ do
 
where mpcAct c = addName ("mpc " ++ c) $ do
p <- maybeToList . fmap ("export MPD_HOST=" `wrap` ";") <$> getStringProp "MPD_HOST"
+
h <- io $ readIORef ?mpdHost
spawn . unwords $ p ++ ["mpc",c]
+
spawn $ unwords ["export MPD_HOST="++h,";","mpc",c]
   
 
-- Prompt for host
 
-- Prompt for host
 
data HostPrompt = HostPrompt
 
data HostPrompt = HostPrompt
 
instance XPrompt HostPrompt where showXPrompt _ = "Pick MPD Host: "
 
instance XPrompt HostPrompt where showXPrompt _ = "Pick MPD Host: "
hostPrompt = mkXPrompt HostPrompt myXPConfig (return . compl) (setStringProp "MPD_HOST")
+
hostPrompt = mkXPrompt HostPrompt myXPConfig (return . compl) (io . writeIORef ?mpdHost)
 
where compl s = nub $ filter (s `isPrefixOf`) ["localhost","dell"]
 
where compl s = nub $ filter (s `isPrefixOf`) ["localhost","dell"]
   
Line 260: Line 243:
 
onlyTitle pp = defaultPP { ppCurrent = const "", ppHidden = const "", ppVisible = const "", ppLayout = ppLayout pp, ppTitle = ppTitle pp }
 
onlyTitle pp = defaultPP { ppCurrent = const "", ppHidden = const "", ppVisible = const "", ppLayout = ppLayout pp, ppTitle = ppTitle pp }
   
-- | Requires a recent addition to xmobar (newer than 0.9.2)
+
-- | Requires a recent addition to xmobar (>0.9.2)
 
xmobarScreen :: Int -> IO Handle
 
xmobarScreen :: Int -> IO Handle
 
xmobarScreen = spawnPipe . ("xmobar -x " ++) . show
 
xmobarScreen = spawnPipe . ("xmobar -x " ++) . show
Line 286: Line 269:
 
, "mail", "movie", "music", "talk", "text", "tools", "web"
 
, "mail", "movie", "music", "talk", "text", "tools", "web"
 
, "yi", "documents", "pdf", "xmobar", "xmonad-conf", "xmonad-newconfig", "xmonad-contrib"
 
, "yi", "documents", "pdf", "xmobar", "xmonad-conf", "xmonad-newconfig", "xmonad-contrib"
, "gtk-gnutella"
+
, "gtk-gnutella", "gitit"
 
]
 
]
   
Line 307: Line 290:
 
, ("pdf", "ref")
 
, ("pdf", "ref")
 
, ("gtk-gnutella", ".gtk-gnutella-downloads")
 
, ("gtk-gnutella", ".gtk-gnutella-downloads")
  +
, ("gitit", "wip/gitit")
 
]
 
]
 
, defaultTopicAction = const $ spawnShell >*> 2
 
, defaultTopicAction = const $ spawnShell >*> 2
Line 327: Line 311:
 
, ("pdf", spawn "okular >&| /dev/null")
 
, ("pdf", spawn "okular >&| /dev/null")
 
, ("gtk-gnutella", spawn "gtk-gnutella")
 
, ("gtk-gnutella", spawn "gtk-gnutella")
  +
, ("gitit", mapM_ (spawnOn ?spawner "gitit") ["firefox http://localhost:5001"] >> spawnShell)
 
]
 
]
 
}
 
}

Revision as of 00:33, 25 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.NamedActions(sendMessage', (^++^), addDescrKeys,
                                addName, separator, spawn', submapName, subtitle, xMessage)
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)
 
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 = addDescrKeys ((mod4Mask, xK_d), xMessage) myKeys $ 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"
        ]
    }
 
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,1,1,1]
--------------------------------------------------------------
 
-------------------- Keys ------------------------------------
myKeys c@(XConfig { modMask = modm }) =
    [ subtitle "FloatSnap" ] ^++^
    [ ((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)
    ] ^++^
 
    [ subtitle "SubLayouts"
    ,((modm .|. controlMask, xK_o), addName "unmerge the current window"
                                     $ withFocused $ sendMessage . UnMerge)
    ,((modm .|. shiftMask .|. controlMask, xK_o), addName "disband the current group"
                                     $ withFocused $ sendMessage . UnMergeAll)
    ,((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), addName "Taller" $ sendMessage Taller)
    ,((modm, xK_o), addName "Wider" $ sendMessage Wider)
 
    , subtitle "Submaps"
    ,((modm, xK_x), submapName $ subMaps)
    ,((modm, xK_s), addName "send a normal action to a sublayout" $ submap $ defaultSublMap c)
 
    , subtitle "Focus"
    ,((modm, xK_period), addName "view next nonempty ws"     $ moveTo Next NonEmptyWS)
    ,((modm, xK_comma ), addName "view previous nonempty ws" $ moveTo Prev NonEmptyWS)
    ,((modm .|. shiftMask, xK_period), addName "focusDown" focusDown)
    ,((modm .|. shiftMask, xK_comma ), addName "focusUp"   focusUp)
 
    , subtitle "TopicSpace"
    ,((modm .|. shiftMask, xK_a), addName "run the topic's action" $ currentTopicAction myTopicConfig)
    ,((modm, xK_a), addName "gridselect a window" $ goToSelected defaultGSConfig)
    ,((modm, xK_Tab), addName "view the last workspace" $ switchNthLastFocused myTopicConfig 1)
    ,((modm, xK_g     ), addName "go to topic" promptedGoto)
 
    , separator
    ,((modm, xK_Return), addName "promote to master" $ dwmpromote)
    ,((modm .|. shiftMask, xK_Return), addName "terminal" spawnShell)
    ,((modm .|. shiftMask, xK_g     ), addName "shift to topic" promptedShift)
    ,((modm, xK_q), addName "Recompile XMonad in background" $ spawn "~/.xmonad/xmonad-recomp.lhs && xmonad --restart")
    ,((modm .|. shiftMask, xK_q), addName "Force recompile XMonad" $ spawn "xmonad --recompile && xmonad --restart")
    ,((0, xK_Print), addName "screenshot" $ spawn "scrot")
 
    ]
    ^++^ [subtitle "WindowNavigation"] ^++^
    concatMap (\(m,(n,f)) -> lrud (modm .|. m) (\d -> addName (n ++ ' ':show d) $ f d))
        [(shiftMask, ("swap",sendMessage . Swap))
        ,(controlMask,  ("pull group",sendMessage . pullGroup))
        ,(0, ("change focus", sendMessage . Go))
        ]
    ^++^ [subtitle "Media Keys"] ^++^ mediaKeys
    ^++^ [subtitle "Workspaces"] ^++^
    [((m .|. modm, key), addName (unwords [d,"workspace",show sc]) $ screenWorkspace sc >>= flip whenJust (windows . f)) |
        (f, m, d) <- [(W.view, 0, "view"), (W.shift, shiftMask, "shift to")],
        (key, sc) <- zip [xK_w, xK_f, xK_p] ([0 .. ])]
    ^++^
    [ ((modm, k), addName (unwords ["view the last",show i,"topic"]) $ 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), addName "run or raise prompt" $ runOrRaisePrompt myXPConfig),
           ((0, xK_p), addName "shell prompt" $ shellPrompt myXPConfig),
           ((0, xK_x), addName "xmonad prompt" $ xmonadPrompt myXPConfig),
           ((0, xK_z), addName "ssh prompt" $ sshPrompt myXPConfig),
           ((shiftMask, xK_w), addName "window gotoPrompt" $ windowPromptGoto myXPConfig),
           ((0, xK_w), addName "search wikipedia" $ promptSearch myXPConfig wikipedia),
           ((0, xK_s), addName "search multi" $ promptSearch myXPConfig multi),
           ((0, xK_m), addName "search mathworld" $ promptSearch myXPConfig mathworld),
           ((0, xK_d), addName "change dir" $ changeDir myXPConfig),
           ((0, xK_b), sendMessage' ToggleStruts),
           ((0, xK_f), addName "sink" $ withFocused $ windows . W.sink),
           ((0, xK_v), addName "refresh" refresh),
           ((0, xK_c), addName "terminal" $ asks config >>= spawnHere ?spawner . terminal),
           ((0, xK_k), addName "close window" kill)
           ]
 
mediaKeys = [((0, xF86XK_AudioPlay), mpcAct "toggle"),
             ((0, xF86XK_AudioStop), addName "HostPrompt" hostPrompt),
             ((0, xF86XK_AudioNext), mpcAct "next"),
             ((0, xF86XK_AudioPrev), mpcAct "prev"),
             ((0, xF86XK_AudioMute), addName "toggle mute" $ spawn " -t"),
             ((shiftMask, xF86XK_AudioMute), addName "toggle external speakers" $ 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 = addName ("mpc " ++ 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 [email protected]")
      , ("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