Personal tools

Xmonad/Config archive/adamvo's xmonad.hs

From HaskellWiki

< Xmonad | Config archive(Difference between revisions)
Jump to: navigation, search
(remove layoutHints)
(update to use ezconfig for most bindings, and checkKeymap)
Line 4: Line 4:
 
<haskell>
 
<haskell>
 
{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}
 
{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}
{-# LANGUAGE NoMonomorphismRestriction, ImplicitParams #-}
+
{-# LANGUAGE NoMonomorphismRestriction, ImplicitParams, FlexibleInstances #-}
-- module Main where
 
 
 
import XMonad
 
import XMonad
 
import qualified XMonad.StackSet as W
 
import qualified XMonad.StackSet as W
Line 10: Line 10:
   
 
-- Update these with: ghc -ddump-minimal-imports
 
-- Update these with: ghc -ddump-minimal-imports
import Control.Applicative((<*), liftA2)
 
import Control.Monad(Monad(return, (>>=), (>>)), Functor(..), (<=<), (=<<), mapM, sequence, zipWithM_)
 
import Data.List((++), zip, map, concatMap, repeat, zipWith, nub, isPrefixOf, intercalate, isInfixOf)
 
import Data.Map(fromList)
 
import Data.Maybe(catMaybes,fromMaybe)
 
import Graphics.X11.ExtraTypes.XF86(xF86XK_AudioLowerVolume, xF86XK_AudioMute, xF86XK_AudioNext, xF86XK_AudioPlay, xF86XK_AudioPrev, xF86XK_AudioRaiseVolume, xF86XK_AudioStop, xF86XK_Sleep)
 
import Graphics.X11.Xinerama(getScreenInfo)
 
import System.IO(IO, Handle, hPutStrLn)
 
 
 
import XMonad.Actions.DwmPromote(dwmpromote)
 
import XMonad.Actions.DwmPromote(dwmpromote)
import XMonad.Actions.FloatSnap(Direction(..), snapGrow, snapMove, snapShrink)
+
import XMonad.Actions.FloatSnap(Direction(..), snapGrow, snapMove,
import XMonad.Actions.GridSelect
+
snapShrink)
import XMonad.Actions.RandomBackground(randomBg', RandomColor(HSV))
+
import XMonad.Actions.GridSelect(defaultColorizer, gridselect,
import XMonad.Actions.Search(mathworld, wikipedia, multi, promptSearch)
+
GSConfig(gs_colorizer, gs_navigate), defaultGSConfig, goToSelected)
import XMonad.Actions.SpawnOn(mkSpawner, spawnOn, manageSpawn, shellPromptHere, spawnHere)
+
import XMonad.Actions.Search(mathworld, wikipedia, multi,
  +
promptSearch)
  +
import XMonad.Actions.SpawnOn(manageSpawn, mkSpawner,
  +
shellPromptHere, spawnHere)
 
import XMonad.Actions.Submap(submap)
 
import XMonad.Actions.Submap(submap)
import XMonad.Actions.TopicSpace(TopicConfig(..), Topic, (>*>), checkTopicConfig, currentTopicAction, currentTopicDir, pprWindowSet, shiftNthLastFocused, switchNthLastFocused, switchTopic)
+
import XMonad.Actions.TopicSpace(TopicConfig(..), Topic, (>*>),
import XMonad.Actions.UpdatePointer(PointerPosition(TowardsCentre), updatePointer)
+
checkTopicConfig, currentTopicAction, currentTopicDir,
import XMonad.Hooks.DynamicLog(PP(ppTitle, ppLayout, ppVisible, ppHidden, ppCurrent, ppSep), dynamicLogString, defaultPP, sjanssenPP, xmobarColor)
+
pprWindowSet, shiftNthLastFocused, switchNthLastFocused,
import XMonad.Hooks.EwmhDesktops(ewmhDesktopsEventHook, ewmhDesktopsLogHook)
+
switchTopic)
import XMonad.Hooks.ManageDocks(ToggleStruts(ToggleStruts), avoidStruts, manageDocks)
+
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.Hooks.UrgencyHook(FocusHook(..), withUrgencyHook)
 
import XMonad.Layout.BoringWindows(boringAuto, focusDown, focusUp)
 
import XMonad.Layout.BoringWindows(boringAuto, focusDown, focusUp)
Line 36: Line 27:
 
import XMonad.Layout.Mosaic(Aspect(Wider, Taller), mosaic)
 
import XMonad.Layout.Mosaic(Aspect(Wider, Taller), mosaic)
 
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
+
import XMonad.Layout.SubLayouts(GroupMsg(UnMergeAll, UnMerge,
import XMonad.Layout.Tabbed(defaultTheme, addTabs, shrinkText)
+
MergeAll),
import XMonad.Layout.WindowNavigation(Navigate(Swap, Go), configurableNavigation, navigateColor)
+
defaultSublMap, onGroup, pullGroup, pushWindow, subLayout)
import XMonad.Prompt(XPConfig(font), XPrompt(showXPrompt), greenXPConfig, mkXPrompt)
+
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.RunOrRaise(runOrRaisePrompt)
 
import XMonad.Prompt.Ssh(sshPrompt)
 
import XMonad.Prompt.Ssh(sshPrompt)
 
import XMonad.Prompt.Window(windowPromptGoto)
 
import XMonad.Prompt.Window(windowPromptGoto)
 
import XMonad.Prompt.XMonad(xmonadPrompt)
 
import XMonad.Prompt.XMonad(xmonadPrompt)
import XMonad.Util.EZConfig(additionalKeys)
+
import XMonad.Util.EZConfig(additionalKeysP, checkKeymap)
  +
import XMonad.Util.StringProp(setStringProp, getStringProp)
 
import XMonad.Util.Run(spawnPipe)
 
import XMonad.Util.Run(spawnPipe)
import XMonad.Util.StringProp(setStringProp,getStringProp)
+
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.Manual
+
import XMonad.Layout.WMII
import XMonad.Layout.ThreeColumns
+
-- import XMonad.Layout.Manual
   
 
main :: IO ()
 
main :: IO ()
 
main = do
 
main = do
 
spawner <- mkSpawner
 
spawner <- mkSpawner
  +
pressedKeys <- newIORef M.empty; let ?pressedKeys = pressedKeys
 
let ?spawner = spawner
 
let ?spawner = spawner
 
checkTopicConfig myTopics myTopicConfig
 
checkTopicConfig myTopics myTopicConfig
Line 63: Line 55:
 
layoutHook = myLayout
 
layoutHook = myLayout
 
, focusedBorderColor = "#ff0000"
 
, focusedBorderColor = "#ff0000"
  +
, startupHook = return () >> checkKeymap (myConfig []) (myKeys c) -- grabChords chords
 
, terminal = "urxvt"
 
, terminal = "urxvt"
 
, modMask = mod4Mask
 
, modMask = mod4Mask
Line 73: Line 66:
 
hs
 
hs
 
updatePointer (TowardsCentre 0.2 0.2)
 
updatePointer (TowardsCentre 0.2 0.2)
, handleEventHook = ewmhDesktopsEventHook
+
, handleEventHook = mconcat [
  +
-- manageKeypresses True $ mkChords 500 300 chords,
  +
ewmhDesktopsEventHook]
 
, workspaces = myTopics
 
, workspaces = myTopics
, manageHook = fmap ("Shiretoko" `isInfixOf`) className --> doShift "web" <+> manageSpawn ?spawner <+> manageDocks
+
, manageHook = composeAll [
} in additionalKeys c (myKeys c)
+
-- fmap ("Shiretoko" `isInfixOf`) className --> doShift "web" <+> ,
  +
manageSpawn ?spawner,
  +
isFullscreen --> doFullFloat,
  +
manageDocks]
  +
} in additionalKeysP c (myKeys c)
   
 
myXPConfig :: XPConfig
 
myXPConfig :: XPConfig
Line 91: Line 84:
 
myLayout = avoidStruts $ named "M" m ||| named "F" (noBorders Full)
 
myLayout = avoidStruts $ named "M" m ||| named "F" (noBorders Full)
 
where m = lessBorders Screen
 
where m = lessBorders Screen
  +
$ layoutHintsToCenter
 
$ addTabs shrinkText defaultTheme
 
$ addTabs shrinkText defaultTheme
 
$ configurableNavigation (navigateColor "#ffff00")
 
$ configurableNavigation (navigateColor "#ffff00")
 
$ boringAuto
 
$ boringAuto
 
$ subLayout [] Simplest
 
$ subLayout [] Simplest
-- $ layoutHintsToCenter
 
 
$ mosaic 1.5 [5,4,2]
 
$ mosaic 1.5 [5,4,2]
  +
-- $ wmii 0.03 1.3
 
-- $ manual 0.2
 
-- $ manual 0.2
 
--------------------------------------------------------------
 
--------------------------------------------------------------
 
-------------------- Keys ------------------------------------
 
-------------------- Keys ------------------------------------
myKeys c@(XConfig { modMask = modm }) =
+
myKeys c =
[ ((modm, xK_Left), withFocused $ snapMove L Nothing)
+
[ ("M-<Left>" , withFocused $ snapMove L Nothing )
, ((modm, xK_Right), withFocused $ snapMove R Nothing)
+
, ("M-<Right>" , withFocused $ snapMove R Nothing )
, ((modm, xK_Up), withFocused $ snapMove U Nothing)
+
, ("M-<Up>" , withFocused $ snapMove U Nothing )
, ((modm, xK_Down), withFocused $ snapMove D Nothing)
+
, ("M-<Down>" , withFocused $ snapMove D Nothing )
, ((modm .|. shiftMask, xK_Left), withFocused $ snapShrink R Nothing)
+
, ("M-S-<Left>" , withFocused $ snapShrink R Nothing)
, ((modm .|. shiftMask, xK_Right), withFocused $ snapGrow R Nothing)
+
, ("M-S-<Right>", withFocused $ snapGrow R Nothing)
, ((modm .|. shiftMask, xK_Up), withFocused $ snapShrink D Nothing)
+
, ("M-S-<Up>" , withFocused $ snapShrink D Nothing)
, ((modm .|. shiftMask, xK_Down), withFocused $ snapGrow D Nothing)
+
, ("M-S-<Down>" , withFocused $ snapGrow D Nothing)
   
  +
, ("M-p", shellPromptHere ?spawner myXPConfig)
   
, ((modm, xK_p), shellPromptHere ?spawner myXPConfig)
+
-- , ((modm, xK_v), sendMessage $ Split 0.5 U)
  +
-- , ((modm .|. shiftMask, xK_v), addLeft)
  +
-- , ((modm .|. controlMask, xK_v), addRight)
   
, ((modm, xK_v), sendMessage $ Split 0.5 U)
+
,("M-S-o" , withFocused $ sendMessage . UnMerge )
, ((modm .|. shiftMask, xK_v), sendMessage $ Split 0.5 L)
+
,("M-S-C-o", withFocused $ sendMessage . UnMergeAll)
, ((modm .|. controlMask, xK_v), sendMessage SwapPanes)
+
,("M-C-m" , withFocused $ sendMessage . MergeAll )
  +
,("M-C-." , onGroup W.focusDown')
  +
,("M-C-," , onGroup W.focusUp' )
   
,((modm .|. shiftMask, xK_o), withFocused $ sendMessage . UnMerge)
+
,("M-;", sendMessage Taller)
,((modm .|. controlMask .|. shiftMask, xK_o), withFocused $ sendMessage . UnMergeAll)
+
,("M-o", sendMessage Wider )
,((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)
+
,("M-x", submap $ M.fromList subMaps)
,((modm, xK_o), sendMessage Wider)
+
,("M-s", submap $ defaultSublMap c )
   
,((modm, xK_x), submap $ M.fromList subMaps)
+
,("M-S-.", focusDown)
,((modm, xK_s), submap $ defaultSublMap c)
+
,("M-S-,", focusUp )
   
,((modm .|. shiftMask, xK_period), focusDown)
+
,("M-S-a", currentTopicAction myTopicConfig)
,((modm .|. shiftMask, xK_comma ), focusUp)
+
,("M-a", gets (W.screen . W.current . windowset) >>= \x -> warpToScreen x 0.5 0.5 >> goToSelected gsConfig)
  +
,("M-<Tab>", switchNthLastFocused myTopicConfig 1)
   
,((modm .|. shiftMask, xK_a), currentTopicAction myTopicConfig)
+
,("M-g" , promptedGoto )
,((modm, xK_a), goToSelected gsConfig)
+
,("M-S-g", promptedShift)
,((modm, xK_Tab), switchNthLastFocused myTopicConfig 1)
+
,("M-r" , promptedGoto )
  +
,("M-S-r", promptedShift)
   
,((modm, xK_g), promptedGoto)
+
,("M-b", sendMessage ToggleStruts)
,((modm .|. shiftMask, xK_g), promptedShift)
+
,("M-<Return>", dwmpromote)
,((modm, xK_r), promptedGoto)
+
,("M-S-<Return>", spawnShell)
,((modm .|. shiftMask, xK_r), promptedShift)
 
 
,((modm, xK_b), sendMessage ToggleStruts)
 
,((modm, xK_Return), dwmpromote)
 
,((modm .|. shiftMask, xK_Return), spawnShell)
 
 
-- don't force a recompile, if nothing has changed (xmonad --recompile runs XMonad.recompile True)
 
-- don't force a recompile, if nothing has changed (xmonad --recompile runs XMonad.recompile True)
,((modm, xK_q), spawn $ "ghc -e 'XMonad.recompile False >>= flip Control.Monad.unless System.Exit.exitFailure'"
+
,("M-q", spawn $ "ghc -e 'XMonad.recompile False >>= flip Control.Monad.unless System.Exit.exitFailure'"
 
++ "&& xmonad --restart")
 
++ "&& xmonad --restart")
,((modm .|. shiftMask, xK_q), spawn "~/wip/x11-wm/xmonad/rebuild.sh")
+
,("M-S-q", spawn "~/wip/x11-wm/xmonad/rebuild.sh")
,((0, xK_Print), spawn "scrot")
+
,("<Print>", spawn "scrot")
 
]
 
]
 
++
 
++
concatMap (\(m,f) -> lrud (modm .|. m) f)
+
concatMap (\(m,f) -> lrud ("M-"++m) f)
[(shiftMask, sendMessage . Swap)
+
[("S-" , sendMessage . Swap)
,(controlMask, sendMessage . pullGroup)
+
,("C-" , sendMessage . pullGroup)
,(controlMask .|. shiftMask, sendMessage . pushWindow)
+
,("S-C-", sendMessage . pushWindow)
,(0, (sendMessage . Go))
+
,("" , sendMessage . Go)]
]
 
 
++ mediaKeys ++
 
++ mediaKeys ++
[((m .|. modm, key), screenWorkspace sc >>= flip whenJust (windows . f)) |
+
[("M-"++m++[key], screenWorkspace sc >>= flip whenJust (windows . f)) |
(f, m) <- [(W.view, 0), (W.shift, shiftMask)],
+
(f, m) <- [(W.view, ""), (W.shift, "S-")],
(key, sc) <- zip [xK_w, xK_f] ([0 .. ])]
+
(key, sc) <- zip "fw" [0 .. ]]
 
++
 
++
[ ((modm .|. m, k), a i)
+
[ ("M-"++m++[k], a i)
| (a, m) <- [(switchNthLastFocused myTopicConfig,0),(shiftNthLastFocused, shiftMask)]
+
| (a, m) <- [(switchNthLastFocused myTopicConfig,""),(shiftNthLastFocused, "S-")]
, (i, k) <- zip [1..] [xK_1 .. xK_9]]
+
, (i, k) <- zip [1..] "123456789"]
   
 
-- helper for windowNavigation keys
 
-- helper for windowNavigation keys
 
-- note: with colemak neiu are placed where jkli are with qwerty layout
 
-- note: with colemak neiu are placed where jkli are with qwerty layout
lrud :: a -> (Direction -> b) -> [((a, KeySym), b)]
+
lrud :: String -> (Direction -> b) -> [(String, b)]
 
lrud m cmd = zip ks cmds
 
lrud m cmd = zip ks cmds
 
where
 
where
ks = zip (repeat m) [xK_n,xK_i,xK_u,xK_e]
+
ks = zipWith (++) (repeat m) $ map return "niue"
 
cmds = zipWith ($) (repeat cmd) [L,R,U,D]
 
cmds = zipWith ($) (repeat cmd) [L,R,U,D]
   
Line 180: Line 175:
 
]
 
]
   
mediaKeys = [((0, xF86XK_AudioPlay), mpcAct "toggle"),
+
mediaKeys = [("<XF86AudioPlay>", mpcAct "toggle"),
((0, xF86XK_AudioStop), hostPrompt),
+
("<XF86AudioStop>", hostPrompt),
((0, xF86XK_AudioNext), mpcAct "next"),
+
("<XF86AudioNext>", mpcAct "next"),
((0, xF86XK_AudioPrev), mpcAct "prev"),
+
("<XF86AudioPrev>", mpcAct "prev"),
((0, xF86XK_AudioMute), spawn "ossmix vmix0-outvol 0"),
+
("<XF86AudioMute>", spawn "ossmix vmix0-outvol 0"),
((shiftMask, xF86XK_AudioMute), spawn "~/bin/speakers.sh"),
+
("S-<XF86AudioMute>", spawn "~/bin/speakers.sh"),
((0, xF86XK_AudioLowerVolume), spawn "ossmix vmix0-outvol -- -1"),
+
("<XF86AudioLowerVolume>", spawn "ossmix vmix0-outvol -- -1"),
((shiftMask, xF86XK_AudioLowerVolume), spawn "ossmix vmix0-outvol -- -0.1"),
+
("S-<XF86AudioLowerVolume>", spawn "ossmix vmix0-outvol -- -0.1"),
((0, xF86XK_AudioRaiseVolume), spawn "ossmix vmix0-outvol +1"),
+
("<XF86AudioRaiseVolume>", spawn "ossmix vmix0-outvol +1"),
((shiftMask, xF86XK_AudioRaiseVolume), spawn "ossmix vmix0-outvol +0.1"),
+
("S-<XF86AudioRaiseVolume>", spawn "ossmix vmix0-outvol +0.1"),
((0, xF86XK_Sleep), spawn "sudo sh -c 'echo mem > /sys/power/state'")]
+
("<XF86Sleep>", spawn "sudo sh -c 'echo mem > /sys/power/state'")]
 
where mpcAct c = do
 
where mpcAct c = do
 
h <- withDisplay $ flip getStringProp mpdHost
 
h <- withDisplay $ flip getStringProp mpdHost
Line 244: Line 239:
 
-- multiple configuration files, which gets messy
 
-- multiple configuration files, which gets messy
 
xmobarScreen :: Int -> IO Handle
 
xmobarScreen :: Int -> IO Handle
xmobarScreen = spawnPipe . ("xmobar -x " ++) . show
+
xmobarScreen = spawnPipe . ("~/.cabal/bin/xmobar -x " ++) . show
   
 
myPP :: PP
 
myPP :: PP
Line 303: Line 298:
 
, ("irc", spawn "urxvt -e ssh engage.uwaterloo.ca")
 
, ("irc", spawn "urxvt -e ssh engage.uwaterloo.ca")
 
, ("dashboard", spawnShell)
 
, ("dashboard", spawnShell)
, ("web", spawn "firefox")
+
, ("web", spawnHere ?spawner "firefox")
 
, ("movie", spawnShell)
 
, ("movie", spawnShell)
 
, ("pdf", spawn "okular")
 
, ("pdf", spawn "okular")
, ("gimp", spawnOn ?spawner "gimp" "gimp")
+
, ("gimp", spawnHere ?spawner "gimp")
 
]
 
]
 
}
 
}
Line 314: Line 309:
   
 
spawnShellIn dir = do
 
spawnShellIn dir = do
color <- randomBg' (HSV 15 0)
+
-- color <- randomBg' (HSV 255 255)
 
t <- asks (terminal . config)
 
t <- asks (terminal . config)
spawnHere ?spawner $ "cd " ++ dir ++ " && " ++ t ++ " -bg " ++ color
+
spawnHere ?spawner $ "cd " ++ dir ++ " && " ++ t -- ++ " -bg " ++ color
   
 
wsgrid = gridselect gsConfig { gs_colorizer = defaultColorizer }
 
wsgrid = gridselect gsConfig { gs_colorizer = defaultColorizer }
Line 324: Line 319:
   
 
promptedShift = wsgrid >>= \x -> whenJust x $ \y -> windows (W.greedyView y . W.shift y)
 
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
  +
--------------------------------------------------------------------------------
 
</haskell>
 
</haskell>

Revision as of 06:47, 1 September 2009

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
--------------------------------------------------------------------------------