Personal tools

Xmonad/Config archive/adamvo's xmonad.hs

From HaskellWiki

< Xmonad | Config archive(Difference between revisions)
Jump to: navigation, search
m (add recompile in background)
(use implicit parameters to pass spawner ioref around)
Line 1: Line 1:
 
<haskell>
 
<haskell>
 
{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}
 
{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}
  +
{-# LANGUAGE ImplicitParams #-}
 
module Main where
 
module Main where
   
Line 11: Line 12:
 
-- Update these with: ghc -ddump-minimal-imports
 
-- Update these with: ghc -ddump-minimal-imports
 
import XMonad.Layout.LayoutHints(layoutHints2) -- not in contrib
 
import XMonad.Layout.LayoutHints(layoutHints2) -- not in contrib
  +
  +
import XMonad.Util.NamedActions -- not pushed yet
   
 
import Graphics.X11.Xinerama(getScreenInfo)
 
import Graphics.X11.Xinerama(getScreenInfo)
 
import Control.Monad(Monad(return, (>>), (>>=)), Functor(..),
 
import Control.Monad(Monad(return, (>>), (>>=)), Functor(..),
 
(=<<), mapM, sequence, zipWithM_)
 
(=<<), mapM, sequence, zipWithM_)
  +
import Control.Applicative((<$>))
 
import Data.List((++), zip, map, concatMap, repeat, zipWith,
 
import Data.List((++), zip, map, concatMap, repeat, zipWith,
intercalate, isInfixOf)
+
isPrefixOf, nub, intercalate, isInfixOf)
import Data.Maybe(catMaybes)
+
import Data.Maybe(catMaybes, maybeToList)
 
import Data.Ratio((%))
 
import Data.Ratio((%))
 
import System.IO(IO, Handle, hPutStrLn)
 
import System.IO(IO, Handle, hPutStrLn)
Line 28: Line 32:
 
promptSearch)
 
promptSearch)
 
import XMonad.Actions.Submap(submap)
 
import XMonad.Actions.Submap(submap)
import XMonad.Actions.TopicSpace(Dir, TopicConfig(..), Topic,
+
import XMonad.Actions.TopicSpace(TopicConfig(..), Topic,
 
(>*>), checkTopicConfig, currentTopicAction, currentTopicDir,
 
(>*>), checkTopicConfig, currentTopicAction, currentTopicDir,
pprWindowSet, switchNthLastFocused, switchTopic)
+
pprWindowSet, switchNthLastFocused, switchTopic,
  +
getStringProp, setStringProp)
 
import XMonad.Hooks.DynamicLog(PP(ppUrgent, ppTitle, ppLayout,
 
import XMonad.Hooks.DynamicLog(PP(ppUrgent, ppTitle, ppLayout,
 
ppVisible, ppHidden, ppCurrent, ppSep),
 
ppVisible, ppHidden, ppCurrent, ppSep),
Line 42: Line 46:
 
focusUp)
 
focusUp)
 
import XMonad.Layout.Mosaic(Mosaic(..),
 
import XMonad.Layout.Mosaic(Mosaic(..),
Aspect(Wider, Taller, SlopeMod))
+
Aspect(..))
 
import XMonad.Layout.Named(named)
 
import XMonad.Layout.Named(named)
 
import XMonad.Layout.NoBorders(Ambiguity(Screen), lessBorders, noBorders)
 
import XMonad.Layout.NoBorders(Ambiguity(Screen), lessBorders, noBorders)
Line 53: Line 57:
 
Navigate(Swap, Go), configurableNavigation, navigateColor)
 
Navigate(Swap, Go), configurableNavigation, navigateColor)
 
import XMonad.Layout.WorkspaceDir(changeDir, workspaceDir)
 
import XMonad.Layout.WorkspaceDir(changeDir, workspaceDir)
import XMonad.Prompt(defaultXPConfig)
+
import XMonad.Prompt(XPrompt(..),XPConfig(..),greenXPConfig,mkXPrompt)
 
import XMonad.Prompt.RunOrRaise(runOrRaisePrompt)
 
import XMonad.Prompt.RunOrRaise(runOrRaisePrompt)
 
import XMonad.Prompt.Shell(shellPrompt)
 
import XMonad.Prompt.Shell(shellPrompt)
Line 60: Line 64:
 
import XMonad.Prompt.Workspace(workspacePrompt)
 
import XMonad.Prompt.Workspace(workspacePrompt)
 
import XMonad.Prompt.XMonad(xmonadPrompt)
 
import XMonad.Prompt.XMonad(xmonadPrompt)
import XMonad.Util.EZConfig(additionalKeys)
 
 
import XMonad.Util.Run(spawnPipe)
 
import XMonad.Util.Run(spawnPipe)
  +
  +
import XMonad.Actions.SpawnOn
  +
  +
-- import XMonad.Layout.Manual
   
 
main :: IO ()
 
main :: IO ()
 
main = do
 
main = do
  +
sp <- mkSpawner
  +
let ?spawner = sp
 
checkTopicConfig myTopics myTopicConfig
 
checkTopicConfig myTopics myTopicConfig
 
xmonad . withUrgencyHook NoUrgencyHook . myConfig
 
xmonad . withUrgencyHook NoUrgencyHook . myConfig
Line 70: Line 79:
 
=<< getScreens
 
=<< getScreens
   
myConfig hs = (\x -> additionalKeys x $ myKeys x) $ defaultConfig
+
myConfig hs = addDescrKeys ((mod4Mask, xK_d), xMessage) myKeys $ defaultConfig
 
{ layoutHook = myLayout
 
{ layoutHook = myLayout
 
, focusedBorderColor = "#ff0000"
 
, focusedBorderColor = "#ff0000"
Line 76: Line 85:
 
, modMask = mod4Mask
 
, modMask = mod4Mask
 
, logHook = ewmhDesktopsLogHook >> myLogHook hs
 
, logHook = ewmhDesktopsLogHook >> myLogHook hs
, startupHook = refresh
+
, startupHook = refresh -- help avoidStruts
 
, handleEventHook = ewmhDesktopsEventHook
 
, handleEventHook = ewmhDesktopsEventHook
 
, workspaces = myTopics
 
, workspaces = myTopics
, manageHook = manageDocks
+
, manageHook = composeAll
<+> (fmap (isInfixOf "Gran Paradiso") className --> doShift "web")
+
[ manageSpawn ?spawner
  +
, manageDocks
  +
, fmap (isInfixOf "Gran Paradiso") className --> doShift "web"
  +
]
 
}
 
}
  +
-- where ?spawner = ?spawner
  +
  +
myXPConfig :: XPConfig
  +
myXPConfig = greenXPConfig { font = "xft:Profont:pixelsize=15:autohint=true" }
   
 
-------------------- Layout ----------------------------------
 
-------------------- Layout ----------------------------------
Line 95: Line 108:
 
$ layoutHints2 -- unfinished modifications to layoutHints: ask if you want this
 
$ layoutHints2 -- unfinished modifications to layoutHints: ask if you want this
 
$ Mosaic [5,4,2,1,1,1]
 
$ Mosaic [5,4,2,1,1,1]
  +
-- $ manual 0.5
  +
 
--------------------------------------------------------------
 
--------------------------------------------------------------
   
 
-------------------- Keys ------------------------------------
 
-------------------- Keys ------------------------------------
myKeys :: XConfig l -> [((KeyMask, KeySym), X ())]
+
myKeys :: (?spawner::Spawner) =>XConfig t -> [((KeyMask, KeySym), NamedAction)]
 
myKeys c@(XConfig { modMask = modm }) =
 
myKeys c@(XConfig { modMask = modm }) =
[((modm, xK_h), sendMessage . SlopeMod $ zipWith (+) (map (/5) [1..]))
+
[ subtitle "Resizing"
,((modm, xK_l), sendMessage . SlopeMod $ (\(x:xs) -> max 1 x:xs) . map (max 0.05) . zipWith subtract (map (/5) [1..]))
+
,((modm, xK_h), addName "Shrink" $ sendMessage . SlopeMod $ zipWith (+) (map (/5) [1..]))
,((modm .|. shiftMask, xK_h), sendMessage $ SlopeMod init)
+
,((modm, xK_l), addName "Expand" $ sendMessage . SlopeMod $ (\(x:xs) -> max 1 x:xs) . map (max 0.05) . zipWith subtract (map (/5) [1..]))
,((modm .|. shiftMask, xK_l), sendMessage $ SlopeMod (++[1]))
+
,((modm .|. shiftMask, xK_h), addName "Show Less Windows" $ sendMessage $ SlopeMod init)
  +
,((modm .|. shiftMask, xK_l), addName "Show More Windows" $ sendMessage $ SlopeMod (++[1]))
   
,((modm, xK_q), spawn "~/xmonad/xmonad-recomp.lhs && xmonad --restart")
+
, subtitle "SubLayouts"
  +
,((modm .|. controlMask, xK_o), addName "unmerge the current window"
  +
$ 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')
   
,((modm, xK_Tab), switchNthLastFocused myTopicConfig 1)
+
, subtitle "Mosaic"
  +
,((modm, xK_semicolon), addName "Taller" $ sendMessage Taller)
  +
,((modm, xK_o), addName "Wider" $ sendMessage Wider)
   
,((0, xK_Print), spawn "scrot")
+
, subtitle "Submaps"
,((modm, xK_Return), dwmpromote)
+
,((modm, xK_x), submapName $ subMaps)
,((modm, xK_a), goToSelected defaultGSConfig)
+
,((modm, xK_s), addName "send a normal action to a sublayout" $ submap $ defaultSublMap c)
   
-- SubLayouts
+
, subtitle "Focus"
,((modm .|. controlMask, xK_o), withFocused $ sendMessage . UnMerge)
+
,((modm .|. shiftMask, xK_Right), addName "slide to the next ws" $ shiftToNext >> nextWS)
,((modm .|. shiftMask .|. controlMask, xK_o), withFocused $ sendMessage . UnMergeAll)
+
,((modm .|. shiftMask, xK_Left ), addName "slide to the previous ws" $ shiftToPrev >> prevWS)
,((modm .|. controlMask, xK_m), withFocused $ sendMessage . MergeAll)
+
,((modm, xK_Right ), addName "view next nonempty ws" $ moveTo Next NonEmptyWS)
,((modm .|. controlMask, xK_period), onGroup W.focusDown')
+
,((modm, xK_Left ), addName "view previous nonempty ws" $ moveTo Prev NonEmptyWS)
,((modm .|. controlMask, xK_comma), onGroup W.focusUp')
+
,((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)
   
-- Mosaic
+
, subtitle "TopicSpace"
,((modm, xK_semicolon), sendMessage Taller)
+
,((modm .|. shiftMask, xK_a), addName "run the topic's action" $ currentTopicAction myTopicConfig)
,((modm, xK_o), sendMessage Wider)
+
,((modm, xK_a), addName "gridselect a window" $ goToSelected defaultGSConfig)
  +
,((modm, xK_Tab), addName "view the last workspace" $ switchNthLastFocused myTopicConfig 1)
  +
,((modm, xK_g ), addName "go to topic" promptedGoto)
   
-- Submaps
+
, separator
,((modm, xK_x), submap . M.fromList $ subMaps)
+
,((modm, xK_Return), addName "promote to master" $ dwmpromote)
,((modm, xK_s), submap $ defaultSublMap c)
+
,((modm .|. shiftMask, xK_Return), addName "terminal" spawnShell)
  +
,((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")
   
-- Focus changes
 
,((modm .|. shiftMask, xK_Right), shiftToNext >> nextWS)
 
,((modm .|. shiftMask, xK_Left ), shiftToPrev >> prevWS)
 
,((modm, xK_Right ), moveTo Next NonEmptyWS)
 
,((modm, xK_Left ), moveTo Prev NonEmptyWS)
 
,((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_Return), spawnShell)
 
,((modm .|. shiftMask, xK_a), currentTopicAction myTopicConfig)
 
,((modm, xK_g ), promptedGoto)
 
,((modm .|. shiftMask, xK_g ), promptedShift)
 
 
]
 
]
++ concatMap (\(m,f) -> lrud (modm .|. m) f)
+
^++^ [subtitle "WindowNavigation"] ^++^
[(shiftMask, sendMessage . Swap)
+
concatMap (\(m,(n,f)) -> lrud (modm .|. m) (\d -> addName (n ++ ' ':show d) $ f d))
,(controlMask, sendMessage . pullGroup)
+
[(shiftMask, ("swap",sendMessage . Swap))
,(0, sendMessage . Go)
+
,(controlMask, ("pull group",sendMessage . pullGroup))
  +
,(0, ("change focus", sendMessage . Go))
 
]
 
]
++ mediaKeys
+
^++^ [subtitle "Media Keys"] ^++^ mediaKeys
++ [((m .|. modm, key), screenWorkspace sc >>= flip whenJust (windows . f)) |
+
^++^ [subtitle "Workspaces"] ^++^
(key, sc) <- zip [xK_w, xK_f, xK_p] ([0 .. ]),
+
[((m .|. modm, key), addName (unwords [d,"workspace",show sc]) $ screenWorkspace sc >>= flip whenJust (windows . f)) |
(f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
+
(f, m, d) <- [(W.view, 0, "view"), (W.shift, shiftMask, "shift to")],
++ [ ((modm, k), switchNthLastFocused myTopicConfig i)
+
(key, sc) <- zip [xK_w, xK_f, xK_p] ([0 .. ])]
  +
^++^
  +
[ ((modm, k), addName (unwords ["view the last",show i,"topic"]) $ switchNthLastFocused myTopicConfig i)
 
| (i, k) <- zip [1..] [xK_1 .. xK_9]]
 
| (i, k) <- zip [1..] [xK_1 .. xK_9]]
   
Line 163: Line 164:
 
cmds = zipWith ($) (repeat cmd) [L,R,U,D]
 
cmds = zipWith ($) (repeat cmd) [L,R,U,D]
   
subMaps :: [((KeyMask, KeySym), X ())]
+
subMaps :: (?spawner::Spawner) => [((KeyMask, KeySym), NamedAction)]
subMaps = [((0, xK_o), runOrRaisePrompt defaultXPConfig),
+
subMaps = [((0, xK_o), addName "run or raise prompt" $ runOrRaisePrompt myXPConfig),
((0, xK_p), shellPrompt defaultXPConfig),
+
((0, xK_p), addName "shell prompt" $ shellPrompt myXPConfig),
((0, xK_x), xmonadPrompt defaultXPConfig),
+
((0, xK_x), addName "xmonad prompt" $ xmonadPrompt myXPConfig),
((0, xK_z), sshPrompt defaultXPConfig),
+
((0, xK_z), addName "ssh prompt" $ sshPrompt myXPConfig),
((shiftMask, xK_w), windowPromptGoto defaultXPConfig),
+
((shiftMask, xK_w), addName "window gotoPrompt" $ windowPromptGoto myXPConfig),
((0, xK_w), promptSearch defaultXPConfig wikipedia),
+
((0, xK_w), addName "search wikipedia" $ promptSearch myXPConfig wikipedia),
((0, xK_s), promptSearch defaultXPConfig multi),
+
((0, xK_s), addName "search multi" $ promptSearch myXPConfig multi),
((0, xK_m), promptSearch defaultXPConfig mathworld),
+
((0, xK_m), addName "search mathworld" $ promptSearch myXPConfig mathworld),
((0, xK_d), changeDir defaultXPConfig),
+
((0, xK_d), addName "change dir" $ changeDir myXPConfig),
((0, xK_b), sendMessage ToggleStruts),
+
((0, xK_b), sendMessage' ToggleStruts),
((0, xK_f), withFocused $ windows . W.sink), ((0, xK_v), refresh),
+
((0, xK_f), addName "sink" $ withFocused $ windows . W.sink),
((0, xK_c), asks config >>= spawn . terminal), ((0, xK_k), kill)
+
((0, xK_v), addName "refresh" refresh),
  +
((0, xK_c), addName "terminal" $ asks config >>= spawnHere ?spawner . terminal),
  +
((0, xK_k), addName "close window" kill)
 
]
 
]
   
mediaKeys :: [((KeyMask, KeySym), X ())]
+
mediaKeys :: [((KeyMask, KeySym), NamedAction)]
mediaKeys = [((0, xF86XK_AudioPlay), spawn "mpc toggle"),
+
mediaKeys = [((0, xF86XK_AudioPlay), mpcAct "toggle"),
((0, xF86XK_AudioStop), spawn "mpc stop"),
+
((shiftMask, xF86XK_AudioPlay), addName "HostPrompt" hostPrompt),
((0, xF86XK_AudioNext), spawn "mpc next"),
+
((0, xF86XK_AudioStop), mpcAct "stop"),
((0, xF86XK_AudioPrev), spawn "mpc prev"),
+
((0, xF86XK_Forward), mpcAct "next"),
((0, xF86XK_AudioMute), spawn "/home/adamvo/bin/ossvol -t"),
+
((0, xF86XK_Back), mpcAct "prev"),
((shiftMask, xF86XK_AudioMute), spawn "/home/adamvo/bin/speakers.sh"),
+
((0, xF86XK_AudioNext), mpcAct "next"),
((0, xF86XK_AudioLowerVolume), spawn "/home/adamvo/bin/ossvol -d 1"),
+
((0, xF86XK_AudioPrev), mpcAct "prev"),
((shiftMask, xF86XK_AudioLowerVolume), spawn "/home/adamvo/bin/ossvol -d 0.1"),
+
((0, xF86XK_AudioMute), addName "toggle mute" $ spawn "~/bin/ossvol -t"),
((0, xF86XK_AudioRaiseVolume), spawn "/home/adamvo/bin/ossvol -i 1"),
+
((shiftMask, xF86XK_AudioMute), addName "toggle external speakers" $ spawn "~/bin/speakers.sh"),
((shiftMask, xF86XK_AudioRaiseVolume), spawn "/home/adamvo/bin/ossvol -i 0.1"),
+
((0, xF86XK_AudioLowerVolume), spawn' "~/bin/ossvol -d 1"),
((0, xF86XK_Sleep), spawn $ "sudo pm-suspend"),
+
((shiftMask, xF86XK_AudioLowerVolume), spawn' "~/bin/ossvol -d 0.1"),
((shiftMask, xF86XK_Sleep), spawn $ "sudo pm-hibernate")]
+
((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
  +
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"]
  +
 
--------------------------------------------------------------
 
--------------------------------------------------------------
   
Line 231: Line 232:
 
xmobarScreen = spawnPipe . ("xmobar -x " ++) . show
 
xmobarScreen = spawnPipe . ("xmobar -x " ++) . show
   
myLogHook hs = multiPP'
+
myLogHook :: (?spawner::Spawner) => [Handle] -> X ()
  +
myLogHook = multiPP'
 
(flip mergePPOutputs [pprWindowSet myTopicConfig,dynamicLogString . onlyTitle])
 
(flip mergePPOutputs [pprWindowSet myTopicConfig,dynamicLogString . onlyTitle])
 
myPP { ppTitle = xmobarColor "orange" "" }
 
myPP { ppTitle = xmobarColor "orange" "" }
 
myPP { ppTitle = const "" }
 
myPP { ppTitle = const "" }
hs
 
   
 
myPP :: PP
 
myPP :: PP
Line 251: Line 251:
 
[ "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", "xmonad"
+
, "mail", "movie", "music", "talk", "text", "tools", "web"
, "yi", "documents", "pdf"
+
, "yi", "documents", "pdf", "xmobar", "xmonad-conf", "xmonad-newconfig", "xmonad-contrib"
  +
, "gtk-gnutella"
 
]
 
]
   
myTopicConfig :: TopicConfig
+
myTopicConfig :: (?spawner::Spawner) => TopicConfig
 
myTopicConfig = TopicConfig
 
myTopicConfig = TopicConfig
 
{ topicDirs = M.fromList $
 
{ topicDirs = M.fromList $
Line 263: Line 263:
 
, ("darcs", "wip/dev-haskell/darcs")
 
, ("darcs", "wip/dev-haskell/darcs")
 
, ("haskell", "haskell")
 
, ("haskell", "haskell")
, ("xmonad", "wip/x11-wm/xmonad")
+
, ("xmonad-conf", ".xmonad")
  +
, ("xmonad-newconfig", "wip/x11-wm/xmonad/core/xmonad-newconfig")
  +
, ("xmonad-contrib", "wip/x11-wm/xmonad/contrib/XMonadContrib/XMonad")
  +
, ("xmobar", "wip/x11-wm/xmobar")
 
, ("tools", "wip/tools")
 
, ("tools", "wip/tools")
 
, ("movie", "media/movie")
 
, ("movie", "media/movie")
Line 269: Line 269:
 
, ("documents", "doc")
 
, ("documents", "doc")
 
, ("pdf", "ref")
 
, ("pdf", "ref")
  +
, ("gtk-gnutella", ".gtk-gnutella-downloads")
 
]
 
]
 
, defaultTopicAction = const $ spawnShell >*> 2
 
, defaultTopicAction = const $ spawnShell >*> 2
Line 276: Line 277:
 
[ ("haskell", spawnShell >*> 2 >>
 
[ ("haskell", spawnShell >*> 2 >>
 
spawnShellIn "wip/dev-haskell/ghc")
 
spawnShellIn "wip/dev-haskell/ghc")
, ("xmonad", spawnShellIn "wip/x11-wm/xmonad" >>
+
, ("xmonad-conf", spawnShellIn ".xmonad/lib/XMonad/Layout" >>
spawnShellIn "wip/x11-wm/xmonad/contrib" >>
+
spawn "urxvt -e vim ~/.xmonad/xmonad.hs")
spawnShellIn "wip/x11-wm/xmonad/utils" >>
+
, ("xmonad-contrib", spawnShell >*> 2)
spawnShellIn ".xmonad" >>
+
, ("xmonad-newconfig", spawn "urxvt -e vim ~/wip/x11-wm/xmonad/core/xmonad-newconfig/XMonad/ConfigMonad.hs")
spawnShellIn ".xmonad")
+
, ("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 "urxvt -e ncmpc -h 192.168.1.2")
, ("mail", spawn "urxvt -e mutt" >> spawnShell)
+
, ("mail", spawn "urxvt -e mutt")
 
, ("irc", spawn "urxvt -e ssh aavogt@engage.uwaterloo.ca")
 
, ("irc", spawn "urxvt -e ssh aavogt@engage.uwaterloo.ca")
 
, ("dashboard", spawnShell)
 
, ("dashboard", spawnShell)
Line 288: Line 289:
 
, ("movie", spawnShell)
 
, ("movie", spawnShell)
 
, ("pdf", spawn "okular >&| /dev/null")
 
, ("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 :: X ()
+
spawnShell :: (?spawner::Spawner) => X ()
 
spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
 
spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
   
spawnShellIn :: Dir -> X ()
+
spawnShellIn :: (?spawner::Spawner) => [Char] -> X ()
spawnShellIn dir = asks (terminal . config) >>= \term -> spawn $ "cd " ++ dir ++ " && " ++ term ++ " "
+
spawnShellIn dir = asks (terminal . config) >>= \term -> spawnHere ?spawner $ "cd " ++ dir ++ " && " ++ term ++ " "
   
goto :: Topic -> X ()
+
goto :: (?spawner::Spawner) => Topic -> X ()
 
goto = switchTopic myTopicConfig
 
goto = switchTopic myTopicConfig
   
promptedGoto :: X ()
+
promptedGoto :: (?spawner::Spawner) => X ()
promptedGoto = workspacePrompt defaultXPConfig goto
+
promptedGoto = workspacePrompt myXPConfig goto
   
promptedShift :: X ()
+
promptedShift :: X ()
promptedShift = workspacePrompt defaultXPConfig $ windows . W.shift
+
promptedShift = workspacePrompt myXPConfig $ windows . W.shift
 
</haskell>
 
</haskell>

Revision as of 01:04, 16 May 2009

{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}
{-# LANGUAGE ImplicitParams #-}
module Main where
 
import XMonad
import Graphics.X11.ExtraTypes.XF86
 
import qualified XMonad.StackSet as W
import qualified Data.Map as M
 
-- 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.Layout.Manual
 
main :: IO ()
main = do
    sp <- mkSpawner
    let ?spawner = sp
    checkTopicConfig myTopics myTopicConfig
    xmonad . withUrgencyHook NoUrgencyHook . myConfig
        =<< mapM xmobarScreen
        =<< getScreens
 
myConfig hs = addDescrKeys ((mod4Mask, xK_d), xMessage) myKeys $ defaultConfig
    { layoutHook = myLayout
    , focusedBorderColor = "#ff0000"
    , terminal = "urxvt"
    , modMask = mod4Mask
    , logHook = ewmhDesktopsLogHook >> myLogHook hs
    , startupHook = refresh -- help avoidStruts
    , handleEventHook = ewmhDesktopsEventHook
    , workspaces = myTopics
    , manageHook = composeAll
        [ manageSpawn ?spawner
        , manageDocks
        , fmap (isInfixOf "Gran Paradiso") className  --> doShift "web"
        ]
    }
    -- where ?spawner = ?spawner
 
myXPConfig :: XPConfig
myXPConfig = greenXPConfig { font = "xft:Profont:pixelsize=15:autohint=true" }
 
-------------------- Layout ----------------------------------
myLayout = workspaceDir "~"
         $ named "M" mosaic ||| named "F" (noBorders Full)
    where
    mosaic = avoidStruts
         $ lessBorders Screen
         $ addTabs shrinkText defaultTheme
         $ configurableNavigation (navigateColor "#ffff00")
         $ boringWindows
         $ subLayout [] (Simplest ||| Tall 1 (1%6) 0.5)
         $ layoutHints2 -- unfinished modifications to layoutHints: ask if you want this
         $ Mosaic [5,4,2,1,1,1]
--         $ manual 0.5
 
--------------------------------------------------------------
 
-------------------- Keys ------------------------------------
myKeys :: (?spawner::Spawner) =>XConfig t -> [((KeyMask, KeySym), NamedAction)]
myKeys c@(XConfig { modMask = modm }) =
    [ subtitle "Resizing"
    ,((modm, xK_h), addName "Shrink" $ sendMessage . SlopeMod $ zipWith (+) (map (/5) [1..]))
    ,((modm, xK_l), addName "Expand" $ sendMessage . SlopeMod $ (\(x:xs) -> max 1 x:xs) . map (max 0.05) . zipWith subtract (map (/5) [1..]))
    ,((modm .|. shiftMask, xK_h), addName "Show Less Windows" $ sendMessage $ SlopeMod init)
    ,((modm .|. shiftMask, xK_l), addName "Show More Windows" $ sendMessage $ SlopeMod (++[1]))
 
    , subtitle "SubLayouts"
    ,((modm .|. controlMask, xK_o), addName "unmerge the current window"
                                     $ 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"
    ,((modm, xK_semicolon), addName "Taller" $ sendMessage Taller)
    ,((modm, xK_o), addName "Wider" $ sendMessage Wider)
 
    , subtitle "Submaps"
    ,((modm, xK_x), submapName $ subMaps)
    ,((modm, xK_s), addName "send a normal action to a sublayout" $ submap $ defaultSublMap c)
 
    , subtitle "Focus"
    ,((modm .|. shiftMask, xK_Right), addName "slide to the next ws" $ shiftToNext >> nextWS)
    ,((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"
    ,((modm .|. shiftMask, xK_a), addName "run the topic's action" $ currentTopicAction myTopicConfig)
    ,((modm, xK_a), addName "gridselect a window" $ goToSelected defaultGSConfig)
    ,((modm, xK_Tab), addName "view the last workspace" $ switchNthLastFocused myTopicConfig 1)
    ,((modm, xK_g     ), addName "go to topic" promptedGoto)
 
    , separator
    ,((modm, xK_Return), addName "promote to master" $ dwmpromote)
    ,((modm .|. shiftMask, xK_Return), addName "terminal" spawnShell)
    ,((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")
 
    ]
    ^++^ [subtitle "WindowNavigation"] ^++^
    concatMap (\(m,(n,f)) -> lrud (modm .|. m) (\d -> addName (n ++ ' ':show d) $ f d))
        [(shiftMask, ("swap",sendMessage . Swap))
        ,(controlMask,  ("pull group",sendMessage . pullGroup))
        ,(0, ("change focus", sendMessage . Go))
        ]
    ^++^ [subtitle "Media Keys"] ^++^ mediaKeys
    ^++^ [subtitle "Workspaces"] ^++^
    [((m .|. modm, key), addName (unwords [d,"workspace",show sc]) $ screenWorkspace sc >>= flip whenJust (windows . f)) |
        (f, m, d) <- [(W.view, 0, "view"), (W.shift, shiftMask, "shift to")],
        (key, sc) <- zip [xK_w, xK_f, xK_p] ([0 .. ])]
    ^++^
    [ ((modm, k), addName (unwords ["view the last",show i,"topic"]) $ switchNthLastFocused myTopicConfig i)
    | (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 :: (?spawner::Spawner) => [((KeyMask, KeySym), NamedAction)]
subMaps = [((0, xK_o), addName "run or raise prompt" $ runOrRaisePrompt myXPConfig),
           ((0, xK_p), addName "shell prompt" $ shellPrompt myXPConfig),
           ((0, xK_x), addName "xmonad prompt" $ xmonadPrompt myXPConfig),
           ((0, xK_z), addName "ssh prompt" $ sshPrompt myXPConfig),
           ((shiftMask, xK_w), addName "window gotoPrompt" $ windowPromptGoto myXPConfig),
           ((0, xK_w), addName "search wikipedia" $ promptSearch myXPConfig wikipedia),
           ((0, xK_s), addName "search multi" $ promptSearch myXPConfig multi),
           ((0, xK_m), addName "search mathworld" $ promptSearch myXPConfig mathworld),
           ((0, xK_d), addName "change dir" $ changeDir myXPConfig),
           ((0, xK_b), sendMessage' ToggleStruts),
           ((0, xK_f), addName "sink" $ withFocused $ windows . W.sink),
           ((0, xK_v), addName "refresh" refresh),
           ((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
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"]
 
--------------------------------------------------------------
 
-------------------- Support for per-screen xmobars ---------
-- Some parts of this will merged into contrib sometime
getScreens :: IO [Int]
getScreens = withDisplay' $ fmap (enumFromTo 0 . pred . length) . getScreenInfo
    where withDisplay' f = do
            x <- openDisplay ""
            res <- f x
            closeDisplay x
            return res
 
-- | 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 takeLength = zipWith const
        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 ([0..] `takeLength` handles)
    put state
 
mergePPOutputs :: PP -> [PP -> X String] -> X String
mergePPOutputs pp = fmap (intercalate (ppSep pp)) . sequence . map ($ 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 (newer than 0.9.2)
xmobarScreen :: Int -> IO Handle
xmobarScreen = spawnPipe . ("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 = defaultPP
     { 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", "tools", "web"
  , "yi", "documents", "pdf", "xmobar", "xmonad-conf", "xmonad-newconfig", "xmonad-contrib"
  , "gtk-gnutella"
  ]
 
myTopicConfig ::  (?spawner::Spawner) => TopicConfig
myTopicConfig = TopicConfig
  { topicDirs = M.fromList $
      [ ("conf", "conf")
      , ("dashboard", "./")
      , ("yi", "wip/dev-haskell/yi")
      , ("darcs", "wip/dev-haskell/darcs")
      , ("haskell", "haskell")
      , ("xmonad-conf", ".xmonad")
      , ("xmonad-newconfig", "wip/x11-wm/xmonad/core/xmonad-newconfig")
      , ("xmonad-contrib", "wip/x11-wm/xmonad/contrib/XMonadContrib/XMonad")
      , ("xmobar", "wip/x11-wm/xmobar")
      , ("tools", "wip/tools")
      , ("movie", "media/movie")
      , ("music", "media/music")
      , ("documents", "doc")
      , ("pdf", "ref")
      , ("gtk-gnutella", ".gtk-gnutella-downloads")
      ]
  , defaultTopicAction = const $ spawnShell >*> 2
  , defaultTopic = "dashboard"
  , maxTopicHistory = 10
  , topicActions = M.fromList $
      [ ("haskell",    spawnShell >*> 2 >>
                       spawnShellIn "wip/dev-haskell/ghc")
      , ("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 "urxvt -e ncmpc -h 192.168.1.2")
      , ("mail",       spawn "urxvt -e mutt")
      , ("irc",        spawn "urxvt -e ssh aavogt@engage.uwaterloo.ca")
      , ("dashboard",  spawnShell)
      , ("web",        spawn "firefox")
      , ("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
spawnShell ::  (?spawner::Spawner) => X ()
spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
 
spawnShellIn ::  (?spawner::Spawner) => [Char] -> X ()
spawnShellIn dir = asks (terminal . config) >>= \term -> spawnHere ?spawner $ "cd " ++ dir ++ " && " ++ term ++ " "
 
goto ::  (?spawner::Spawner) => Topic -> X ()
goto = switchTopic myTopicConfig
 
promptedGoto ::  (?spawner::Spawner) => X ()
promptedGoto = workspacePrompt myXPConfig goto
 
promptedShift ::  X ()
promptedShift = workspacePrompt myXPConfig  $ windows . W.shift