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)
(updates for gridselect changes)
 
(23 intermediate revisions by one user not shown)
Line 1: Line 1:
  +
[[Category:XMonad configuration]]
  +
[[../adamvo's xmobarrc]] (0.9.2)
  +
  +
[[../obtoxmd]] -- script called to temporarily run another wm
  +
 
<haskell>
 
<haskell>
{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}
+
-- current darcs as of 2010-12-31
{-# LANGUAGE ImplicitParams #-}
+
{-# LANGUAGE
module Main where
+
DeriveDataTypeable,
  +
FlexibleContexts,
  +
FlexibleInstances,
  +
MultiParamTypeClasses,
  +
NoMonomorphismRestriction,
  +
PatternGuards,
  +
ScopedTypeVariables,
  +
TypeSynonymInstances,
  +
UndecidableInstances
  +
#-}
  +
{-# OPTIONS_GHC -W -fwarn-unused-imports -fno-warn-missing-signatures #-}
   
  +
import Control.Applicative
  +
import Control.Monad
  +
import Control.Monad.Instances ()
  +
import Control.Monad.Writer
  +
import Data.List
  +
import Data.Maybe
  +
import Data.Traversable(traverse)
  +
import Graphics.X11.Xinerama
  +
import qualified Data.Map as M
  +
import qualified XMonad.StackSet as W
  +
import qualified XMonad.Util.ExtensibleState as XS
  +
import System.IO
 
import XMonad
 
import XMonad
import Graphics.X11.ExtraTypes.XF86
+
import XMonad.Actions.DwmPromote
+
import XMonad.Actions.FloatSnap
import qualified XMonad.StackSet as W
+
import XMonad.Actions.GridSelect
import qualified Data.Map as M
+
import XMonad.Actions.Search
 
-- 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(..),
 
moveTo, nextWS, prevWS, shiftToNext, shiftToPrev)
 
import XMonad.Actions.DwmPromote(dwmpromote)
 
import XMonad.Actions.GridSelect(defaultGSConfig, goToSelected)
 
import XMonad.Actions.Search(mathworld, wikipedia, multi,
 
promptSearch)
 
import XMonad.Actions.Submap(submap)
 
import XMonad.Actions.TopicSpace(TopicConfig(..), Topic,
 
(>*>), checkTopicConfig, currentTopicAction, currentTopicDir,
 
pprWindowSet, switchNthLastFocused, switchTopic,
 
getStringProp, setStringProp)
 
import XMonad.Hooks.DynamicLog(PP(ppUrgent, ppTitle, ppLayout,
 
ppVisible, ppHidden, ppCurrent, ppSep),
 
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(boringWindows, focusDown,
 
focusUp)
 
import XMonad.Layout.Mosaic(Mosaic(..),
 
Aspect(..))
 
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(Direction(..),
 
Navigate(Swap, Go), configurableNavigation, navigateColor)
 
import XMonad.Layout.WorkspaceDir(changeDir, workspaceDir)
 
import XMonad.Prompt(XPrompt(..),XPConfig(..),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.Run(spawnPipe)
 
 
 
import XMonad.Actions.SpawnOn
 
import XMonad.Actions.SpawnOn
  +
import XMonad.Actions.Submap
  +
import XMonad.Actions.TopicSpace
  +
import XMonad.Actions.UpdatePointer
  +
import XMonad.Actions.Warp
  +
import XMonad.Hooks.DynamicLog
  +
import XMonad.Hooks.EwmhDesktops
  +
import XMonad.Hooks.ManageDocks
  +
import XMonad.Hooks.ManageHelpers
  +
import XMonad.Hooks.UrgencyHook
  +
import XMonad.Layout.BoringWindows
  +
import XMonad.Layout.Drawer
  +
import XMonad.Layout.Grid
  +
import XMonad.Layout.IM
  +
import XMonad.Layout.LayoutHints
  +
import XMonad.Layout.LayoutModifier
  +
import XMonad.Layout.Magnifier
  +
import XMonad.Layout.Master
  +
import XMonad.Layout.Mosaic
  +
import XMonad.Layout.MosaicAlt
  +
import XMonad.Layout.MouseResizableTile
  +
import XMonad.Layout.Named
  +
import XMonad.Layout.NoBorders
  +
import XMonad.Layout.PerWorkspace
  +
import XMonad.Layout.Simplest
  +
import XMonad.Layout.SimplestFloat
  +
import XMonad.Layout.SubLayouts
  +
import XMonad.Layout.Tabbed
  +
import XMonad.Layout.TrackFloating
  +
import XMonad.Layout.WindowNavigation
  +
import XMonad.Prompt
  +
import XMonad.Prompt.RunOrRaise
  +
import XMonad.Prompt.Ssh
  +
import XMonad.Prompt.Window
  +
import XMonad.Prompt.XMonad
  +
import XMonad.Util.EZConfig
  +
import XMonad.Util.Replace
  +
import XMonad.Util.Run
   
-- import XMonad.Layout.Manual
 
   
 
main :: IO ()
 
main :: IO ()
 
main = do
 
main = do
sp <- mkSpawner
+
replace
let ?spawner = sp
 
 
checkTopicConfig myTopics myTopicConfig
 
checkTopicConfig myTopics myTopicConfig
xmonad . withUrgencyHook NoUrgencyHook . myConfig
+
let urgency
=<< mapM xmobarScreen
+
| True = withUrgencyHook FocusHook
=<< getScreens
+
| True = withUrgencyHook NoUrgencyHook
  +
xmonad . ewmh . urgency . myConfig
  +
=<< mapM xmobarScreen =<< getScreens
   
myConfig hs = addDescrKeys ((mod4Mask, xK_d), xMessage) myKeys $ defaultConfig
+
sofficeToolbox = className =? "OpenOffice.org 3.1"
{ layoutHook = myLayout
+
<&&> isInProperty "WM_PROTOCOLS" "WM_TAKE_FOCUS"
, focusedBorderColor = "#ff0000"
+
  +
myConfig hs = let c = defaultConfig {
  +
layoutHook = myLayout
  +
, focusFollowsMouse = False
  +
, focusedBorderColor = "red"
  +
, startupHook = do
  +
return () -- supposedly to avoid inf. loops with checkKeymap
  +
checkKeymap (myConfig []) (myKeys c)
 
, terminal = "urxvt"
 
, terminal = "urxvt"
 
, modMask = mod4Mask
 
, modMask = mod4Mask
, logHook = ewmhDesktopsLogHook >> myLogHook hs
+
, logHook = do
, startupHook = refresh -- help avoidStruts
+
multiPP'
, handleEventHook = ewmhDesktopsEventHook
+
(mergePPOutputs [XMonad.Actions.TopicSpace.pprWindowSet myTopicConfig,
  +
dynamicLogString . onlyTitle])
  +
myPP
  +
myPP{ ppTitle = const "" }
  +
hs
  +
updatePointer (TowardsCentre 0.2 0.2)
  +
, handleEventHook = ewmhDesktopsEventHook <+> fullscreenEventHook <+> focusFollow <+>
  +
(\e -> case e of
  +
PropertyEvent{ ev_window = w } -> do
  +
isURXVT <- runQuery (className =? "URxvt") w
  +
if not isURXVT then hintsEventHook e else return (All True)
  +
_ -> return (All True))
 
, workspaces = myTopics
 
, workspaces = myTopics
, manageHook = composeAll
+
, manageHook = mconcat
[ manageSpawn ?spawner
+
[manageSpawn
, manageDocks
+
,isFullscreen --> doFullFloat
, fmap (isInfixOf "Gran Paradiso") className --> doShift "web"
+
-- ,className =? "MPlayer" --> doFullFloat
]
+
,className =? "XTerm" --> queryMerge (className =? "XTerm")
}
+
,manageDocks
-- where ?spawner = ?spawner
+
]
  +
} in additionalKeysP c (myKeys c)
   
 
myXPConfig :: XPConfig
 
myXPConfig :: XPConfig
 
myXPConfig = greenXPConfig { font = "xft:Profont:pixelsize=15:autohint=true" }
 
myXPConfig = greenXPConfig { font = "xft:Profont:pixelsize=15:autohint=true" }
   
-------------------- Layout ----------------------------------
+
gsConfig = defaultGSConfig { gs_navigate = fix $ \self ->
myLayout = workspaceDir "~"
+
let navKeyMap = M.mapKeys ((,) 0) $ M.fromList $
$ named "M" mosaic ||| named "F" (noBorders Full)
+
[(xK_Escape, cancel)
where
+
,(xK_Return, select)
mosaic = avoidStruts
+
,(xK_slash , substringSearch self)]
$ lessBorders Screen
+
++
$ addTabs shrinkText defaultTheme
+
map (\(k,a) -> (k,a >> self))
$ configurableNavigation (navigateColor "#ffff00")
+
[(xK_Left , move (-1,0 ))
$ boringWindows
+
,(xK_h , move (-1,0 ))
$ subLayout [] (Simplest ||| Tall 1 (1%6) 0.5)
+
,(xK_n , move (-1,0 ))
$ layoutHints2 -- unfinished modifications to layoutHints: ask if you want this
+
,(xK_Right , move (1,0 ))
$ Mosaic [5,4,2,1,1,1]
+
,(xK_l , move (1,0 ))
-- $ manual 0.5
+
,(xK_i , move (1,0 ))
  +
,(xK_Down , move (0,1 ))
  +
,(xK_j , move (0,1 ))
  +
,(xK_e , move (0,1 ))
  +
,(xK_Up , move (0,-1 ))
  +
,(xK_u , move (0,-1 ))
  +
,(xK_y , move (-1,-1))
  +
,(xK_m , move (1,-1 ))
  +
,(xK_space , setPos (0,0))
  +
]
  +
in makeXEventhandler $ shadowWithKeymap navKeyMap (const self) }
   
--------------------------------------------------------------
+
data ExpandEdges a = ExpandEdges Int deriving (Read,Show)
   
  +
instance LayoutModifier ExpandEdges Window where
  +
modifyLayout (ExpandEdges n) ws (Rectangle x y w h) = let
  +
bigRect = Rectangle (x - fromIntegral n) (y - fromIntegral n)
  +
(w + 2*fromIntegral n) (h + 2*fromIntegral n)
  +
in
  +
runLayout ws bigRect
  +
  +
-- | push edges off-screen
  +
expandEdges n layout = ModifiedLayout (ExpandEdges n) layout
  +
  +
  +
  +
-------------------- Layout ----------------------------------
  +
myLayout =
  +
trackFloating . smartBorders
  +
. onWorkspace "movie" (magnifier m ||| layoutHints Full)
  +
. avoidStruts
  +
. onWorkspace "test" (multimastered 2 (1/100) (1/2) Grid)
  +
. onWorkspace "gimp" (named "G" gimp)
  +
. onWorkspace "xm-conf" ((nav $ ModifiedLayout (ExpandEdges 1) (Tall 1 0.3 0.5)) ||| Full)
  +
$ m ||| named "F" (noBorders Full)
  +
where nav = configurableNavigation (navigateColor "#ffff00")
  +
m = named "M"
  +
. lessBorders Screen
  +
. layoutHintsToCenter
  +
. addTabs shrinkText defaultTheme
  +
. nav
  +
. boringAuto
  +
. subLayout [] (Simplest ||| simplestFloat)
  +
$ mosaic 1.5 [7,5,2]
  +
gimp = nav
  +
. onLeft (simpleDrawer 0.01 0.3 $ Role "gimp-toolbox")
  +
. withIM 0.15 (Role "gimp-dock")
  +
. addTabs shrinkText defaultTheme
  +
. nav
  +
. boringAuto
  +
. subLayout [] Simplest
  +
$ mouseResizableTile ||| Full
  +
--------------------------------------------------------------
 
-------------------- Keys ------------------------------------
 
-------------------- Keys ------------------------------------
myKeys :: (?spawner::Spawner) =>XConfig t -> [((KeyMask, KeySym), NamedAction)]
+
myKeys c =
myKeys c@(XConfig { modMask = modm }) =
+
[("M-<Left>" , withFocused $ snapMove L Nothing )
[ subtitle "Resizing"
+
,("M-<Right>" , withFocused $ snapMove R Nothing )
,((modm, xK_h), addName "Shrink" $ sendMessage . SlopeMod $ zipWith (+) (map (/5) [1..]))
+
,("M-<Up>" , withFocused $ snapMove U Nothing )
,((modm, xK_l), addName "Expand" $ sendMessage . SlopeMod $ (\(x:xs) -> max 1 x:xs) . map (max 0.05) . zipWith subtract (map (/5) [1..]))
+
,("M-<Down>" , withFocused $ snapMove D Nothing )
,((modm .|. shiftMask, xK_h), addName "Show Less Windows" $ sendMessage $ SlopeMod init)
+
,("M-S-<Left>" , withFocused $ snapShrink R Nothing)
,((modm .|. shiftMask, xK_l), addName "Show More Windows" $ sendMessage $ SlopeMod (++[1]))
+
,("M-S-<Right>", withFocused $ snapGrow R Nothing)
  +
,("M-S-<Up>" , withFocused $ snapShrink D Nothing)
  +
,("M-S-<Down>" , withFocused $ snapGrow D Nothing)
   
, subtitle "SubLayouts"
+
, ("M-l", withFocused (sendMessage . expandWindowAlt) >> sendMessage Expand)
,((modm .|. controlMask, xK_o), addName "unmerge the current window"
+
, ("M-h", withFocused (sendMessage . shrinkWindowAlt) >> sendMessage Shrink)
$ 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"
+
,("M-;", withFocused (sendMessage . tallWindowAlt) >> sendMessage Taller)
,((modm, xK_semicolon), addName "Taller" $ sendMessage Taller)
+
,("M-o", withFocused (sendMessage . wideWindowAlt) >> sendMessage Wider )
,((modm, xK_o), addName "Wider" $ sendMessage Wider)
 
   
, subtitle "Submaps"
+
,("M-v", toggleFF)
,((modm, xK_x), submapName $ subMaps)
 
,((modm, xK_s), addName "send a normal action to a sublayout" $ submap $ defaultSublMap c)
 
   
, subtitle "Focus"
+
,("M-S-b", restart "/home/aavogt/bin/obtoxmd" True)
,((modm .|. shiftMask, xK_Right), addName "slide to the next ws" $ shiftToNext >> nextWS)
+
,("M-S-d", restart "urxvt -e xmonad" False)
,((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_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"
+
,("M-S-o" , withFocused $ sendMessage . UnMerge )
,((modm .|. shiftMask, xK_a), addName "run the topic's action" $ currentTopicAction myTopicConfig)
+
,("M-S-C-o", withFocused $ sendMessage . UnMergeAll)
,((modm, xK_a), addName "gridselect a window" $ goToSelected defaultGSConfig)
+
,("M-C-m" , withFocused $ sendMessage . MergeAll )
,((modm, xK_Tab), addName "view the last workspace" $ switchNthLastFocused myTopicConfig 1)
+
,("M-C-." , onGroup W.focusDown')
,((modm, xK_g ), addName "go to topic" promptedGoto)
+
,("M-C-," , onGroup W.focusUp' )
   
, separator
+
,("M-p", shellPromptHere myXPConfig)
,((modm, xK_Return), addName "promote to master" $ dwmpromote)
+
,("M-x", submap $ M.fromList subMaps)
,((modm .|. shiftMask, xK_Return), addName "terminal" spawnShell)
+
,("M-g", submap $ defaultSublMap c )
,((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")
 
   
  +
,("M-S-.", focusDown)
  +
,("M-S-,", focusUp )
  +
  +
,("M-S-a", currentTopicAction myTopicConfig)
  +
,("M-a", warpToCentre >> goToSelected gsConfig)
  +
-- workaround
  +
,("M-<Tab>", switchNthLastFocused myTopicConfig . succ . length . W.visible . windowset =<< get )
  +
  +
,("M-s" , warpToCentre >> promptedGoto )
  +
,("M-S-s", warpToCentre >> 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 ':m +XMonad Control.Monad System.Exit' -e 'flip unless exitFailure =<< recompile False' && xmonad --restart")
  +
,("M-S-q", spawn "~/wip/x11-wm/xmonad/rebuild.sh")
  +
,("<Print>", spawn "scrot")
 
]
 
]
^++^ [subtitle "WindowNavigation"] ^++^
+
++
concatMap (\(m,(n,f)) -> lrud (modm .|. m) (\d -> addName (n ++ ' ':show d) $ f d))
+
concatMap (\(m,f) -> lrud ("M-"++m) f)
[(shiftMask, ("swap",sendMessage . Swap))
+
[("S-" , sendMessage . Swap)
,(controlMask, ("pull group",sendMessage . pullGroup))
+
,("C-" , sendMessage . pullGroup)
,(0, ("change focus", sendMessage . Go))
+
,("S-C-", sendMessage . pushWindow)
]
+
,("" , sendMessage . Go)]
^++^ [subtitle "Media Keys"] ^++^ mediaKeys
+
++ mediaKeys ++
^++^ [subtitle "Workspaces"] ^++^
+
[("M-"++m++[key], screenWorkspace sc >>= flip whenJust (windows . f))
[((m .|. modm, key), addName (unwords [d,"workspace",show sc]) $ screenWorkspace sc >>= flip whenJust (windows . f)) |
+
| (f, m) <- [(W.view, ""), (W.shift, "S-")]
(f, m, d) <- [(W.view, 0, "view"), (W.shift, shiftMask, "shift to")],
+
, (key, sc) <- zip "wf" [0 .. ]]
(key, sc) <- zip [xK_w, xK_f, xK_p] ([0 .. ])]
+
++
^++^
+
[ ("M-"++m++[k], a i)
[ ((modm, k), addName (unwords ["view the last",show i,"topic"]) $ switchNthLastFocused myTopicConfig i)
+
| (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 -> (Direction2D -> 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 = map (\x -> m ++ [x]) "niue"
 
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), runOrRaisePrompt myXPConfig),
subMaps = [((0, xK_o), addName "run or raise prompt" $ runOrRaisePrompt myXPConfig),
+
((0, xK_p), shellPromptHere myXPConfig),
((0, xK_p), addName "shell prompt" $ shellPrompt myXPConfig),
+
((0, xK_x), xmonadPrompt myXPConfig),
((0, xK_x), addName "xmonad prompt" $ xmonadPrompt myXPConfig),
+
((0, xK_z), sshPrompt myXPConfig),
((0, xK_z), addName "ssh prompt" $ sshPrompt myXPConfig),
+
((shiftMask, xK_w), windowPromptGoto myXPConfig),
((shiftMask, xK_w), addName "window gotoPrompt" $ windowPromptGoto myXPConfig),
+
((0, xK_w), promptSearch myXPConfig wikipedia),
((0, xK_w), addName "search wikipedia" $ promptSearch myXPConfig wikipedia),
+
((0, xK_s), promptSearch myXPConfig multi),
((0, xK_s), addName "search multi" $ promptSearch myXPConfig multi),
+
((0, xK_m), promptSearch myXPConfig mathworld),
((0, xK_m), addName "search mathworld" $ promptSearch myXPConfig mathworld),
+
((0, xK_b), sendMessage ToggleStruts),
((0, xK_d), addName "change dir" $ changeDir myXPConfig),
+
((0, xK_f), withFocused $ windows . W.sink),
((0, xK_b), sendMessage' ToggleStruts),
+
((0, xK_v), refresh),
((0, xK_f), addName "sink" $ withFocused $ windows . W.sink),
+
((0, xK_c), asks config >>= spawnHere . terminal),
((0, xK_v), addName "refresh" refresh),
+
((0, xK_k), kill)
((0, xK_c), addName "terminal" $ asks config >>= spawnHere ?spawner . terminal),
 
((0, xK_k), addName "close window" kill)
 
 
]
 
]
   
mediaKeys :: [((KeyMask, KeySym), NamedAction)]
 
mediaKeys = [((0, xF86XK_AudioPlay), mpcAct "toggle"),
 
((shiftMask, xF86XK_AudioPlay), 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_AudioPrev), mpcAct "prev"),
 
((0, xF86XK_AudioMute), addName "toggle mute" $ spawn "~/bin/ossvol -t"),
 
((shiftMask, xF86XK_AudioMute), addName "toggle external speakers" $ spawn "~/bin/speakers.sh"),
 
((0, xF86XK_AudioLowerVolume), spawn' "~/bin/ossvol -d 1"),
 
((shiftMask, xF86XK_AudioLowerVolume), spawn' "~/bin/ossvol -d 0.1"),
 
((0, xF86XK_AudioRaiseVolume), spawn' "~/bin/ossvol -i 1"),
 
((shiftMask, xF86XK_AudioRaiseVolume), spawn' "~/bin/ossvol -i 0.1"),
 
((0, xF86XK_Sleep), spawn' "sudo pm-suspend"),
 
((shiftMask, xF86XK_Sleep), spawn' "sudo pm-hibernate")]
 
where mpcAct c = addName ("mpc " ++ c) $ do
 
p <- maybeToList . fmap ("export MPD_HOST=" `wrap` ";") <$> getStringProp "MPD_HOST"
 
spawn . unwords $ p ++ ["mpc",c]
 
   
-- Prompt for host
+
amarok = False
data HostPrompt = HostPrompt
 
instance XPrompt HostPrompt where showXPrompt _ = "Pick MPD Host: "
 
hostPrompt = mkXPrompt HostPrompt myXPConfig (return . compl) (setStringProp "MPD_HOST")
 
where compl s = nub $ filter (s `isPrefixOf`) ["localhost","dell"]
 
   
  +
mediaKeys = [("<XF86AudioPlay>", do mpcAct "toggle"; when amarok $ spawn "amarok -t"),
  +
("<XF86AudioStop>", promptHost),
  +
("<XF86AudioNext>", do mpcAct "next"; when amarok $ spawn "amarok -f"),
  +
("<XF86AudioPrev>", do mpcAct "prev"; when amarok $ spawn "amarok -r"),
  +
("<XF86AudioMute>", spawn "ossmix vmix0-outvol 0"),
  +
("<XF86AudioLowerVolume>", spawn "amixer sset PCM 1-"),
  +
("<XF86AudioRaiseVolume>", spawn "amixer sset PCM 1+"),
  +
("<XF86Sleep>", spawn "sudo pm-suspend")
  +
]
  +
where mpcAct c = do
  +
h <- XS.gets hostPrompt
  +
spawn $ unwords ["export MPD_HOST="++h,";","mpc",c]
  +
  +
-- Prompt for mpd host
  +
newtype HostPrompt = HostPrompt { hostPrompt :: String } deriving (Read,Show,Typeable)
  +
instance ExtensionClass HostPrompt where
  +
initialValue = HostPrompt "/home/aavogt/.mpd/socket"
  +
extensionType = PersistentExtension
  +
  +
instance XPrompt HostPrompt where showXPrompt _ = "Pick MPD Host: "
  +
promptHost = mkXPrompt (HostPrompt "") myXPConfig (return . compl) (XS.put . HostPrompt)
  +
where compl s = nub $ filter (s `isPrefixOf`) ["127.0.0.1","dell"]
 
--------------------------------------------------------------
 
--------------------------------------------------------------
  +
  +
warpToCentre = gets (W.screen . W.current . windowset) >>= \x -> warpToScreen x 0.5 0.5
   
 
-------------------- Support for per-screen xmobars ---------
 
-------------------- Support for per-screen xmobars ---------
-- Some parts of this will merged into contrib sometime
+
-- Some parts of this should be merged into contrib sometime
 
getScreens :: IO [Int]
 
getScreens :: IO [Int]
getScreens = withDisplay' $ fmap (enumFromTo 0 . pred . length) . getScreenInfo
+
getScreens = openDisplay "" >>= liftA2 (<*) f closeDisplay
where withDisplay' f = do
+
where f = fmap (zipWith const [0..]) . getScreenInfo
x <- openDisplay ""
 
res <- f x
 
closeDisplay x
 
return res
 
   
-- | Output to each handle what would be seen when viewing the screen with that
+
multiPP :: PP -- ^ The PP to use if the screen is focused
-- index. If the workspace is focused use the first PP, otherwise use the
+
-> PP -- ^ The PP to use otherwise
-- second PP.
+
-> [Handle] -- ^ Handles for the status bars, in order of increasing X
multiPP :: PP -> PP -> [Handle] -> X ()
+
-- screen number
  +
-> X ()
 
multiPP = multiPP' dynamicLogString
 
multiPP = multiPP' dynamicLogString
   
Line 165: Line 280:
 
multiPP' dynlStr focusPP unfocusPP handles = do
 
multiPP' dynlStr focusPP unfocusPP handles = do
 
state <- get
 
state <- get
let takeLength = zipWith const
+
let pickPP :: WorkspaceId -> WriterT (Last XState) X String
viewWs n = put state { windowset = W.view n $ windowset state }
+
pickPP ws = do
focused = W.tag . W.workspace . W.current $ windowset state
+
let isFoc = (ws ==) . W.tag . W.workspace . W.current $ windowset state
choosePP w = if w == focused then focusPP else unfocusPP
+
put state{ windowset = W.view ws $ windowset state }
io . zipWithM_ hPutStrLn handles
+
out <- lift $ dynlStr $ if isFoc then focusPP else unfocusPP
=<< mapM (\w -> viewWs w >> dynlStr (choosePP w)) . catMaybes
+
when isFoc $ get >>= tell . Last . Just
=<< mapM screenWorkspace ([0..] `takeLength` handles)
+
return out
put state
+
traverse put . getLast
  +
=<< execWriterT . (io . zipWithM_ hPutStrLn handles <=< mapM pickPP) . catMaybes
  +
=<< mapM screenWorkspace (zipWith const [0..] handles)
  +
return ()
   
mergePPOutputs :: PP -> [PP -> X String] -> X String
+
mergePPOutputs :: [PP -> X String] -> PP -> X String
mergePPOutputs pp = fmap (intercalate (ppSep pp)) . sequence . map ($ pp)
+
mergePPOutputs x pp = fmap (intercalate (ppSep pp)) . sequence . sequence x $ pp
   
 
onlyTitle :: PP -> PP
 
onlyTitle :: PP -> PP
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), otherwise you have to use
  +
-- 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
 
myLogHook :: (?spawner::Spawner) => [Handle] -> X ()
 
myLogHook = multiPP'
 
(flip mergePPOutputs [pprWindowSet myTopicConfig,dynamicLogString . onlyTitle])
 
myPP { ppTitle = xmobarColor "orange" "" }
 
myPP { ppTitle = const "" }
 
   
 
myPP :: PP
 
myPP :: PP
myPP = defaultPP
+
myPP = sjanssenPP { ppLayout = xmobarColor "orange" "", ppUrgent = xmobarColor "red" "" . ('^':) }
{ ppCurrent = xmobarColor "white" ""
 
, ppSep = " : "
 
, ppLayout = xmobarColor "green" ""
 
, ppVisible = xmobarColor "white" "" . wrap "(" ")"
 
, ppUrgent = xmobarColor "red" "" . ("^"++)}
 
 
--------------------------------------------------------------
 
--------------------------------------------------------------
   
Line 191: Line 306:
 
myTopics :: [Topic]
 
myTopics :: [Topic]
 
myTopics =
 
myTopics =
[ "dashboard" -- the first one
+
[ "a"
, "admin", "build", "cleaning", "conf", "darcs", "haskell", "irc"
+
, "web"
, "mail", "movie", "music", "talk", "text", "tools", "web"
+
, "haskell"
, "yi", "documents", "pdf", "xmobar", "xmonad-conf", "xmonad-newconfig", "xmonad-contrib"
+
, "mail"
, "gtk-gnutella"
+
, "irc"
  +
, "xm-conf"
  +
, "gimp"
  +
, "gitit"
  +
, "admin"
  +
, "movie"
  +
, "music"
  +
, "pdf"
  +
, "doc"
  +
, "xmc"
  +
, "xme"
  +
, "xm"
  +
, "xmobar"
  +
, "wip"
  +
, "test"
 
]
 
]
   
myTopicConfig :: (?spawner::Spawner) => TopicConfig
+
 
myTopicConfig = TopicConfig
 
myTopicConfig = TopicConfig
 
{ topicDirs = M.fromList $
 
{ topicDirs = M.fromList $
[ ("conf", "conf")
+
[ ("a", "./")
, ("dashboard", "./")
 
, ("yi", "wip/dev-haskell/yi")
 
, ("darcs", "wip/dev-haskell/darcs")
 
 
, ("haskell", "haskell")
 
, ("haskell", "haskell")
, ("xmonad-conf", ".xmonad")
+
, ("xm-conf", ".xmonad")
, ("xmonad-newconfig", "wip/x11-wm/xmonad/core/xmonad-newconfig")
+
, ("xme", "wip/x11-wm/xmonad/extras/xmonad-extras/XMonad")
, ("xmonad-contrib", "wip/x11-wm/xmonad/contrib/XMonadContrib/XMonad")
+
, ("xm", "wip/x11-wm/xmonad/core/xmonad")
  +
, ("xmc", "wip/x11-wm/xmonad/contrib/XMonadContrib/XMonad")
 
, ("xmobar", "wip/x11-wm/xmobar")
 
, ("xmobar", "wip/x11-wm/xmobar")
, ("tools", "wip/tools")
 
 
, ("movie", "media/movie")
 
, ("movie", "media/movie")
 
, ("music", "media/music")
 
, ("music", "media/music")
, ("documents", "doc")
+
, ("doc", "doc")
 
, ("pdf", "ref")
 
, ("pdf", "ref")
, ("gtk-gnutella", ".gtk-gnutella-downloads")
+
, ("gitit", "wip/gitit")
  +
, ("gimp", "./")
  +
, ("wip", "wip")
 
]
 
]
 
, defaultTopicAction = const $ spawnShell >*> 2
 
, defaultTopicAction = const $ spawnShell >*> 2
, defaultTopic = "dashboard"
+
, defaultTopic = "a"
 
, maxTopicHistory = 10
 
, maxTopicHistory = 10
 
, topicActions = M.fromList $
 
, topicActions = M.fromList $
[ ("haskell", spawnShell >*> 2 >>
+
[ ("xm-conf", spawnShellIn ".xmonad/lib/XMonad/Layout" >>
spawnShellIn "wip/dev-haskell/ghc")
 
, ("xmonad-conf", spawnShellIn ".xmonad/lib/XMonad/Layout" >>
 
 
spawn "urxvt -e vim ~/.xmonad/xmonad.hs")
 
spawn "urxvt -e vim ~/.xmonad/xmonad.hs")
, ("xmonad-contrib", spawnShell >*> 2)
+
, ("xmc" , 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)
, ("xmobar", spawnShellIn "wip/x11-wm/xmobar/Plugins" >*> 2)
+
, ("music" , spawn "urxvt -e ncmpc -h /home/aavogt/.mpd/socket" >> spawn "export MPD_HOST=192.168.1.2; mpc && urxvt -e ncmpc -h 192.168.1.2")
, ("music", spawn "urxvt -e ncmpc" >> spawn "urxvt -e ncmpc -h 192.168.1.2")
+
, ("mail" , spawnOn "mail" "urxvt -e mutt")
, ("mail", spawn "urxvt -e mutt")
+
, ("irc" , spawnOn "irc" "urxvt --title irc -e ssh engage")
, ("irc", spawn "urxvt -e ssh aavogt@engage.uwaterloo.ca")
+
, ("web" , spawnOn "web" "firefox")
, ("dashboard", spawnShell)
+
, ("pdf" , spawnOn "pdf" "okular")
, ("web", spawn "firefox")
+
, ("gimp" , spawnHere "gimp")
, ("movie", spawnShell)
 
, ("pdf", spawn "okular >&| /dev/null")
 
, ("gtk-gnutella", spawn "gtk-gnutella")
 
 
]
 
]
 
}
 
}
   
 
-- From the sample config in TopicSpace, these should probably be exported from that module
 
-- From the sample config in TopicSpace, these should probably be exported from that module
spawnShell :: (?spawner::Spawner) => X ()
 
 
spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
 
spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
   
spawnShellIn :: (?spawner::Spawner) => [Char] -> X ()
+
spawnShellIn dir = do
spawnShellIn dir = asks (terminal . config) >>= \term -> spawnHere ?spawner $ "cd " ++ dir ++ " && " ++ term ++ " "
+
-- color <- randomBg' (HSV 255 255)
  +
t <- asks (terminal . config)
  +
spawnHere $ "cd " ++ dir ++ " && " ++ t -- ++ " -bg " ++ color
  +
  +
wsgrid = gridselect gsConfig <=< 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)
  +
--------------------------------------------------------------------------------
  +
  +
--------------------------------------------------------------------------------
  +
-- A nice little example of extensiblestate
  +
newtype FocusFollow = FocusFollow {getFocusFollow :: Bool } deriving (Typeable,Read,Show)
  +
instance ExtensionClass FocusFollow where
  +
initialValue = FocusFollow True
  +
extensionType = PersistentExtension
  +
  +
-- this eventHook is the same as from xmonad for handling crossing events
  +
focusFollow e@(CrossingEvent {ev_window=w, ev_event_type=t})
  +
| t == enterNotify, ev_mode e == notifyNormal =
  +
whenX (XS.gets getFocusFollow) (focus w) >> return (All True)
  +
focusFollow _ = return (All True)
  +
  +
toggleFF = XS.modify $ FocusFollow . not . getFocusFollow
  +
--------------------------------------------------------------------------------
  +
  +
{- | Sometimes this picks the wrong element to merge into (that is, not the
  +
'focused' element of the group), and SubLayouts breaks up the whole group
  +
-}
  +
queryMerge pGrp = do
  +
w <- ask
  +
aws <- liftX $ filterM (runQuery pGrp) =<< gets
  +
(W.integrate' . W.stack . W.workspace . W.current . windowset)
  +
  +
let addRem = False -- run the query with window removed??
  +
when addRem
  +
(liftX $ modify (\ws -> ws { windowset = W.insertUp w (windowset ws) }))
  +
liftX $ windows (W.insertUp w)
   
goto :: (?spawner::Spawner) => Topic -> X ()
+
mapM_ (liftX . sendMessage . XMonad.Layout.SubLayouts.Merge w) aws
goto = switchTopic myTopicConfig
 
   
promptedGoto :: (?spawner::Spawner) => X ()
+
when addRem
promptedGoto = workspacePrompt myXPConfig goto
+
(liftX $ modify (\ws -> ws { windowset = W.delete' w (windowset ws) }))
   
promptedShift :: X ()
+
idHook
promptedShift = workspacePrompt myXPConfig $ windows . W.shift
 
 
</haskell>
 
</haskell>

Latest revision as of 16:00, 31 December 2010

Xmonad/Config archive/adamvo's xmobarrc (0.9.2)

Xmonad/Config archive/obtoxmd -- script called to temporarily run another wm

-- current darcs as of 2010-12-31
{-# LANGUAGE
     DeriveDataTypeable,
     FlexibleContexts,
     FlexibleInstances,
     MultiParamTypeClasses,
     NoMonomorphismRestriction,
     PatternGuards,
     ScopedTypeVariables,
     TypeSynonymInstances,
     UndecidableInstances
     #-}
{-# OPTIONS_GHC -W -fwarn-unused-imports -fno-warn-missing-signatures #-}
 
import Control.Applicative
import Control.Monad
import Control.Monad.Instances ()
import Control.Monad.Writer
import Data.List
import Data.Maybe
import Data.Traversable(traverse)
import Graphics.X11.Xinerama
import qualified Data.Map as M
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import System.IO
import XMonad
import XMonad.Actions.DwmPromote
import XMonad.Actions.FloatSnap
import XMonad.Actions.GridSelect
import XMonad.Actions.Search
import XMonad.Actions.SpawnOn
import XMonad.Actions.Submap
import XMonad.Actions.TopicSpace
import XMonad.Actions.UpdatePointer
import XMonad.Actions.Warp
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.EwmhDesktops
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
import XMonad.Hooks.UrgencyHook
import XMonad.Layout.BoringWindows
import XMonad.Layout.Drawer
import XMonad.Layout.Grid
import XMonad.Layout.IM
import XMonad.Layout.LayoutHints
import XMonad.Layout.LayoutModifier
import XMonad.Layout.Magnifier
import XMonad.Layout.Master
import XMonad.Layout.Mosaic
import XMonad.Layout.MosaicAlt
import XMonad.Layout.MouseResizableTile
import XMonad.Layout.Named
import XMonad.Layout.NoBorders
import XMonad.Layout.PerWorkspace
import XMonad.Layout.Simplest
import XMonad.Layout.SimplestFloat
import XMonad.Layout.SubLayouts
import XMonad.Layout.Tabbed
import XMonad.Layout.TrackFloating
import XMonad.Layout.WindowNavigation
import XMonad.Prompt
import XMonad.Prompt.RunOrRaise
import XMonad.Prompt.Ssh
import XMonad.Prompt.Window
import XMonad.Prompt.XMonad
import XMonad.Util.EZConfig
import XMonad.Util.Replace
import XMonad.Util.Run
 
 
main :: IO ()
main = do
    replace
    checkTopicConfig myTopics myTopicConfig
    let urgency
            | True = withUrgencyHook FocusHook
            | True = withUrgencyHook NoUrgencyHook
    xmonad . ewmh . urgency . myConfig
        =<< mapM xmobarScreen =<< getScreens
 
sofficeToolbox = className =? "OpenOffice.org 3.1"
                <&&> isInProperty "WM_PROTOCOLS" "WM_TAKE_FOCUS"
 
myConfig hs = let c = defaultConfig {
      layoutHook = myLayout
    , focusFollowsMouse = False
    , focusedBorderColor = "red"
    , startupHook = do
        return () -- supposedly to avoid inf. loops with checkKeymap
        checkKeymap (myConfig []) (myKeys c)
    , terminal = "urxvt"
    , modMask = mod4Mask
    , logHook = do
        multiPP'
            (mergePPOutputs [XMonad.Actions.TopicSpace.pprWindowSet myTopicConfig,
                             dynamicLogString . onlyTitle])
            myPP
            myPP{ ppTitle = const "" }
            hs
        updatePointer (TowardsCentre 0.2 0.2)
    , handleEventHook = ewmhDesktopsEventHook <+> fullscreenEventHook <+> focusFollow <+>
                    (\e -> case e of
                        PropertyEvent{ ev_window = w } -> do
                            isURXVT <- runQuery (className =? "URxvt") w
                            if not isURXVT then hintsEventHook e else return (All True)
                        _ -> return (All True))
    , workspaces = myTopics
    , manageHook = mconcat
                    [manageSpawn
                    ,isFullscreen --> doFullFloat
                    -- ,className =? "MPlayer" --> doFullFloat
                    ,className =? "XTerm" --> queryMerge (className =? "XTerm")
                    ,manageDocks
                    ]
    } in additionalKeysP c (myKeys c)
 
myXPConfig :: XPConfig
myXPConfig = greenXPConfig { font = "xft:Profont:pixelsize=15:autohint=true" }
 
gsConfig = defaultGSConfig { gs_navigate = fix $ \self ->
    let navKeyMap = M.mapKeys ((,) 0) $ M.fromList $
                [(xK_Escape, cancel)
                ,(xK_Return, select)
                ,(xK_slash , substringSearch self)]
           ++
            map (\(k,a) -> (k,a >> self))
                [(xK_Left  , move (-1,0 ))
                ,(xK_h     , move (-1,0 ))
                ,(xK_n     , move (-1,0 ))
                ,(xK_Right , move (1,0  ))
                ,(xK_l     , move (1,0  ))
                ,(xK_i     , move (1,0  ))
                ,(xK_Down  , move (0,1  ))
                ,(xK_j     , move (0,1  ))
                ,(xK_e     , move (0,1  ))
                ,(xK_Up    , move (0,-1 ))
                ,(xK_u     , move (0,-1 ))
                ,(xK_y     , move (-1,-1))
                ,(xK_m     , move (1,-1 ))
                ,(xK_space , setPos (0,0))
                ]
    in makeXEventhandler $ shadowWithKeymap navKeyMap (const self) }
 
data ExpandEdges a = ExpandEdges Int deriving (Read,Show)
 
instance LayoutModifier ExpandEdges Window where
    modifyLayout (ExpandEdges n) ws (Rectangle x y w h) = let
            bigRect = Rectangle (x - fromIntegral n) (y - fromIntegral n)
                                (w + 2*fromIntegral n) (h + 2*fromIntegral n)
        in
        runLayout ws bigRect
 
-- | push edges off-screen
expandEdges n layout = ModifiedLayout (ExpandEdges n) layout
 
 
 
-------------------- Layout ----------------------------------
myLayout =
         trackFloating . smartBorders
         . onWorkspace "movie" (magnifier m ||| layoutHints Full)
         . avoidStruts
         . onWorkspace "test" (multimastered 2 (1/100) (1/2) Grid)
         . onWorkspace "gimp" (named "G" gimp)
         . onWorkspace "xm-conf" ((nav $ ModifiedLayout (ExpandEdges 1) (Tall 1 0.3 0.5)) ||| Full)
         $ m ||| named "F" (noBorders Full)
    where nav = configurableNavigation (navigateColor "#ffff00")
          m = named "M"
            . lessBorders Screen
            . layoutHintsToCenter
            . addTabs shrinkText defaultTheme
            . nav
            . boringAuto
            . subLayout [] (Simplest ||| simplestFloat)
            $ mosaic 1.5 [7,5,2]
          gimp = nav
               . onLeft (simpleDrawer 0.01 0.3 $ Role "gimp-toolbox")
               . withIM 0.15 (Role "gimp-dock")
               . addTabs shrinkText defaultTheme
               . nav
               . boringAuto
               . subLayout [] Simplest
               $ mouseResizableTile ||| Full
--------------------------------------------------------------
-------------------- 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-l", withFocused (sendMessage . expandWindowAlt) >> sendMessage Expand)
    , ("M-h", withFocused (sendMessage . shrinkWindowAlt) >> sendMessage Shrink)
 
    ,("M-;", withFocused (sendMessage . tallWindowAlt) >> sendMessage Taller)
    ,("M-o", withFocused (sendMessage . wideWindowAlt) >> sendMessage Wider )
 
    ,("M-v", toggleFF)
 
    ,("M-S-b", restart "/home/aavogt/bin/obtoxmd" True)
    ,("M-S-d", restart "urxvt -e xmonad" False)
 
    ,("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-p",  shellPromptHere myXPConfig)
    ,("M-x", submap $ M.fromList subMaps)
    ,("M-g", submap $ defaultSublMap c  )
 
    ,("M-S-.", focusDown)
    ,("M-S-,", focusUp  )
 
    ,("M-S-a", currentTopicAction myTopicConfig)
    ,("M-a", warpToCentre >> goToSelected gsConfig)
    -- workaround
    ,("M-<Tab>", switchNthLastFocused myTopicConfig . succ . length . W.visible . windowset =<< get )
 
    ,("M-s"  , warpToCentre >> promptedGoto )
    ,("M-S-s", warpToCentre >> 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 ':m +XMonad Control.Monad System.Exit' -e 'flip unless exitFailure =<< recompile False' && 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 "wf" [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 -> (Direction2D -> b) -> [(String, b)]
lrud m cmd = zip ks cmds
    where
      ks   = map (\x -> m ++ [x]) "niue"
      cmds = zipWith ($) (repeat cmd) [L,R,U,D]
 
subMaps = [((0, xK_o),  runOrRaisePrompt myXPConfig),
           ((0, xK_p),  shellPromptHere 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 . terminal),
           ((0, xK_k), kill)
           ]
 
 
amarok = False
 
mediaKeys = [("<XF86AudioPlay>", do mpcAct "toggle"; when amarok $ spawn "amarok -t"),
             ("<XF86AudioStop>", promptHost),
             ("<XF86AudioNext>", do mpcAct "next"; when amarok $ spawn "amarok -f"),
             ("<XF86AudioPrev>", do mpcAct "prev"; when amarok $ spawn "amarok -r"),
             ("<XF86AudioMute>", spawn "ossmix vmix0-outvol 0"),
             ("<XF86AudioLowerVolume>",   spawn "amixer sset PCM 1-"),
             ("<XF86AudioRaiseVolume>",   spawn "amixer sset PCM 1+"),
             ("<XF86Sleep>", spawn "sudo pm-suspend")
             ]
    where mpcAct c = do
            h <- XS.gets hostPrompt
            spawn $ unwords ["export MPD_HOST="++h,";","mpc",c]
 
-- Prompt for mpd host
newtype HostPrompt = HostPrompt { hostPrompt :: String } deriving (Read,Show,Typeable)
instance ExtensionClass HostPrompt where
    initialValue = HostPrompt "/home/aavogt/.mpd/socket"
    extensionType = PersistentExtension
 
instance XPrompt HostPrompt where showXPrompt _ = "Pick MPD Host: "
promptHost = mkXPrompt (HostPrompt "") myXPConfig (return . compl) (XS.put . HostPrompt)
    where compl s = nub $ filter (s `isPrefixOf`) ["127.0.0.1","dell"]
--------------------------------------------------------------
 
warpToCentre = gets (W.screen . W.current . windowset) >>= \x -> warpToScreen x  0.5 0.5
 
-------------------- 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 -> WriterT (Last XState) X String
        pickPP ws = do
            let isFoc = (ws ==) . W.tag . W.workspace . W.current $ windowset state
            put state{ windowset = W.view ws $ windowset state }
            out <- lift $ dynlStr $ if isFoc then focusPP else unfocusPP
            when isFoc $ get >>= tell . Last . Just
            return out
    traverse put . getLast
        =<< execWriterT . (io . zipWithM_ hPutStrLn handles <=< mapM pickPP) . catMaybes
        =<< mapM screenWorkspace (zipWith const [0..] handles)
    return ()
 
mergePPOutputs :: [PP -> X String] -> PP -> X String
mergePPOutputs x pp = fmap (intercalate (ppSep pp)) . sequence . sequence x $ 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), 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" "", ppUrgent = xmobarColor "red" "" . ('^':) }
--------------------------------------------------------------
 
-------------------- X.Actions.TopicSpace --------------------
myTopics :: [Topic]
myTopics =
  [ "a"
  , "web"
  , "haskell"
  , "mail"
  , "irc"
  , "xm-conf"
  , "gimp"
  , "gitit"
  , "admin"
  , "movie"
  , "music"
  , "pdf"
  , "doc"
  , "xmc"
  , "xme"
  , "xm"
  , "xmobar"
  , "wip"
  , "test"
  ]
 
 
myTopicConfig = TopicConfig
  { topicDirs = M.fromList $
      [ ("a", "./")
      , ("haskell", "haskell")
      , ("xm-conf", ".xmonad")
      , ("xme", "wip/x11-wm/xmonad/extras/xmonad-extras/XMonad")
      , ("xm", "wip/x11-wm/xmonad/core/xmonad")
      , ("xmc", "wip/x11-wm/xmonad/contrib/XMonadContrib/XMonad")
      , ("xmobar", "wip/x11-wm/xmobar")
      , ("movie", "media/movie")
      , ("music", "media/music")
      , ("doc", "doc")
      , ("pdf", "ref")
      , ("gitit", "wip/gitit")
      , ("gimp", "./")
      , ("wip", "wip")
      ]
  , defaultTopicAction = const $ spawnShell >*> 2
  , defaultTopic = "a"
  , maxTopicHistory = 10
  , topicActions = M.fromList $
      [ ("xm-conf", spawnShellIn ".xmonad/lib/XMonad/Layout" >>
                        spawn "urxvt -e vim ~/.xmonad/xmonad.hs")
       , ("xmc"    , spawnShell >*> 2)
       , ("xmobar" , spawnShellIn "wip/x11-wm/xmobar/Plugins" >*> 2)
       , ("music"  , spawn "urxvt -e ncmpc -h /home/aavogt/.mpd/socket" >> spawn "export MPD_HOST=192.168.1.2; mpc && urxvt -e ncmpc -h 192.168.1.2")
       , ("mail"   , spawnOn "mail" "urxvt -e mutt")
       , ("irc"    , spawnOn "irc" "urxvt --title irc -e ssh engage")
       , ("web"    , spawnOn "web" "firefox")
       , ("pdf"    , spawnOn "pdf" "okular")
       , ("gimp"   , spawnHere "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 $ "cd " ++ dir ++ " && " ++ t -- ++ " -bg " ++ color
 
wsgrid = gridselect gsConfig <=< 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)
--------------------------------------------------------------------------------
 
--------------------------------------------------------------------------------
-- A nice little example of extensiblestate
newtype FocusFollow = FocusFollow {getFocusFollow :: Bool } deriving (Typeable,Read,Show)
instance ExtensionClass FocusFollow where
    initialValue = FocusFollow True
    extensionType = PersistentExtension
 
-- this eventHook is the same as from xmonad for handling crossing events
focusFollow e@(CrossingEvent {ev_window=w, ev_event_type=t})
                | t == enterNotify, ev_mode e == notifyNormal =
        whenX (XS.gets getFocusFollow) (focus w) >> return (All True)
focusFollow _ = return (All True)
 
toggleFF = XS.modify $ FocusFollow . not . getFocusFollow
--------------------------------------------------------------------------------
 
{- | Sometimes this picks the wrong element to merge into (that is, not the
'focused' element of the group), and SubLayouts breaks up the whole group
-}
queryMerge pGrp = do
    w <- ask
    aws <- liftX $ filterM (runQuery pGrp) =<< gets
        (W.integrate' . W.stack . W.workspace . W.current . windowset)
 
    let addRem = False -- run the query with window removed??
    when addRem
        (liftX $ modify (\ws -> ws { windowset = W.insertUp w (windowset ws) }))
    liftX $ windows (W.insertUp w)
 
    mapM_ (liftX . sendMessage . XMonad.Layout.SubLayouts.Merge w) aws
 
    when addRem
        (liftX $ modify (\ws -> ws { windowset = W.delete' w (windowset ws) }))
 
    idHook