Personal tools

Xmonad/Config archive/adamvo's xmonad.hs

From HaskellWiki

< Xmonad | Config archive(Difference between revisions)
Jump to: navigation, search
(fix lost <haskell> tag)
(update)
Line 1: Line 1:
 
<haskell>
 
<haskell>
 
{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}
 
{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}
{-# LANGUAGE ImplicitParams, NoMonomorphismRestriction #-}
+
{-# LANGUAGE NoMonomorphismRestriction, ImplicitParams #-}
 
module Main where
 
module Main where
  
Line 9: Line 9:
  
 
-- Update these with:  ghc -ddump-minimal-imports
 
-- Update these with:  ghc -ddump-minimal-imports
import XMonad.Actions.CycleWS(WSType(NonEmptyWS), WSDirection(..),
+
import Control.Applicative((<*), liftA2)
                              moveTo)
+
import Control.Monad(Monad(return, (>>=), (>>)), Functor(..), (=<<), mapM, sequence, zipWithM_)
 +
import Data.List((++), zip, map, concatMap, repeat, zipWith, nub, isPrefixOf, intercalate, isInfixOf)
 +
import Data.Map(fromList)
 +
import Data.Maybe(catMaybes,fromMaybe)
 +
import Graphics.X11.ExtraTypes.XF86(xF86XK_AudioLowerVolume, xF86XK_AudioMute, xF86XK_AudioNext, xF86XK_AudioPlay, xF86XK_AudioPrev, xF86XK_AudioRaiseVolume, xF86XK_AudioStop, xF86XK_Sleep)
 +
import Graphics.X11.Xinerama(getScreenInfo)
 +
import System.IO(IO, Handle, hPutStrLn)
 +
 
 +
import XMonad.Actions.CycleWS(WSType(NonEmptyWS), WSDirection(..), moveTo)
 
import XMonad.Actions.DwmPromote(dwmpromote)
 
import XMonad.Actions.DwmPromote(dwmpromote)
import XMonad.Actions.FloatSnap(Direction(..), snapGrow, snapMove,
+
import XMonad.Actions.FloatSnap(Direction(..), snapGrow, snapMove, snapShrink)
                                snapShrink)
+
 
import XMonad.Actions.GridSelect(defaultGSConfig, goToSelected)
 
import XMonad.Actions.GridSelect(defaultGSConfig, goToSelected)
import XMonad.Actions.Search(mathworld, wikipedia, multi,
+
import XMonad.Actions.RandomBackground(randomBg', RandomColor(HSV))
                            promptSearch)
+
import XMonad.Actions.Search(mathworld, wikipedia, multi, promptSearch)
import XMonad.Actions.SpawnOn(spawnOn, Spawner, manageSpawn,
+
import XMonad.Actions.SpawnOn(mkSpawner, spawnOn, manageSpawn, shellPromptHere, spawnHere)
                              mkSpawner, spawnHere, shellPromptHere)
+
 
import XMonad.Actions.Submap(submap)
 
import XMonad.Actions.Submap(submap)
import XMonad.Actions.TopicSpace(TopicConfig(..), Topic, (>*>),
+
import XMonad.Actions.TopicSpace(TopicConfig(..), Topic, (>*>), checkTopicConfig, currentTopicAction, currentTopicDir, pprWindowSet, shiftNthLastFocused, switchNthLastFocused, switchTopic)
                                checkTopicConfig, currentTopicAction, currentTopicDir,
+
import XMonad.Actions.UpdatePointer(PointerPosition(TowardsCentre), updatePointer)
                                pprWindowSet, switchNthLastFocused, switchTopic)
+
import XMonad.Hooks.DynamicLog(PP(ppUrgent, ppTitle, ppLayout, ppVisible, ppHidden, ppCurrent, ppSep), dynamicLogString, defaultPP, xmobarColor, wrap)
import XMonad.Hooks.DynamicLog(PP(ppSep, ppCurrent, ppHidden,
+
import XMonad.Hooks.EwmhDesktops(ewmhDesktopsEventHook, ewmhDesktopsLogHook)
                                  ppVisible, ppLayout, ppTitle, ppUrgent),
+
import XMonad.Hooks.ManageDocks(ToggleStruts(ToggleStruts), avoidStruts, manageDocks)
                              dynamicLogString, defaultPP, xmobarColor, wrap)
+
import XMonad.Hooks.UrgencyHook(FocusHook(..), withUrgencyHook)
import XMonad.Hooks.EwmhDesktops(ewmhDesktopsEventHook,
+
                                ewmhDesktopsLogHook)
+
import XMonad.Hooks.ManageDocks(ToggleStruts(ToggleStruts),
+
                                avoidStruts, manageDocks)
+
import XMonad.Hooks.UrgencyHook(NoUrgencyHook(..), withUrgencyHook)
+
 
import XMonad.Layout.BoringWindows(boringAuto, focusDown, focusUp)
 
import XMonad.Layout.BoringWindows(boringAuto, focusDown, focusUp)
 
import XMonad.Layout.LayoutHints(layoutHintsToCenter)
 
import XMonad.Layout.LayoutHints(layoutHintsToCenter)
 
import XMonad.Layout.Mosaic(Aspect(Wider, Taller), mosaic)
 
import XMonad.Layout.Mosaic(Aspect(Wider, Taller), mosaic)
 
import XMonad.Layout.Named(named)
 
import XMonad.Layout.Named(named)
import XMonad.Layout.NoBorders(Ambiguity(Screen), lessBorders,
+
import XMonad.Layout.NoBorders(Ambiguity(Screen), lessBorders, noBorders)
                              noBorders)
+
 
import XMonad.Layout.Simplest(Simplest(..))
 
import XMonad.Layout.Simplest(Simplest(..))
import XMonad.Layout.SubLayouts(GroupMsg(UnMergeAll, UnMerge,
+
import XMonad.Layout.SubLayouts
                                        MergeAll),
+
                                defaultSublMap, onGroup, pullGroup, subLayout)
+
 
import XMonad.Layout.Tabbed(defaultTheme, addTabs, shrinkText)
 
import XMonad.Layout.Tabbed(defaultTheme, addTabs, shrinkText)
import XMonad.Layout.WindowNavigation(Navigate(Swap, Go),
+
import XMonad.Layout.WindowNavigation(Navigate(Swap, Go), configurableNavigation, navigateColor)
                                      configurableNavigation, navigateColor)
+
import XMonad.Prompt(XPConfig(font), XPrompt(showXPrompt), greenXPConfig, mkXPrompt)
import XMonad.Layout.WorkspaceDir(changeDir, workspaceDir)
+
import XMonad.Prompt(XPConfig(font), XPrompt(showXPrompt),
+
                    greenXPConfig, mkXPrompt)
+
 
import XMonad.Prompt.RunOrRaise(runOrRaisePrompt)
 
import XMonad.Prompt.RunOrRaise(runOrRaisePrompt)
 
import XMonad.Prompt.Ssh(sshPrompt)
 
import XMonad.Prompt.Ssh(sshPrompt)
Line 54: Line 49:
 
import XMonad.Util.EZConfig(additionalKeys)
 
import XMonad.Util.EZConfig(additionalKeys)
 
import XMonad.Util.Run(spawnPipe)
 
import XMonad.Util.Run(spawnPipe)
import Graphics.X11.Xinerama(getScreenInfo)
+
import XMonad.Util.StringProp(setStringProp,getStringProp)
import Graphics.X11.ExtraTypes.XF86(xF86XK_AudioLowerVolume,
+
                                    xF86XK_AudioMute, xF86XK_AudioNext, xF86XK_AudioPlay,
+
                                    xF86XK_AudioPrev, xF86XK_AudioRaiseVolume, xF86XK_AudioStop,
+
                                    xF86XK_Sleep)
+
import Data.Map(fromList)
+
import Control.Monad(Monad(return, (>>=), (>>)), Functor(..),
+
                    (=<<), mapM, sequence, zipWithM_)
+
import Data.IORef(newIORef, readIORef, writeIORef)
+
import Data.List((++), zip, map, concatMap, repeat, zipWith, nub,
+
                isPrefixOf, intercalate, isInfixOf)
+
import Data.Maybe(catMaybes)
+
import Data.Ratio((%))
+
import System.IO(IO, Handle, hPutStrLn)
+
  
 
main :: IO ()
 
main :: IO ()
 
main = do
 
main = do
     sp <- mkSpawner
+
     spawner <- mkSpawner
    mpdHost <- newIORef "localhost"
+
     let ?spawner = spawner
     let ?spawner = sp
+
        ?mpdHost = mpdHost
+
 
     checkTopicConfig myTopics myTopicConfig
 
     checkTopicConfig myTopics myTopicConfig
     xmonad . withUrgencyHook NoUrgencyHook . myConfig =<< mapM xmobarScreen =<< getScreens
+
     xmonad . withUrgencyHook FocusHook . myConfig =<< mapM xmobarScreen =<< getScreens
  
 
myConfig hs = let c = defaultConfig {
 
myConfig hs = let c = defaultConfig {
Line 83: Line 63:
 
     , terminal = "urxvt"
 
     , terminal = "urxvt"
 
     , modMask = mod4Mask
 
     , modMask = mod4Mask
     , logHook = ewmhDesktopsLogHook >> myLogHook hs
+
     , logHook = do
 +
        ewmhDesktopsLogHook
 +
        multiPP'
 +
            (mergePPOutputs [pprWindowSet myTopicConfig,dynamicLogString . onlyTitle])
 +
            myPP
 +
            myPP { ppTitle = const "" }
 +
            hs
 +
        updatePointer (TowardsCentre 0.2 0.2)
 
     , handleEventHook = ewmhDesktopsEventHook
 
     , handleEventHook = ewmhDesktopsEventHook
 
     , workspaces = myTopics
 
     , workspaces = myTopics
     , manageHook = manageSpawn ?spawner <+> manageDocks
+
     , manageHook = fmap ("Gran Paradiso" `isInfixOf`) className --> doShift "web" <+> manageSpawn ?spawner <+> manageDocks
 
     } in additionalKeys c (myKeys c)
 
     } in additionalKeys c (myKeys c)
  
Line 93: Line 80:
  
 
-------------------- Layout ----------------------------------
 
-------------------- Layout ----------------------------------
myLayout = workspaceDir "~" $ avoidStruts
+
myLayout = avoidStruts $ named "M" m ||| named "F" (noBorders Full)
        $ named "M" mos ||| named "F" (noBorders Full)
+
     where m = lessBorders Screen
     where mos = lessBorders Screen
+
 
             $ addTabs shrinkText defaultTheme
 
             $ addTabs shrinkText defaultTheme
 
             $ configurableNavigation (navigateColor "#ffff00")
 
             $ configurableNavigation (navigateColor "#ffff00")
Line 101: Line 87:
 
             $ subLayout [] Simplest
 
             $ subLayout [] Simplest
 
             $ layoutHintsToCenter
 
             $ layoutHintsToCenter
             $ mosaic 1.5 [5,4,2]
+
             $ mosaic 1.5 [5,4,2] -- manual 0.2
 
--------------------------------------------------------------
 
--------------------------------------------------------------
  
Line 125: Line 111:
  
 
     ,((modm, xK_x), submap $ M.fromList subMaps)
 
     ,((modm, xK_x), submap $ M.fromList subMaps)
     ,((modm, xK_s), submap $ defaultSublMap c)
+
     ,((modm, xK_s), submap $ fmap (>> refresh) $ defaultSublMap c)
  
 
     ,((modm, xK_period), moveTo Next NonEmptyWS)
 
     ,((modm, xK_period), moveTo Next NonEmptyWS)
Line 135: Line 121:
 
     ,((modm, xK_a), goToSelected defaultGSConfig)
 
     ,((modm, xK_a), goToSelected defaultGSConfig)
 
     ,((modm, xK_Tab), switchNthLastFocused myTopicConfig 1)
 
     ,((modm, xK_Tab), switchNthLastFocused myTopicConfig 1)
     ,((modm, xK_g     ), promptedGoto)
+
     ,((modm, xK_g), promptedGoto)
 +
    ,((modm .|. shiftMask, xK_g), promptedShift)
  
 
     ,((modm, xK_Return), dwmpromote)
 
     ,((modm, xK_Return), dwmpromote)
 
     ,((modm .|. shiftMask, xK_Return), spawnShell)
 
     ,((modm .|. shiftMask, xK_Return), spawnShell)
    ,((modm .|. shiftMask, xK_g    ), promptedShift)
 
 
     ,((modm, xK_q), spawn "~/.xmonad/xmonad-recomp.lhs && xmonad --restart")
 
     ,((modm, xK_q), spawn "~/.xmonad/xmonad-recomp.lhs && xmonad --restart")
     ,((modm .|. shiftMask, xK_q), spawn "xmonad --recompile && xmonad --restart")
+
     ,((modm .|. shiftMask, xK_q), spawn "~/wip/x11-wm/xmonad/rebuild.sh")
 
     ,((0, xK_Print),  spawn "scrot")
 
     ,((0, xK_Print),  spawn "scrot")
  
Line 147: Line 133:
 
     ++
 
     ++
 
     concatMap (\(m,f) -> lrud (modm .|. m) f)
 
     concatMap (\(m,f) -> lrud (modm .|. m) f)
         [(shiftMask, (sendMessage . Swap))
+
         [(shiftMask, sendMessage . Swap)
         ,(controlMask,  (sendMessage . pullGroup))
+
         ,(controlMask,  sendMessage . pullGroup)
 +
        ,(controlMask .|. shiftMask, sendMessage . pushWindow)
 
         ,(0, (sendMessage . Go))
 
         ,(0, (sendMessage . Go))
 
         ]
 
         ]
Line 156: Line 143:
 
         (key, sc) <- zip [xK_w, xK_f, xK_p] ([0 .. ])]
 
         (key, sc) <- zip [xK_w, xK_f, xK_p] ([0 .. ])]
 
     ++
 
     ++
     [ ((modm, k), switchNthLastFocused myTopicConfig i)
+
     [ ((modm .|. m, k), a i)
    | (i, k) <- zip [1..] [xK_1 .. xK_9]]
+
        | (a, m) <- [(switchNthLastFocused myTopicConfig,0),(shiftNthLastFocused, shiftMask)]
 +
        , (i, k) <- zip [1..] [xK_1 .. xK_9]]
  
 
-- helper for windowNavigation keys
 
-- helper for windowNavigation keys
Line 175: Line 163:
 
           ((0, xK_s), promptSearch myXPConfig multi),
 
           ((0, xK_s), promptSearch myXPConfig multi),
 
           ((0, xK_m), promptSearch myXPConfig mathworld),
 
           ((0, xK_m), promptSearch myXPConfig mathworld),
          ((0, xK_d), changeDir myXPConfig),
 
 
           ((0, xK_b), sendMessage ToggleStruts),
 
           ((0, xK_b), sendMessage ToggleStruts),
 
           ((0, xK_f), withFocused $ windows . W.sink),
 
           ((0, xK_f), withFocused $ windows . W.sink),
Line 195: Line 182:
 
             ((0, xF86XK_Sleep), spawn "sudo sh -c 'echo mem > /sys/power/state'")]
 
             ((0, xF86XK_Sleep), spawn "sudo sh -c 'echo mem > /sys/power/state'")]
 
     where mpcAct c = do
 
     where mpcAct c = do
             h <- io $ readIORef ?mpdHost
+
             h <- withDisplay $ flip getStringProp mpdHost
             spawn $ unwords ["export MPD_HOST="++h,";","mpc",c]
+
             spawn $ unwords ["export MPD_HOST="++fromMaybe "localhost" h,";","mpc",c]
 +
 
 +
mpdHost = "XMONAD_MPD_HOST"
  
 
-- Prompt for host
 
-- Prompt for host
 
data HostPrompt = HostPrompt
 
data HostPrompt = HostPrompt
 
instance XPrompt HostPrompt where showXPrompt _ = "Pick MPD Host: "
 
instance XPrompt HostPrompt where showXPrompt _ = "Pick MPD Host: "
hostPrompt = mkXPrompt HostPrompt myXPConfig (return . compl) (io . writeIORef ?mpdHost)
+
hostPrompt = mkXPrompt HostPrompt myXPConfig (return . compl) f
 
     where compl s = nub $ filter (s `isPrefixOf`) ["localhost","dell"]
 
     where compl s = nub $ filter (s `isPrefixOf`) ["localhost","dell"]
 
+
          f x = withDisplay $ \d -> setStringProp d mpdHost x
 
--------------------------------------------------------------
 
--------------------------------------------------------------
  
 
-------------------- 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 (zipWith const [0..]) . 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
 
-- | Output to each handle what would be seen when viewing the screen with that
Line 233: Line 218:
 
     put state
 
     put state
  
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 $ map ($ pp) x
  
 
onlyTitle :: PP -> PP
 
onlyTitle :: PP -> PP
Line 242: Line 227:
 
xmobarScreen :: Int -> IO Handle
 
xmobarScreen :: Int -> IO Handle
 
xmobarScreen = spawnPipe . ("xmobar -x " ++) . show
 
xmobarScreen = spawnPipe . ("xmobar -x " ++) . show
 
myLogHook ::  (?spawner::Spawner) => [Handle] -> X ()
 
myLogHook = multiPP'
 
    (flip mergePPOutputs [pprWindowSet myTopicConfig,dynamicLogString . onlyTitle])
 
    myPP
 
    myPP { ppTitle = const "" }
 
  
 
myPP :: PP
 
myPP :: PP
Line 264: Line 243:
 
   [ "dashboard" -- the first one
 
   [ "dashboard" -- the first one
 
   , "admin", "build", "cleaning", "conf", "darcs", "haskell", "irc"
 
   , "admin", "build", "cleaning", "conf", "darcs", "haskell", "irc"
   , "mail", "movie", "music", "talk", "text", "tools", "web"
+
   , "mail", "movie", "music", "talk", "text", "web"
   , "yi", "documents", "pdf", "xmobar", "xmonad-conf", "xmonad-newconfig", "xmonad-contrib"
+
   , "yi", "documents", "pdf", "xmobar", "xmonad-conf", "xmonad-extras", "xmonad-newconfig", "xmonad-contrib"
   , "gtk-gnutella", "gitit", "gimp"
+
   , "gitit", "gimp"
 
   ]
 
   ]
  
myTopicConfig ::  (?spawner::Spawner) => TopicConfig
 
 
myTopicConfig = TopicConfig
 
myTopicConfig = TopicConfig
 
   { topicDirs = M.fromList $
 
   { topicDirs = M.fromList $
Line 278: Line 256:
 
       , ("haskell", "haskell")
 
       , ("haskell", "haskell")
 
       , ("xmonad-conf", ".xmonad")
 
       , ("xmonad-conf", ".xmonad")
 +
      , ("xmonad-extras", "wip/x11-wm/xmonad/extras/xmonad-extras/XMonad")
 
       , ("xmonad-newconfig", "wip/x11-wm/xmonad/core/xmonad-newconfig")
 
       , ("xmonad-newconfig", "wip/x11-wm/xmonad/core/xmonad-newconfig")
 
       , ("xmonad-contrib", "wip/x11-wm/xmonad/contrib/XMonadContrib/XMonad")
 
       , ("xmonad-contrib", "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")
 
       , ("documents", "doc")
 
       , ("pdf", "ref")
 
       , ("pdf", "ref")
      , ("gtk-gnutella", ".gtk-gnutella-downloads")
 
 
       , ("gitit", "wip/gitit")
 
       , ("gitit", "wip/gitit")
 
       , ("gimp", "./")
 
       , ("gimp", "./")
Line 294: Line 271:
 
   , maxTopicHistory = 10
 
   , maxTopicHistory = 10
 
   , topicActions = M.fromList $
 
   , topicActions = M.fromList $
       [ ("haskell",    spawnShell >*> 2 >>
+
       [ ("xmonad-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)
 
       , ("xmonad-contrib", spawnShell >*> 2)
 
       , ("xmonad-newconfig", spawn "urxvt -e vim ~/wip/x11-wm/xmonad/core/xmonad-newconfig/XMonad/ConfigMonad.hs")
 
       , ("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" >> spawn "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",      spawn "urxvt -e mutt")
 
       , ("mail",      spawn "urxvt -e mutt")
       , ("irc",        spawn "urxvt -e ssh aavogt@engage.uwaterloo.ca")
+
       , ("irc",        spawn "urxvt -e ssh engage.uwaterloo.ca")
 
       , ("dashboard",  spawnShell)
 
       , ("dashboard",  spawnShell)
 
       , ("web",        spawn "firefox")
 
       , ("web",        spawn "firefox")
 
       , ("movie",      spawnShell)
 
       , ("movie",      spawnShell)
       , ("pdf",        spawn "okular >&| /dev/null")
+
       , ("pdf",        spawn "okular")
       , ("gtk-gnutella", spawn "gtk-gnutella")
+
       , ("gimp",      spawnOn ?spawner "gimp" "gimp")
       , ("gitit", mapM_ (spawnOn ?spawner "gitit") ["firefox -no-remote http://localhost:5001"] >> spawnShell)
+
      , ("gimp", spawnOn ?spawner "gimp" "gimp")
+
 
       ]
 
       ]
 
   }
 
   }
  
 
-- 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 15 0)
 
+
    t <- asks (terminal . config)
goto ::  (?spawner::Spawner) => Topic -> X ()
+
    spawnHere ?spawner $ "cd " ++ dir ++ " && " ++ t ++ " -bg " ++ color
goto = switchTopic myTopicConfig
+
  
promptedGoto ::  (?spawner::Spawner) => X ()
+
promptedGoto = workspacePrompt myXPConfig $ switchTopic myTopicConfig
promptedGoto = workspacePrompt myXPConfig goto
+
  
promptedShift ::  X ()
+
promptedShift = workspacePrompt myXPConfig $ \x -> windows (W.greedyView x . W.shift x)
promptedShift = workspacePrompt myXPConfig $ windows . W.shift
+
 
</haskell>
 
</haskell>

Revision as of 23:37, 11 July 2009

{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}
{-# LANGUAGE NoMonomorphismRestriction, ImplicitParams #-}
module Main where
 
import XMonad
import qualified XMonad.StackSet as W
import qualified Data.Map as M
 
-- Update these with:  ghc -ddump-minimal-imports
import Control.Applicative((<*), liftA2)
import Control.Monad(Monad(return, (>>=), (>>)), Functor(..), (=<<), mapM, sequence, zipWithM_)
import Data.List((++), zip, map, concatMap, repeat, zipWith, nub, isPrefixOf, intercalate, isInfixOf)
import Data.Map(fromList)
import Data.Maybe(catMaybes,fromMaybe)
import Graphics.X11.ExtraTypes.XF86(xF86XK_AudioLowerVolume, xF86XK_AudioMute, xF86XK_AudioNext, xF86XK_AudioPlay, xF86XK_AudioPrev, xF86XK_AudioRaiseVolume, xF86XK_AudioStop, xF86XK_Sleep)
import Graphics.X11.Xinerama(getScreenInfo)
import System.IO(IO, Handle, hPutStrLn)
 
import XMonad.Actions.CycleWS(WSType(NonEmptyWS), WSDirection(..), moveTo)
import XMonad.Actions.DwmPromote(dwmpromote)
import XMonad.Actions.FloatSnap(Direction(..), snapGrow, snapMove, snapShrink)
import XMonad.Actions.GridSelect(defaultGSConfig, goToSelected)
import XMonad.Actions.RandomBackground(randomBg', RandomColor(HSV))
import XMonad.Actions.Search(mathworld, wikipedia, multi, promptSearch)
import XMonad.Actions.SpawnOn(mkSpawner, spawnOn, manageSpawn, 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.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(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
import XMonad.Layout.Tabbed(defaultTheme, addTabs, shrinkText)
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.Workspace(workspacePrompt)
import XMonad.Prompt.XMonad(xmonadPrompt)
import XMonad.Util.EZConfig(additionalKeys)
import XMonad.Util.Run(spawnPipe)
import XMonad.Util.StringProp(setStringProp,getStringProp)
 
main :: IO ()
main = do
    spawner <- mkSpawner
    let ?spawner = spawner
    checkTopicConfig myTopics myTopicConfig
    xmonad . withUrgencyHook FocusHook . myConfig =<< mapM xmobarScreen =<< getScreens
 
myConfig hs = let c = defaultConfig {
      layoutHook = myLayout
    , focusedBorderColor = "#ff0000"
    , terminal = "urxvt"
    , modMask = mod4Mask
    , logHook = do
        ewmhDesktopsLogHook
        multiPP'
            (mergePPOutputs [pprWindowSet myTopicConfig,dynamicLogString . onlyTitle])
            myPP
            myPP { ppTitle = const "" }
            hs
        updatePointer (TowardsCentre 0.2 0.2)
    , handleEventHook = ewmhDesktopsEventHook
    , workspaces = myTopics
    , manageHook = fmap ("Gran Paradiso" `isInfixOf`) className --> doShift "web" <+> manageSpawn ?spawner <+> manageDocks
    } in additionalKeys c (myKeys c)
 
myXPConfig :: XPConfig
myXPConfig = greenXPConfig { font = "xft:Profont:pixelsize=15:autohint=true" }
 
-------------------- Layout ----------------------------------
myLayout = avoidStruts $ named "M" m ||| named "F" (noBorders Full)
    where m = lessBorders Screen
            $ addTabs shrinkText defaultTheme
            $ configurableNavigation (navigateColor "#ffff00")
            $ boringAuto
            $ subLayout [] Simplest
            $ layoutHintsToCenter
            $ mosaic 1.5 [5,4,2] -- manual 0.2
--------------------------------------------------------------
 
-------------------- Keys ------------------------------------
myKeys c@(XConfig { modMask = modm }) =
    [ ((modm,               xK_Left),  withFocused $ snapMove L Nothing)
    , ((modm,               xK_Right), withFocused $ snapMove R Nothing)
    , ((modm,               xK_Up),    withFocused $ snapMove U Nothing)
    , ((modm,               xK_Down),  withFocused $ snapMove D Nothing)
    , ((modm .|. shiftMask, xK_Left),  withFocused $ snapShrink R Nothing)
    , ((modm .|. shiftMask, xK_Right), withFocused $ snapGrow R Nothing)
    , ((modm .|. shiftMask, xK_Up),    withFocused $ snapShrink D Nothing)
    , ((modm .|. shiftMask, xK_Down),  withFocused $ snapGrow D Nothing)
 
    ,((modm .|. controlMask, xK_o), withFocused $ sendMessage . UnMerge)
    ,((modm .|. shiftMask .|. controlMask, xK_o), withFocused $ sendMessage . UnMergeAll)
    ,((modm .|. controlMask, xK_m), withFocused $ sendMessage . MergeAll)
    ,((modm .|. controlMask, xK_period), onGroup W.focusDown')
    ,((modm .|. controlMask, xK_comma), onGroup W.focusUp')
 
    ,((modm, xK_semicolon), sendMessage Taller)
    ,((modm, xK_o), sendMessage Wider)
 
    ,((modm, xK_x), submap $ M.fromList subMaps)
    ,((modm, xK_s), submap $ fmap (>> refresh) $ defaultSublMap c)
 
    ,((modm, xK_period), moveTo Next NonEmptyWS)
    ,((modm, xK_comma ), moveTo Prev NonEmptyWS)
    ,((modm .|. shiftMask, xK_period), focusDown)
    ,((modm .|. shiftMask, xK_comma ), focusUp)
 
    ,((modm .|. shiftMask, xK_a), currentTopicAction myTopicConfig)
    ,((modm, xK_a), goToSelected defaultGSConfig)
    ,((modm, xK_Tab), switchNthLastFocused myTopicConfig 1)
    ,((modm, xK_g), promptedGoto)
    ,((modm .|. shiftMask, xK_g), promptedShift)
 
    ,((modm, xK_Return), dwmpromote)
    ,((modm .|. shiftMask, xK_Return), spawnShell)
    ,((modm, xK_q), spawn "~/.xmonad/xmonad-recomp.lhs && xmonad --restart")
    ,((modm .|. shiftMask, xK_q), spawn "~/wip/x11-wm/xmonad/rebuild.sh")
    ,((0, xK_Print),  spawn "scrot")
 
    ]
    ++
    concatMap (\(m,f) -> lrud (modm .|. m) f)
        [(shiftMask, sendMessage . Swap)
        ,(controlMask,  sendMessage . pullGroup)
        ,(controlMask .|. shiftMask, sendMessage . pushWindow)
        ,(0, (sendMessage . Go))
        ]
    ++ mediaKeys ++
    [((m .|. modm, key), screenWorkspace sc >>= flip whenJust (windows . f)) |
        (f, m) <- [(W.view, 0), (W.shift, shiftMask)],
        (key, sc) <- zip [xK_w, xK_f, xK_p] ([0 .. ])]
    ++
    [ ((modm .|. m, k), a i)
        | (a, m) <- [(switchNthLastFocused myTopicConfig,0),(shiftNthLastFocused, shiftMask)]
        , (i, k) <- zip [1..] [xK_1 .. xK_9]]
 
-- helper for windowNavigation keys
--    note: with colemak neiu are placed where jkli are with qwerty layout
lrud :: a -> (Direction -> b) -> [((a, KeySym), b)]
lrud m cmd = zip ks cmds
    where
      ks = zip (repeat m) [xK_n,xK_i,xK_u,xK_e]
      cmds = zipWith ($) (repeat cmd) [L,R,U,D]
 
subMaps = [((0, xK_o),  runOrRaisePrompt myXPConfig),
           ((0, xK_p),  shellPromptHere ?spawner myXPConfig),
           ((0, xK_x), xmonadPrompt myXPConfig),
           ((0, xK_z), sshPrompt myXPConfig),
           ((shiftMask, xK_w), windowPromptGoto myXPConfig),
           ((0, xK_w), promptSearch myXPConfig wikipedia),
           ((0, xK_s), promptSearch myXPConfig multi),
           ((0, xK_m), promptSearch myXPConfig mathworld),
           ((0, xK_b), sendMessage ToggleStruts),
           ((0, xK_f), withFocused $ windows . W.sink),
           ((0, xK_v), refresh),
           ((0, xK_c), asks config >>= spawnHere ?spawner . terminal),
           ((0, xK_k), kill)
           ]
 
mediaKeys = [((0, xF86XK_AudioPlay), mpcAct "toggle"),
             ((0, xF86XK_AudioStop), hostPrompt),
             ((0, xF86XK_AudioNext), mpcAct "next"),
             ((0, xF86XK_AudioPrev), mpcAct "prev"),
             ((0, xF86XK_AudioMute),  spawn "ossmix vmix0-outvol 0"),
             ((shiftMask, xF86XK_AudioMute),  spawn "~/bin/speakers.sh"),
             ((0, xF86XK_AudioLowerVolume),         spawn "ossmix vmix0-outvol -- -1"),
             ((shiftMask, xF86XK_AudioLowerVolume), spawn "ossmix vmix0-outvol -- -0.1"),
             ((0, xF86XK_AudioRaiseVolume),         spawn "ossmix vmix0-outvol +1"),
             ((shiftMask, xF86XK_AudioRaiseVolume), spawn "ossmix vmix0-outvol +0.1"),
             ((0, xF86XK_Sleep), spawn "sudo sh -c 'echo mem > /sys/power/state'")]
    where mpcAct c = do
            h <- withDisplay $ flip getStringProp mpdHost
            spawn $ unwords ["export MPD_HOST="++fromMaybe "localhost" h,";","mpc",c]
 
mpdHost = "XMONAD_MPD_HOST"
 
-- Prompt for host
data HostPrompt = HostPrompt
instance XPrompt HostPrompt where showXPrompt _ = "Pick MPD Host: "
hostPrompt = mkXPrompt HostPrompt myXPConfig (return . compl) f
    where compl s = nub $ filter (s `isPrefixOf`) ["localhost","dell"]
          f x = withDisplay $ \d -> setStringProp d mpdHost x
--------------------------------------------------------------
 
-------------------- Support for per-screen xmobars ---------
-- Some parts of this should be merged into contrib sometime
getScreens :: IO [Int]
getScreens = openDisplay "" >>= liftA2 (<*) f closeDisplay
    where f = fmap (zipWith const [0..]) . getScreenInfo
 
-- | Output to each handle what would be seen when viewing the screen with that
-- index. If the workspace is focused use the first PP, otherwise use the
-- second PP.
multiPP :: PP -> PP -> [Handle] -> X ()
multiPP = multiPP' dynamicLogString
 
multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()
multiPP' dynlStr focusPP unfocusPP handles = do
    state <- get
    let viewWs n = put state { windowset = W.view n $ windowset state }
        focused = W.tag . W.workspace . W.current $ windowset state
        choosePP w = if w == focused then focusPP else unfocusPP
    io . zipWithM_ hPutStrLn handles
            =<< mapM (\w -> viewWs w >> dynlStr (choosePP w)) . catMaybes
            =<< mapM screenWorkspace (zipWith const [0..] handles)
    put state
 
mergePPOutputs :: [PP -> X String] -> PP -> X String
mergePPOutputs x pp = fmap (intercalate (ppSep pp)) . sequence $ map ($ pp) x
 
onlyTitle :: PP -> PP
onlyTitle pp = defaultPP { ppCurrent = const "", ppHidden = const "", ppVisible = const "", ppLayout = ppLayout pp, ppTitle = ppTitle pp }
 
-- | Requires a recent addition to xmobar (>0.9.2)
xmobarScreen :: Int -> IO Handle
xmobarScreen = spawnPipe . ("xmobar -x " ++) . show
 
myPP :: PP
myPP = defaultPP
    { ppTitle = xmobarColor "orange" ""
    , ppCurrent = xmobarColor "white" ""
    , ppSep = " : "
    , ppLayout = xmobarColor "green" ""
    , ppVisible = xmobarColor "white" "" . wrap "(" ")"
    , ppUrgent = xmobarColor "red" "" . ("^"++)}
--------------------------------------------------------------
 
-------------------- X.Actions.TopicSpace --------------------
myTopics :: [Topic]
myTopics =
  [ "dashboard" -- the first one
  , "admin", "build", "cleaning", "conf", "darcs", "haskell", "irc"
  , "mail", "movie", "music", "talk", "text", "web"
  , "yi", "documents", "pdf", "xmobar", "xmonad-conf", "xmonad-extras", "xmonad-newconfig", "xmonad-contrib"
  , "gitit", "gimp"
  ]
 
myTopicConfig = TopicConfig
  { topicDirs = M.fromList $
      [ ("conf", "conf")
      , ("dashboard", "./")
      , ("yi", "wip/dev-haskell/yi")
      , ("darcs", "wip/dev-haskell/darcs")
      , ("haskell", "haskell")
      , ("xmonad-conf", ".xmonad")
      , ("xmonad-extras", "wip/x11-wm/xmonad/extras/xmonad-extras/XMonad")
      , ("xmonad-newconfig", "wip/x11-wm/xmonad/core/xmonad-newconfig")
      , ("xmonad-contrib", "wip/x11-wm/xmonad/contrib/XMonadContrib/XMonad")
      , ("xmobar", "wip/x11-wm/xmobar")
      , ("movie", "media/movie")
      , ("music", "media/music")
      , ("documents", "doc")
      , ("pdf", "ref")
      , ("gitit", "wip/gitit")
      , ("gimp", "./")
      ]
  , defaultTopicAction = const $ spawnShell >*> 2
  , defaultTopic = "dashboard"
  , maxTopicHistory = 10
  , topicActions = M.fromList $
      [ ("xmonad-conf", spawnShellIn ".xmonad/lib/XMonad/Layout" >>
                        spawn "urxvt -e vim ~/.xmonad/xmonad.hs")
      , ("xmonad-contrib", spawnShell >*> 2)
      , ("xmonad-newconfig", spawn "urxvt -e vim ~/wip/x11-wm/xmonad/core/xmonad-newconfig/XMonad/ConfigMonad.hs")
      , ("xmobar",     spawnShellIn "wip/x11-wm/xmobar/Plugins" >*> 2)
      , ("music",      spawn "urxvt -e ncmpc" >> spawn "export MPD_HOST=192.168.1.2; mpc && urxvt -e ncmpc -h 192.168.1.2")
      , ("mail",       spawn "urxvt -e mutt")
      , ("irc",        spawn "urxvt -e ssh engage.uwaterloo.ca")
      , ("dashboard",  spawnShell)
      , ("web",        spawn "firefox")
      , ("movie",      spawnShell)
      , ("pdf",        spawn "okular")
      , ("gimp",       spawnOn ?spawner "gimp" "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 15 0)
    t <- asks (terminal . config)
    spawnHere ?spawner $ "cd " ++ dir ++ " && " ++ t ++ " -bg " ++ color
 
promptedGoto = workspacePrompt myXPConfig $ switchTopic myTopicConfig
 
promptedShift = workspacePrompt myXPConfig $ \x -> windows (W.greedyView x . W.shift x)