Xmonad/Config archive/adamvo's xmonad.hs
{-# 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, shellPromptHere)
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(layoutHintsToCenter) 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.Ssh(sshPrompt) import XMonad.Prompt.Window(windowPromptGoto) import XMonad.Prompt.Workspace(workspacePrompt) import XMonad.Prompt.XMonad(xmonadPrompt) import XMonad.Util.EZConfig(additionalKeys) 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 = let c = defaultConfig {
layoutHook = myLayout , focusedBorderColor = "#ff0000" , terminal = "urxvt" , modMask = mod4Mask , logHook = ewmhDesktopsLogHook >> myLogHook hs , handleEventHook = ewmhDesktopsEventHook , workspaces = myTopics , manageHook = manageSpawn ?spawner <+> manageDocks } 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
$ layoutHintsToCenter
$ 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), shellPromptHere ?spawner 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 "ossmix vmix0-outvol 0"),
((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 (zipWith const [0..]) . 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 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 (zipWith const [0..] 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
myPP { ppTitle = const "" }
myPP :: PP myPP = defaultPP
{ ppTitle = xmobarColor "orange" ""
, 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", "gimp" ]
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")
, ("gimp", "./")
]
, 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 -no-remote http://localhost:5001"] >> spawnShell)
, ("gimp", spawnOn ?spawner "gimp" "gimp")
]
}
-- 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 </haskell>