Xmonad/Config archive/adamvo's xmonad.hs
< Xmonad | Config archive
Jump to navigation
Jump to search
{-# 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]
--------------------------------------------------------------
-------------------- 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 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