Xmonad/Config archive/adamvo's xmonad.hs
< Xmonad | Config archive
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
Xmonad/Config archive/adamvo's xmobarrc (0.9.2)
{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}
{-# LANGUAGE NoMonomorphismRestriction, ImplicitParams, FlexibleInstances #-}
import XMonad
import qualified XMonad.StackSet as W
import qualified Data.Map as M
-- Update these with: ghc -ddump-minimal-imports
import XMonad.Actions.DwmPromote(dwmpromote)
import XMonad.Actions.FloatSnap(Direction(..), snapGrow, snapMove,
snapShrink)
import XMonad.Actions.GridSelect(defaultColorizer, gridselect,
GSConfig(gs_colorizer, gs_navigate), defaultGSConfig, goToSelected)
import XMonad.Actions.Search(mathworld, wikipedia, multi,
promptSearch)
import XMonad.Actions.SpawnOn(manageSpawn, mkSpawner,
shellPromptHere, spawnHere)
import XMonad.Actions.Submap(submap)
import XMonad.Actions.TopicSpace(TopicConfig(..), Topic, (>*>),
checkTopicConfig, currentTopicAction, currentTopicDir,
pprWindowSet, shiftNthLastFocused, switchNthLastFocused,
switchTopic)
import XMonad.Actions.UpdatePointer(PointerPosition(TowardsCentre),
updatePointer)
import XMonad.Actions.Warp(warpToScreen)
import XMonad.Hooks.DynamicLog(PP(ppSep, ppCurrent, ppHidden,
ppVisible, ppLayout, ppTitle),
dynamicLogString, defaultPP, xmobarColor, sjanssenPP)
import XMonad.Hooks.EwmhDesktops(ewmhDesktopsEventHook,
ewmhDesktopsLogHook)
import XMonad.Hooks.ManageDocks(ToggleStruts(ToggleStruts),
avoidStruts, manageDocks)
import XMonad.Hooks.ManageHelpers(doFullFloat, isFullscreen)
import XMonad.Hooks.UrgencyHook(FocusHook(..), 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, pushWindow, subLayout)
import XMonad.Layout.Tabbed(defaultTheme, shrinkText, addTabs)
import XMonad.Layout.WindowNavigation(Navigate(Swap, Go),
configurableNavigation, navigateColor)
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.XMonad(xmonadPrompt)
import XMonad.Util.EZConfig(additionalKeysP, checkKeymap)
import XMonad.Util.StringProp(setStringProp, getStringProp)
import XMonad.Util.Run(spawnPipe)
import XMonad.Util.Paste(sendKey)
import Graphics.X11.Xinerama(getScreenInfo)
import XMonad
import Control.Applicative(Applicative((<*>)), (<*), liftA2)
import Control.Monad(Monad(return, (>>=), (>>)), Functor(..),
(=<<), mapM, sequence, (<=<), guard, liftM, zipWithM_)
import Data.Function((.), const, ($), flip, id, on)
import Data.IORef(IORef, newIORef, readIORef, modifyIORef)
import Data.List((++), foldr, filter, zip, map, all, concatMap,
length, repeat, tail, unzip, zipWith, maximum, unwords, isPrefixOf,
intercalate, maximumBy, nub)
import Data.Maybe(Maybe(..), maybe, catMaybes, fromMaybe,
maybeToList)
import Data.Monoid(Monoid(mconcat), All(All))
import System.IO(IO, Handle, hPutStrLn)
import XMonad.Layout.WMII
-- import XMonad.Layout.Manual
main :: IO ()
main = do
spawner <- mkSpawner
pressedKeys <- newIORef M.empty; let ?pressedKeys = pressedKeys
let ?spawner = spawner
checkTopicConfig myTopics myTopicConfig
xmonad . withUrgencyHook FocusHook . myConfig =<< mapM xmobarScreen =<< getScreens
myConfig hs = let c = defaultConfig {
layoutHook = myLayout
, focusedBorderColor = "#ff0000"
, startupHook = return () >> checkKeymap (myConfig []) (myKeys c) -- grabChords chords
, terminal = "urxvt"
, modMask = mod4Mask
, logHook = do
ewmhDesktopsLogHook
multiPP'
(mergePPOutputs [pprWindowSet myTopicConfig,dynamicLogString . onlyTitle])
myPP
myPP { ppTitle = const "" }
hs
updatePointer (TowardsCentre 0.2 0.2)
, handleEventHook = mconcat [
-- manageKeypresses True $ mkChords 500 300 chords,
ewmhDesktopsEventHook]
, workspaces = myTopics
, manageHook = composeAll [
-- fmap ("Shiretoko" `isInfixOf`) className --> doShift "web" <+> ,
manageSpawn ?spawner,
isFullscreen --> doFullFloat,
manageDocks]
} in additionalKeysP c (myKeys c)
myXPConfig :: XPConfig
myXPConfig = greenXPConfig { font = "xft:Profont:pixelsize=15:autohint=true" }
gsConfig = defaultGSConfig { gs_navigate = neiu `M.union` gs_navigate defaultGSConfig }
where neiu = M.map (\(x,y) (a,b) -> (x+a,y+b)) $ M.fromList
[((0,xK_n),(-1,0))
,((0,xK_e),(0,1))
,((0,xK_i),(1,0))
,((0,xK_u),(0,-1))]
-------------------- Layout ----------------------------------
myLayout = avoidStruts $ named "M" m ||| named "F" (noBorders Full)
where m = lessBorders Screen
$ layoutHintsToCenter
$ addTabs shrinkText defaultTheme
$ configurableNavigation (navigateColor "#ffff00")
$ boringAuto
$ subLayout [] Simplest
$ mosaic 1.5 [5,4,2]
-- $ wmii 0.03 1.3
-- $ manual 0.2
--------------------------------------------------------------
-------------------- Keys ------------------------------------
myKeys c =
[ ("M-<Left>" , withFocused $ snapMove L Nothing )
, ("M-<Right>" , withFocused $ snapMove R Nothing )
, ("M-<Up>" , withFocused $ snapMove U Nothing )
, ("M-<Down>" , withFocused $ snapMove D Nothing )
, ("M-S-<Left>" , withFocused $ snapShrink R Nothing)
, ("M-S-<Right>", withFocused $ snapGrow R Nothing)
, ("M-S-<Up>" , withFocused $ snapShrink D Nothing)
, ("M-S-<Down>" , withFocused $ snapGrow D Nothing)
, ("M-p", shellPromptHere ?spawner myXPConfig)
-- , ((modm, xK_v), sendMessage $ Split 0.5 U)
-- , ((modm .|. shiftMask, xK_v), addLeft)
-- , ((modm .|. controlMask, xK_v), addRight)
,("M-S-o" , withFocused $ sendMessage . UnMerge )
,("M-S-C-o", withFocused $ sendMessage . UnMergeAll)
,("M-C-m" , withFocused $ sendMessage . MergeAll )
,("M-C-." , onGroup W.focusDown')
,("M-C-," , onGroup W.focusUp' )
,("M-;", sendMessage Taller)
,("M-o", sendMessage Wider )
,("M-x", submap $ M.fromList subMaps)
,("M-s", submap $ defaultSublMap c )
,("M-S-.", focusDown)
,("M-S-,", focusUp )
,("M-S-a", currentTopicAction myTopicConfig)
,("M-a", gets (W.screen . W.current . windowset) >>= \x -> warpToScreen x 0.5 0.5 >> goToSelected gsConfig)
,("M-<Tab>", switchNthLastFocused myTopicConfig 1)
,("M-g" , promptedGoto )
,("M-S-g", promptedShift)
,("M-r" , promptedGoto )
,("M-S-r", promptedShift)
,("M-b", sendMessage ToggleStruts)
,("M-<Return>", dwmpromote)
,("M-S-<Return>", spawnShell)
-- don't force a recompile, if nothing has changed (xmonad --recompile runs XMonad.recompile True)
,("M-q", spawn $ "ghc -e 'XMonad.recompile False >>= flip Control.Monad.unless System.Exit.exitFailure'"
++ "&& xmonad --restart")
,("M-S-q", spawn "~/wip/x11-wm/xmonad/rebuild.sh")
,("<Print>", spawn "scrot")
]
++
concatMap (\(m,f) -> lrud ("M-"++m) f)
[("S-" , sendMessage . Swap)
,("C-" , sendMessage . pullGroup)
,("S-C-", sendMessage . pushWindow)
,("" , sendMessage . Go)]
++ mediaKeys ++
[("M-"++m++[key], screenWorkspace sc >>= flip whenJust (windows . f)) |
(f, m) <- [(W.view, ""), (W.shift, "S-")],
(key, sc) <- zip "fw" [0 .. ]]
++
[ ("M-"++m++[k], a i)
| (a, m) <- [(switchNthLastFocused myTopicConfig,""),(shiftNthLastFocused, "S-")]
, (i, k) <- zip [1..] "123456789"]
-- helper for windowNavigation keys
-- note: with colemak neiu are placed where jkli are with qwerty layout
lrud :: String -> (Direction -> b) -> [(String, b)]
lrud m cmd = zip ks cmds
where
ks = zipWith (++) (repeat m) $ map return "niue"
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_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 = [("<XF86AudioPlay>", mpcAct "toggle"),
("<XF86AudioStop>", hostPrompt),
("<XF86AudioNext>", mpcAct "next"),
("<XF86AudioPrev>", mpcAct "prev"),
("<XF86AudioMute>", spawn "ossmix vmix0-outvol 0"),
("S-<XF86AudioMute>", spawn "~/bin/speakers.sh"),
("<XF86AudioLowerVolume>", spawn "ossmix vmix0-outvol -- -1"),
("S-<XF86AudioLowerVolume>", spawn "ossmix vmix0-outvol -- -0.1"),
("<XF86AudioRaiseVolume>", spawn "ossmix vmix0-outvol +1"),
("S-<XF86AudioRaiseVolume>", spawn "ossmix vmix0-outvol +0.1"),
("<XF86Sleep>", spawn "sudo sh -c 'echo mem > /sys/power/state'")]
where mpcAct c = do
h <- withDisplay $ flip getStringProp mpdHost
spawn $ unwords ["export MPD_HOST="++fromMaybe "localhost" h,";","mpc",c]
mpdHost = "XMONAD_MPD_HOST"
-- Prompt for mpd host
data HostPrompt = HostPrompt
instance XPrompt HostPrompt where showXPrompt _ = "Pick MPD Host: "
hostPrompt = mkXPrompt HostPrompt myXPConfig (return . compl) f
where compl s = nub $ filter (s `isPrefixOf`) ["localhost","dell"]
f x = withDisplay $ \d -> setStringProp d mpdHost x
--------------------------------------------------------------
-------------------- Support for per-screen xmobars ---------
-- Some parts of this should be merged into contrib sometime
getScreens :: IO [Int]
getScreens = openDisplay "" >>= liftA2 (<*) f closeDisplay
where f = fmap (zipWith const [0..]) . getScreenInfo
multiPP :: PP -- ^ The PP to use if the screen is focused
-> PP -- ^ The PP to use otherwise
-> [Handle] -- ^ Handles for the status bars, in order of increasing X
-- screen number
-> X ()
multiPP = multiPP' dynamicLogString
multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()
multiPP' dynlStr focusPP unfocusPP handles = do
state <- get
let pickPP :: WorkspaceId -> X PP
pickPP ws = do
let foc = W.tag . W.workspace . W.current $ windowset state
put state { windowset = W.view ws $ windowset state }
return $ if ws == foc then focusPP else unfocusPP
io . zipWithM_ hPutStrLn handles
=<< mapM (dynlStr <=< pickPP) . catMaybes
=<< mapM screenWorkspace (zipWith const [0..] handles)
put state
mergePPOutputs :: [PP -> X String] -> PP -> X String
mergePPOutputs x pp = fmap (intercalate (ppSep pp)) . sequence $ map ($ pp) x
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), otherwise you have to use
-- multiple configuration files, which gets messy
xmobarScreen :: Int -> IO Handle
xmobarScreen = spawnPipe . ("~/.cabal/bin/xmobar -x " ++) . show
myPP :: PP
myPP = sjanssenPP { ppLayout = xmobarColor "orange" "" }
--------------------------------------------------------------
-------------------- X.Actions.TopicSpace --------------------
myTopics :: [Topic]
myTopics =
[ "dashboard"
, "web"
, "haskell"
, "irc"
, "admin"
, "documents"
, "gimp"
, "gitit"
, "mail"
, "movie"
, "music"
, "pdf"
, "xmonad-conf"
, "xmonad-contrib"
, "xmonad-extras"
, "xmonad-newconfig"
, "xmobar"
, "wip"
]
myTopicConfig = TopicConfig
{ topicDirs = M.fromList $
[ ("dashboard", "./")
, ("haskell", "haskell")
, ("xmonad-conf", ".xmonad")
, ("xmonad-extras", "wip/x11-wm/xmonad/extras/xmonad-extras/XMonad")
, ("xmonad-newconfig", "wip/x11-wm/xmonad/core/xmonad-newconfig")
, ("xmonad-contrib", "wip/x11-wm/xmonad/contrib/XMonadContrib/XMonad")
, ("xmobar", "wip/x11-wm/xmobar")
, ("movie", "media/movie")
, ("music", "media/music")
, ("documents", "doc")
, ("pdf", "ref")
, ("gitit", "wip/gitit")
, ("gimp", "./")
, ("wip", "wip")
]
, defaultTopicAction = const $ spawnShell >*> 2
, defaultTopic = "dashboard"
, maxTopicHistory = 10
, topicActions = M.fromList $
[ ("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 "export MPD_HOST=192.168.1.2; mpc && urxvt -e ncmpc -h 192.168.1.2")
, ("mail", spawn "urxvt -e mutt")
, ("irc", spawn "urxvt -e ssh engage.uwaterloo.ca")
, ("dashboard", spawnShell)
, ("web", spawnHere ?spawner "firefox")
, ("movie", spawnShell)
, ("pdf", spawn "okular")
, ("gimp", spawnHere ?spawner "gimp")
]
}
-- From the sample config in TopicSpace, these should probably be exported from that module
spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
spawnShellIn dir = do
-- color <- randomBg' (HSV 255 255)
t <- asks (terminal . config)
spawnHere ?spawner $ "cd " ++ dir ++ " && " ++ t -- ++ " -bg " ++ color
wsgrid = gridselect gsConfig { gs_colorizer = defaultColorizer }
=<< asks (map (\x -> (x,x)) . workspaces . config)
promptedGoto = wsgrid >>= flip whenJust (switchTopic myTopicConfig)
promptedShift = wsgrid >>= \x -> whenJust x $ \y -> windows (W.greedyView y . W.shift y)
------------------- Chords -----------------------------------------------------
-- a failure since xmonad isn't -threaded yet, so we can't reasonably use
-- threaddelay to send the keys that didn't turn out to be part of a chord
-- (waiting for xcb/xhb port)
mkChords :: (?pressedKeys::IORef (M.Map (KeyMask,KeyCode) Time))
=> Time -- ^ expire older keypresses than this time
-> Time -- ^ maximum delay between consecutive keypresses in miliseconds
-> [([(KeyMask,KeySym)],X ())]
-> M.Map (KeyMask,KeyCode) Time
-> X ()
mkChords oldest tdiff chords' m = do
chords <- mkKeyCodes chords'
let nothingIfNull [] = Nothing
nothingIfNull xs = Just xs
let newest = maximum $ M.elems m
(olds,oks) = M.partition (< newest - oldest) m
disp <- asks display
-- this send has to happen some other time...
let send = do
mapM_ (\(m,ks) -> sendKey m =<< io (keycodeToKeysym disp ks 0)) $ M.keys olds
io $ modifyIORef ?pressedKeys (foldr (.) id (map M.delete $ M.keys olds))
maybe send (snd . maximumBy (compare `on` fst)) $ nothingIfNull $ do
(ks,act) <- chords
times <- maybeToList $ mapM (flip M.lookup oks) ks
guard $ all (\x -> x<tdiff && x>=0)
$ zipWith subtract <*> tail $ map fromIntegral times
return (length ks,act)
mkKeyCodes :: [([(a, KeySym)], b)] -> X [([(a, KeyCode)], b)]
mkKeyCodes y = do
d <- asks display
mapM (\(x,y) -> let (masks,syms) = unzip x
in liftM (flip (,) y . zip masks) $ mapM (liftIO . keysymToKeycode d) syms) y
manageKeypresses :: (?pressedKeys::IORef (M.Map (KeyMask, KeyCode) Time), MonadIO m) =>Bool -> (M.Map (KeyMask, KeyCode) Time -> m b) -> Event -> m All
manageKeypresses ignoreRelease checkMap (KeyEvent { ev_event_type = ty, ev_keycode = k, ev_time = t, ev_state = mod } )
| ty == keyPress = do
modKs $ M.filterWithKey (flip $ const ((k/=) . snd))
modKs $ M.insert (mod,k) t
checkMap =<< liftIO (readIORef ?pressedKeys)
return (All True)
| not ignoreRelease && ty == keyRelease = do
modKs $ M.filterWithKey (flip $ const ((k/=) . snd))
return (All True)
where modKs = io . modifyIORef ?pressedKeys
manageKeypresses _ _ _ = return (All True)
-- addSendKeys :: [([(KeyMask, KeySym)], X ())] -> [([(KeyMask, KeySym)], X ())]
chords :: [([(KeyMask, KeySym)], X ())]
chords = [([(mod4Mask,xK_z),(mod4Mask,xK_c)],spawn "xmessage hahaahah it works" :: X ())]
-- Ripped out of XMonad.Main.grabKeys
grabChords :: [([(ButtonMask, KeySym)], X())] -> X ()
grabChords c = do
XConf { display = dpy, theRoot = rootw } <- ask
let grab m ks = do
kc <- keysymToKeycode dpy ks
grabKey dpy kc m rootw True grabModeAsync grabModeAsync
mapM_ (io . uncurry grab) $ concatMap fst c
--------------------------------------------------------------------------------