Personal tools

Xmonad/Config archive/adamvo's xmonad.hs

From HaskellWiki

< Xmonad | Config archive(Difference between revisions)
Jump to: navigation, search
(update to use ezconfig for most bindings, and checkKeymap)
(updates for gridselect changes)
 
(11 intermediate revisions by one user not shown)
Line 1: Line 1:
 
[[Category:XMonad configuration]]
 
[[Category:XMonad configuration]]
 
[[../adamvo's xmobarrc]] (0.9.2)
 
[[../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 NoMonomorphismRestriction, ImplicitParams, FlexibleInstances #-}
+
{-# LANGUAGE
import XMonad
+
    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.StackSet as W
import qualified Data.Map as M
+
import qualified XMonad.Util.ExtensibleState as XS
 
+
import System.IO
-- 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 XMonad
import Control.Applicative(Applicative((<*>)), (<*), liftA2)
+
import XMonad.Actions.DwmPromote
import Control.Monad(Monad(return, (>>=), (>>)), Functor(..),
+
import XMonad.Actions.FloatSnap
                    (=<<), mapM, sequence, (<=<), guard, liftM, zipWithM_)
+
import XMonad.Actions.GridSelect
import Data.Function((.), const, ($), flip, id, on)
+
import XMonad.Actions.Search
import Data.IORef(IORef, newIORef, readIORef, modifyIORef)
+
import XMonad.Actions.SpawnOn
import Data.List((++), foldr, filter, zip, map, all, concatMap,
+
import XMonad.Actions.Submap
                length, repeat, tail, unzip, zipWith, maximum, unwords, isPrefixOf,
+
import XMonad.Actions.TopicSpace
                intercalate, maximumBy, nub)
+
import XMonad.Actions.UpdatePointer
import Data.Maybe(Maybe(..), maybe, catMaybes, fromMaybe,
+
import XMonad.Actions.Warp
                  maybeToList)
+
import XMonad.Hooks.DynamicLog
import Data.Monoid(Monoid(mconcat), All(All))
+
import XMonad.Hooks.EwmhDesktops
import System.IO(IO, Handle, hPutStrLn)
+
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.WMII
 
-- import XMonad.Layout.Manual
 
  
 
main :: IO ()
 
main :: IO ()
 
main = do
 
main = do
     spawner <- mkSpawner
+
     replace
    pressedKeys <- newIORef M.empty; let ?pressedKeys = pressedKeys
+
    let ?spawner = spawner
+
 
     checkTopicConfig myTopics myTopicConfig
 
     checkTopicConfig myTopics myTopicConfig
     xmonad . withUrgencyHook FocusHook . myConfig =<< mapM xmobarScreen =<< getScreens
+
     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 {
 
myConfig hs = let c = defaultConfig {
 
       layoutHook = myLayout
 
       layoutHook = myLayout
     , focusedBorderColor = "#ff0000"
+
    , focusFollowsMouse = False
     , startupHook = return () >> checkKeymap (myConfig []) (myKeys c) -- grabChords chords
+
     , 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 = do
 
     , logHook = do
        ewmhDesktopsLogHook
 
 
         multiPP'
 
         multiPP'
             (mergePPOutputs [pprWindowSet myTopicConfig,dynamicLogString . onlyTitle])
+
             (mergePPOutputs [XMonad.Actions.TopicSpace.pprWindowSet myTopicConfig,
 +
                            dynamicLogString . onlyTitle])
 
             myPP
 
             myPP
             myPP { ppTitle = const "" }
+
             myPP{ ppTitle = const "" }
 
             hs
 
             hs
 
         updatePointer (TowardsCentre 0.2 0.2)
 
         updatePointer (TowardsCentre 0.2 0.2)
     , handleEventHook = mconcat [
+
     , handleEventHook = ewmhDesktopsEventHook <+> fullscreenEventHook <+> focusFollow <+>
    --       manageKeypresses True $ mkChords 500 300 chords,
+
                    (\e -> case e of
            ewmhDesktopsEventHook]
+
                        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
                     -- fmap ("Shiretoko" `isInfixOf`) className --> doShift "web" <+> ,
+
                    [manageSpawn
                     manageSpawn ?spawner,
+
                     ,isFullscreen --> doFullFloat
                    isFullscreen --> doFullFloat,
+
                    -- ,className =? "MPlayer" --> doFullFloat
                     manageDocks]
+
                     ,className =? "XTerm" --> queryMerge (className =? "XTerm")
 +
                     ,manageDocks
 +
                    ]
 
     } in additionalKeysP c (myKeys c)
 
     } in additionalKeysP c (myKeys c)
  
Line 115: Line 125:
 
myXPConfig = greenXPConfig { font = "xft:Profont:pixelsize=15:autohint=true" }
 
myXPConfig = greenXPConfig { font = "xft:Profont:pixelsize=15:autohint=true" }
  
gsConfig = defaultGSConfig { gs_navigate = neiu `M.union` gs_navigate defaultGSConfig }
+
gsConfig = defaultGSConfig { gs_navigate = fix $ \self ->
     where neiu = M.map (\(x,y) (a,b) -> (x+a,y+b)) $ M.fromList
+
     let navKeyMap = M.mapKeys ((,) 0) $ M.fromList $
            [((0,xK_n),(-1,0))
+
                [(xK_Escape, cancel)
            ,((0,xK_e),(0,1))
+
                ,(xK_Return, select)
            ,((0,xK_i),(1,0))
+
                ,(xK_slash , substringSearch self)]
            ,((0,xK_u),(0,-1))]
+
          ++
 +
            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,))
 +
                ,(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 ----------------------------------
 
-------------------- Layout ----------------------------------
myLayout = avoidStruts $ named "M" m ||| named "F" (noBorders Full)
+
myLayout =
     where m = lessBorders Screen
+
        trackFloating . smartBorders
             $ layoutHintsToCenter
+
        . onWorkspace "movie" (magnifier m ||| layoutHints Full)
             $ addTabs shrinkText defaultTheme
+
        . avoidStruts
             $ configurableNavigation (navigateColor "#ffff00")
+
        . onWorkspace "test" (multimastered 2 (1/100) (1/2) Grid)
             $ boringAuto
+
        . onWorkspace "gimp" (named "G" gimp)
             $ subLayout [] Simplest
+
        . onWorkspace "xm-conf" ((nav $ ModifiedLayout (ExpandEdges 1) (Tall 1 0.3 0.5)) ||| Full)
             $ mosaic 1.5 [5,4,2]
+
        $ m ||| named "F" (noBorders Full)
            -- $ wmii 0.03 1.3
+
     where nav = configurableNavigation (navigateColor "#ffff00")
--            $ manual 0.2
+
          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 c =
 
myKeys c =
     [ ("M-<Left>"  , withFocused $ snapMove L Nothing  )
+
     [("M-<Left>"  , withFocused $ snapMove L Nothing  )
     , ("M-<Right>"  , withFocused $ snapMove R Nothing  )
+
     ,("M-<Right>"  , withFocused $ snapMove R Nothing  )
     , ("M-<Up>"    , withFocused $ snapMove U Nothing  )
+
     ,("M-<Up>"    , withFocused $ snapMove U Nothing  )
     , ("M-<Down>"  , withFocused $ snapMove D Nothing  )
+
     ,("M-<Down>"  , withFocused $ snapMove D Nothing  )
     , ("M-S-<Left>" , withFocused $ snapShrink R Nothing)
+
     ,("M-S-<Left>" , withFocused $ snapShrink R Nothing)
     , ("M-S-<Right>", withFocused $ snapGrow  R Nothing)
+
     ,("M-S-<Right>", withFocused $ snapGrow  R Nothing)
     , ("M-S-<Up>"  , withFocused $ snapShrink D Nothing)
+
     ,("M-S-<Up>"  , withFocused $ snapShrink D Nothing)
     , ("M-S-<Down>" , withFocused $ snapGrow  D Nothing)
+
     ,("M-S-<Down>" , withFocused $ snapGrow  D Nothing)
  
     , ("M-p", shellPromptHere ?spawner myXPConfig)
+
     , ("M-l", withFocused (sendMessage . expandWindowAlt) >> sendMessage Expand)
 +
    , ("M-h", withFocused (sendMessage . shrinkWindowAlt) >> sendMessage Shrink)
  
     -- , ((modm, xK_v), sendMessage $ Split 0.5 U)
+
     ,("M-;", withFocused (sendMessage . tallWindowAlt) >> sendMessage Taller)
     -- , ((modm .|. shiftMask, xK_v), addLeft)
+
     ,("M-o", withFocused (sendMessage . wideWindowAlt) >> sendMessage Wider )
     -- , ((modm .|. controlMask, xK_v), addRight)
+
 
 +
    ,("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-o"  , withFocused $ sendMessage . UnMerge  )
Line 157: Line 218:
 
     ,("M-C-,"  , onGroup W.focusUp'  )
 
     ,("M-C-,"  , onGroup W.focusUp'  )
  
     ,("M-;", sendMessage Taller)
+
     ,("M-p", shellPromptHere myXPConfig)
    ,("M-o", sendMessage Wider )
+
 
+
 
     ,("M-x", submap $ M.fromList subMaps)
 
     ,("M-x", submap $ M.fromList subMaps)
     ,("M-s", submap $ defaultSublMap c  )
+
     ,("M-g", submap $ defaultSublMap c  )
  
 
     ,("M-S-.", focusDown)
 
     ,("M-S-.", focusDown)
Line 167: Line 226:
  
 
     ,("M-S-a", currentTopicAction myTopicConfig)
 
     ,("M-S-a", currentTopicAction myTopicConfig)
     ,("M-a", gets (W.screen . W.current . windowset) >>= \x -> warpToScreen x  0.5 0.5 >> goToSelected gsConfig)
+
     ,("M-a", warpToCentre >> goToSelected gsConfig)
     ,("M-<Tab>", switchNthLastFocused myTopicConfig 1)
+
    -- workaround
 +
     ,("M-<Tab>", switchNthLastFocused myTopicConfig . succ . length . W.visible . windowset =<< get )
  
     ,("M-g"  , promptedGoto )
+
     ,("M-s"  , warpToCentre >> promptedGoto )
     ,("M-S-g", promptedShift)
+
     ,("M-S-s", warpToCentre >> promptedShift)
    ,("M-r"  , promptedGoto )
+
    ,("M-S-r", promptedShift)
+
  
 
     ,("M-b", sendMessage ToggleStruts)
 
     ,("M-b", sendMessage ToggleStruts)
Line 179: Line 237:
 
     ,("M-S-<Return>", spawnShell)
 
     ,("M-S-<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)
     ,("M-q", spawn $ "ghc -e 'XMonad.recompile False >>= flip Control.Monad.unless System.Exit.exitFailure'"
+
     ,("M-q", spawn "ghc -e ':m +XMonad Control.Monad System.Exit' -e 'flip unless exitFailure =<< recompile False' && xmonad --restart")
                            ++ "&& xmonad --restart")
+
 
     ,("M-S-q", spawn "~/wip/x11-wm/xmonad/rebuild.sh")
 
     ,("M-S-q", spawn "~/wip/x11-wm/xmonad/rebuild.sh")
 
     ,("<Print>",  spawn "scrot")
 
     ,("<Print>",  spawn "scrot")
Line 191: Line 248:
 
         ,(""    , sendMessage . Go)]
 
         ,(""    , sendMessage . Go)]
 
     ++ mediaKeys ++
 
     ++ mediaKeys ++
     [("M-"++m++[key], screenWorkspace sc >>= flip whenJust (windows . f)) |
+
     [("M-"++m++[key], screenWorkspace sc >>= flip whenJust (windows . f))
         (f, m) <- [(W.view, ""), (W.shift, "S-")],
+
         | (f, m) <- [(W.view, ""), (W.shift, "S-")]
         (key, sc) <- zip "fw" [0 .. ]]
+
         , (key, sc) <- zip "wf" [0 .. ]]
 
     ++
 
     ++
 
     [ ("M-"++m++[k], a i)
 
     [ ("M-"++m++[k], a i)
Line 201: Line 258:
 
-- 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 :: String -> (Direction -> b) -> [(String, b)]
+
lrud :: String -> (Direction2D -> b) -> [(String, b)]
 
lrud m cmd = zip ks cmds
 
lrud m cmd = zip ks cmds
 
     where
 
     where
       ks  = zipWith (++) (repeat m) $ map return "niue"
+
       ks  = map (\x -> m ++ [x]) "niue"
 
       cmds = zipWith ($) (repeat cmd) [L,R,U,D]
 
       cmds = zipWith ($) (repeat cmd) [L,R,U,D]
  
 
subMaps = [((0, xK_o),  runOrRaisePrompt myXPConfig),
 
subMaps = [((0, xK_o),  runOrRaisePrompt myXPConfig),
           ((0, xK_p),  shellPromptHere ?spawner myXPConfig),
+
           ((0, xK_p),  shellPromptHere myXPConfig),
 
           ((0, xK_x), xmonadPrompt myXPConfig),
 
           ((0, xK_x), xmonadPrompt myXPConfig),
 
           ((0, xK_z), sshPrompt myXPConfig),
 
           ((0, xK_z), sshPrompt myXPConfig),
Line 218: Line 275:
 
           ((0, xK_f), withFocused $ windows . W.sink),
 
           ((0, xK_f), withFocused $ windows . W.sink),
 
           ((0, xK_v), refresh),
 
           ((0, xK_v), refresh),
           ((0, xK_c), asks config >>= spawnHere ?spawner . terminal),
+
           ((0, xK_c), asks config >>= spawnHere . terminal),
 
           ((0, xK_k), kill)
 
           ((0, xK_k), kill)
 
           ]
 
           ]
  
mediaKeys = [("<XF86AudioPlay>", mpcAct "toggle"),
+
 
             ("<XF86AudioStop>", hostPrompt),
+
amarok = False
             ("<XF86AudioNext>", mpcAct "next"),
+
 
             ("<XF86AudioPrev>", mpcAct "prev"),
+
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"),
 
             ("<XF86AudioMute>", spawn "ossmix vmix0-outvol 0"),
            ("S-<XF86AudioMute>", spawn "~/bin/speakers.sh"),
+
             ("<XF86AudioLowerVolume>",  spawn "amixer sset PCM 1-"),
             ("<XF86AudioLowerVolume>",  spawn "ossmix vmix0-outvol -- -1"),
+
             ("<XF86AudioRaiseVolume>",  spawn "amixer sset PCM 1+"),
            ("S-<XF86AudioLowerVolume>", spawn "ossmix vmix0-outvol -- -0.1"),
+
             ("<XF86Sleep>", spawn "sudo pm-suspend")
             ("<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
 
     where mpcAct c = do
             h <- withDisplay $ flip getStringProp mpdHost
+
             h <- XS.gets hostPrompt
             spawn $ unwords ["export MPD_HOST="++fromMaybe "localhost" h,";","mpc",c]
+
             spawn $ unwords ["export MPD_HOST="++h,";","mpc",c]
 
+
mpdHost = "XMONAD_MPD_HOST"
+
  
 
-- Prompt for mpd host
 
-- Prompt for mpd host
data HostPrompt = HostPrompt
+
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: "
 
instance XPrompt HostPrompt where showXPrompt _ = "Pick MPD Host: "
hostPrompt = mkXPrompt HostPrompt myXPConfig (return . compl) f
+
promptHost = mkXPrompt (HostPrompt "") myXPConfig (return . compl) (XS.put . HostPrompt)
     where compl s = nub $ filter (s `isPrefixOf`) ["localhost","dell"]
+
     where compl s = nub $ filter (s `isPrefixOf`) ["127.0.0.1","dell"]
          f x = withDisplay $ \d -> setStringProp d mpdHost x
+
 
--------------------------------------------------------------
 
--------------------------------------------------------------
 +
 +
warpToCentre = gets (W.screen . W.current . windowset) >>= \x -> warpToScreen x  0.5 0.5
  
 
-------------------- Support for per-screen xmobars ---------
 
-------------------- Support for per-screen xmobars ---------
Line 263: Line 324:
 
multiPP' dynlStr focusPP unfocusPP handles = do
 
multiPP' dynlStr focusPP unfocusPP handles = do
 
     state <- get
 
     state <- get
     let pickPP :: WorkspaceId -> X PP
+
     let pickPP :: WorkspaceId -> WriterT (Last XState) X String
 
         pickPP ws = do
 
         pickPP ws = do
             let foc = W.tag . W.workspace . W.current $ windowset state
+
             let isFoc = (ws ==) . W.tag . W.workspace . W.current $ windowset state
             put state { windowset = W.view ws $ windowset state }
+
             put state{ windowset = W.view ws $ windowset state }
             return $ if ws == foc then focusPP else unfocusPP
+
             out <- lift $ dynlStr $ if isFoc then focusPP else unfocusPP
    io . zipWithM_ hPutStrLn handles
+
            when isFoc $ get >>= tell . Last . Just
             =<< mapM (dynlStr <=< pickPP) . catMaybes
+
             return out
            =<< mapM screenWorkspace (zipWith const [0..] handles)
+
    traverse put . getLast
     put state
+
        =<< execWriterT . (io . zipWithM_ hPutStrLn handles <=< mapM pickPP) . catMaybes
 +
        =<< mapM screenWorkspace (zipWith const [0..] handles)
 +
     return ()
  
 
mergePPOutputs :: [PP -> X String] -> PP -> X String
 
mergePPOutputs :: [PP -> X String] -> PP -> X String
mergePPOutputs x pp = fmap (intercalate (ppSep pp)) . sequence $ map ($ pp) x
+
mergePPOutputs x pp = fmap (intercalate (ppSep pp)) . sequence . sequence x $ pp
  
 
onlyTitle :: PP -> PP
 
onlyTitle :: PP -> PP
Line 289: Line 352:
  
 
myPP :: PP
 
myPP :: PP
myPP = sjanssenPP { ppLayout = xmobarColor "orange" "" }
+
myPP = sjanssenPP { ppLayout = xmobarColor "orange" "", ppUrgent = xmobarColor "red" "" . ('^':) }
 
--------------------------------------------------------------
 
--------------------------------------------------------------
  
Line 295: Line 358:
 
myTopics :: [Topic]
 
myTopics :: [Topic]
 
myTopics =
 
myTopics =
   [ "dashboard"
+
   [ "a"
 
   , "web"
 
   , "web"
 
   , "haskell"
 
   , "haskell"
 +
  , "mail"
 
   , "irc"
 
   , "irc"
   , "admin"
+
   , "xm-conf"
  , "documents"
+
 
   , "gimp"
 
   , "gimp"
 
   , "gitit"
 
   , "gitit"
   , "mail"
+
   , "admin"
 
   , "movie"
 
   , "movie"
 
   , "music"
 
   , "music"
 
   , "pdf"
 
   , "pdf"
   , "xmonad-conf"
+
   , "doc"
   , "xmonad-contrib"
+
   , "xmc"
   , "xmonad-extras"
+
   , "xme"
   , "xmonad-newconfig"
+
   , "xm"
 
   , "xmobar"
 
   , "xmobar"
 
   , "wip"
 
   , "wip"
 +
  , "test"
 
   ]
 
   ]
 +
  
 
myTopicConfig = TopicConfig
 
myTopicConfig = TopicConfig
 
   { topicDirs = M.fromList $
 
   { topicDirs = M.fromList $
       [ ("dashboard", "./")
+
       [ ("a", "./")
 
       , ("haskell", "haskell")
 
       , ("haskell", "haskell")
       , ("xmonad-conf", ".xmonad")
+
       , ("xm-conf", ".xmonad")
       , ("xmonad-extras", "wip/x11-wm/xmonad/extras/xmonad-extras/XMonad")
+
       , ("xme", "wip/x11-wm/xmonad/extras/xmonad-extras/XMonad")
       , ("xmonad-newconfig", "wip/x11-wm/xmonad/core/xmonad-newconfig")
+
       , ("xm", "wip/x11-wm/xmonad/core/xmonad")
       , ("xmonad-contrib", "wip/x11-wm/xmonad/contrib/XMonadContrib/XMonad")
+
       , ("xmc", "wip/x11-wm/xmonad/contrib/XMonadContrib/XMonad")
 
       , ("xmobar", "wip/x11-wm/xmobar")
 
       , ("xmobar", "wip/x11-wm/xmobar")
 
       , ("movie", "media/movie")
 
       , ("movie", "media/movie")
 
       , ("music", "media/music")
 
       , ("music", "media/music")
       , ("documents", "doc")
+
       , ("doc", "doc")
 
       , ("pdf", "ref")
 
       , ("pdf", "ref")
 
       , ("gitit", "wip/gitit")
 
       , ("gitit", "wip/gitit")
Line 333: Line 398:
 
       ]
 
       ]
 
   , defaultTopicAction = const $ spawnShell >*> 2
 
   , defaultTopicAction = const $ spawnShell >*> 2
   , defaultTopic = "dashboard"
+
   , defaultTopic = "a"
 
   , maxTopicHistory = 10
 
   , maxTopicHistory = 10
 
   , topicActions = M.fromList $
 
   , topicActions = M.fromList $
       [ ("xmonad-conf", spawnShellIn ".xmonad/lib/XMonad/Layout" >>
+
       [ ("xm-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 "export MPD_HOST=192.168.1.2; mpc && 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 engage.uwaterloo.ca")
+
      , ("web"   , spawnOn "web" "firefox")
      , ("dashboard", spawnShell)
+
      , ("pdf"   , spawnOn "pdf" "okular")
      , ("web",        spawnHere ?spawner "firefox")
+
      , ("gimp"   , spawnHere "gimp")
      , ("movie",     spawnShell)
+
      , ("pdf",        spawn "okular")
+
      , ("gimp",       spawnHere ?spawner "gimp")
+
 
       ]
 
       ]
 
   }
 
   }
Line 358: Line 420:
 
     -- color <- randomBg' (HSV 255 255)
 
     -- color <- randomBg' (HSV 255 255)
 
     t <- asks (terminal . config)
 
     t <- asks (terminal . config)
     spawnHere ?spawner $ "cd " ++ dir ++ " && " ++ t -- ++ " -bg " ++ color
+
     spawnHere $ "cd " ++ dir ++ " && " ++ t -- ++ " -bg " ++ color
  
wsgrid = gridselect gsConfig { gs_colorizer = defaultColorizer }
+
wsgrid = gridselect gsConfig <=< asks $ map (\x -> (x,x)) . workspaces . config
          =<< asks (map (\x -> (x,x)) . workspaces . config)
+
  
 
promptedGoto = wsgrid >>= flip whenJust (switchTopic myTopicConfig)
 
promptedGoto = wsgrid >>= flip whenJust (switchTopic myTopicConfig)
  
 
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
+
-- A nice little example of extensiblestate
-- threaddelay to send the keys that didn't turn out to be part of a chord
+
newtype FocusFollow = FocusFollow {getFocusFollow :: Bool } deriving (Typeable,Read,Show)
-- (waiting for xcb/xhb port)
+
instance ExtensionClass FocusFollow where
mkChords :: (?pressedKeys::IORef (M.Map (KeyMask,KeyCode) Time))
+
    initialValue = FocusFollow True
        => Time -- ^ expire older keypresses than this time
+
    extensionType = PersistentExtension
        -> 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)]
+
-- this eventHook is the same as from xmonad for handling crossing events
mkKeyCodes y = do
+
focusFollow e@(CrossingEvent {ev_window=w, ev_event_type=t})
    d <- asks display
+
                | t == enterNotify, ev_mode e == notifyNormal =
    mapM (\(x,y) -> let (masks,syms) = unzip x
+
        whenX (XS.gets getFocusFollow) (focus w) >> return (All True)
        in liftM (flip (,) y . zip masks) $ mapM (liftIO . keysymToKeycode d) syms) y
+
focusFollow _ = return (All True)
  
manageKeypresses :: (?pressedKeys::IORef (M.Map (KeyMask, KeyCode) Time), MonadIO m) =>Bool -> (M.Map (KeyMask, KeyCode) Time -> m b) -> Event -> m All
+
toggleFF = XS.modify $ FocusFollow . not . getFocusFollow
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 ())]
+
{- | 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)
  
chords ::  [([(KeyMask, KeySym)], X ())]
+
    let addRem = False -- run the query with window removed??
chords = [([(mod4Mask,xK_z),(mod4Mask,xK_c)],spawn "xmessage hahaahah it works" :: X ())]
+
    when addRem
 +
        (liftX $ modify (\ws -> ws { windowset = W.insertUp w (windowset ws) }))
 +
    liftX $ windows (W.insertUp w)
  
-- Ripped out of XMonad.Main.grabKeys
+
    mapM_ (liftX . sendMessage . XMonad.Layout.SubLayouts.Merge w) aws
grabChords :: [([(ButtonMask, KeySym)], X())] -> X ()
+
 
grabChords c = do
+
    when addRem
    XConf { display = dpy, theRoot = rootw } <- ask
+
        (liftX $ modify (\ws -> ws { windowset = W.delete' w (windowset ws) }))
    let grab m ks = do
+
 
            kc <- keysymToKeycode dpy ks
+
     idHook
            grabKey dpy kc m rootw True grabModeAsync grabModeAsync
+
     mapM_ (io . uncurry grab) $ concatMap fst c
+
--------------------------------------------------------------------------------
+
 
</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