Personal tools

Xmonad/Config archive/adamvo's xmonad.hs

From HaskellWiki

< Xmonad | Config archive(Difference between revisions)
Jump to: navigation, search
(fix type variable ambiguity with changed GSConfig)
(update for ewmh)
Line 3: Line 3:
  
 
<haskell>
 
<haskell>
 +
-- current darcs as of 2009-10-24
 
{-# OPTIONS_GHC -W -fno-warn-missing-signatures #-}
 
{-# OPTIONS_GHC -W -fno-warn-missing-signatures #-}
 
{-# LANGUAGE NoMonomorphismRestriction, ImplicitParams, FlexibleInstances #-}
 
{-# LANGUAGE NoMonomorphismRestriction, ImplicitParams, FlexibleInstances #-}
-- module Main where
 
  
 
import XMonad
 
import XMonad
 
import qualified XMonad.StackSet as W
 
import qualified XMonad.StackSet as W
 
import qualified Data.Map as M
 
import qualified Data.Map as M
 +
 +
import Control.Monad.Instances ()
  
 
-- Update these with:  ghc -ddump-minimal-imports
 
-- Update these with:  ghc -ddump-minimal-imports
 +
import Control.Applicative((<*), liftA2)
 +
import Control.Monad(Monad(return, (>>=), (>>)), Functor(..), (=<<), mapM, sequence, (<=<), zipWithM_)
 +
import Data.Function((.), const, ($), flip)
 +
import Data.IORef(newIORef)
 +
import Data.List((++), filter, zip, map, concatMap, length, repeat, zipWith, unwords, isPrefixOf, intercalate, nub)
 +
import Data.Maybe(Maybe(Nothing), catMaybes, fromMaybe)
 +
import Data.Monoid(Monoid(mconcat))
 +
import Graphics.X11.Xinerama(getScreenInfo)
 +
import System.IO(IO, Handle, hPutStrLn)
 
import XMonad.Actions.DwmPromote(dwmpromote)
 
import XMonad.Actions.DwmPromote(dwmpromote)
import XMonad.Actions.FloatSnap(Direction(..), snapGrow, snapMove,
+
-- import XMonad.Actions.Eval (evalExpressionWithReturn,defaultEvalConfig) -- From xmonad-extras
                                snapShrink)
+
import XMonad.Actions.FloatSnap(Direction2D(..), snapGrow, snapMove, snapShrink)
import XMonad.Actions.GridSelect(defaultColorizer, gridselect,
+
import XMonad.Actions.GridSelect(gridselect, GSConfig(gs_navigate), defaultGSConfig, goToSelected)
                                GSConfig(gs_colorizer, gs_navigate), defaultGSConfig, goToSelected)
+
import XMonad.Actions.Search(mathworld, wikipedia, multi, promptSearch)
import XMonad.Actions.Search(mathworld, wikipedia, multi,
+
import XMonad.Actions.SpawnOn -- (manageSpawn, mkSpawner, shellPromptHere, spawnOn)
                            promptSearch)
+
import XMonad.Actions.SpawnOn(manageSpawn, mkSpawner,
+
                              shellPromptHere, spawnDescendantHere)
+
 
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, shiftNthLastFocused, switchNthLastFocused,
+
                                switchTopic)
+
import XMonad.Actions.UpdatePointer(PointerPosition(TowardsCentre),
+
                                    updatePointer)
+
 
import XMonad.Actions.Warp(warpToScreen)
 
import XMonad.Actions.Warp(warpToScreen)
import XMonad.Hooks.DynamicLog(PP(ppSep, ppCurrent, ppHidden,
+
import XMonad.Hooks.DynamicLog(PP(ppTitle, ppLayout, ppVisible, ppHidden, ppCurrent, ppSep), dynamicLogString, defaultPP, xmobarColor, sjanssenPP)
                                  ppVisible, ppLayout, ppTitle),
+
import XMonad.Hooks.EwmhDesktops(ewmh)
                              dynamicLogString, defaultPP, xmobarColor, sjanssenPP)
+
import XMonad.Hooks.ManageDocks(ToggleStruts(ToggleStruts), avoidStruts, manageDocks)
import XMonad.Hooks.EwmhDesktops(ewmhDesktopsEventHook,
+
                                ewmhDesktopsLogHook)
+
import XMonad.Hooks.ManageDocks(ToggleStruts(ToggleStruts),
+
                                avoidStruts, manageDocks)
+
 
import XMonad.Hooks.ManageHelpers(doFullFloat, isFullscreen)
 
import XMonad.Hooks.ManageHelpers(doFullFloat, isFullscreen)
 
import XMonad.Hooks.UrgencyHook(FocusHook(..), withUrgencyHook)
 
import XMonad.Hooks.UrgencyHook(FocusHook(..), withUrgencyHook)
 
import XMonad.Layout.BoringWindows(boringAuto, focusDown, focusUp)
 
import XMonad.Layout.BoringWindows(boringAuto, focusDown, focusUp)
 +
import XMonad.Layout.IM(Property(Role), withIM)
 
import XMonad.Layout.LayoutHints(layoutHintsToCenter)
 
import XMonad.Layout.LayoutHints(layoutHintsToCenter)
 +
import XMonad.Layout.LayoutScreens(layoutScreens)
 
import XMonad.Layout.Mosaic(Aspect(Wider, Taller), mosaic)
 
import XMonad.Layout.Mosaic(Aspect(Wider, Taller), mosaic)
 +
import XMonad.Layout.MouseResizableTile(mouseResizableTile)
 
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.PerWorkspace(onWorkspace)
 
import XMonad.Layout.Simplest(Simplest(..))
 
import XMonad.Layout.Simplest(Simplest(..))
import XMonad.Layout.SubLayouts(GroupMsg(UnMergeAll, UnMerge,
+
import XMonad.Layout.SubLayouts(GroupMsg(UnMergeAll, UnMerge, MergeAll), defaultSublMap, onGroup, pullGroup, pushWindow, subLayout)
                                        MergeAll),
+
import XMonad.Layout.Tabbed(defaultTheme, addTabs, fontName, shrinkText)
                                defaultSublMap, onGroup, pullGroup, pushWindow, subLayout)
+
import XMonad.Layout.TwoPane(TwoPane(..))
import XMonad.Layout.Tabbed(defaultTheme, shrinkText, addTabs)
+
import XMonad.Layout.WindowNavigation(Navigate(Swap, Go), configurableNavigation, navigateColor)
import XMonad.Layout.WindowNavigation(Navigate(Swap, Go),
+
import XMonad.Prompt(XPConfig(font), XPrompt(showXPrompt), greenXPConfig, mkXPrompt)
                                      configurableNavigation, navigateColor)
+
import XMonad.Prompt.Input (inputPrompt)
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 58: Line 59:
 
import XMonad.Prompt.XMonad(xmonadPrompt)
 
import XMonad.Prompt.XMonad(xmonadPrompt)
 
import XMonad.Util.EZConfig(additionalKeysP, checkKeymap)
 
import XMonad.Util.EZConfig(additionalKeysP, checkKeymap)
import XMonad.Util.StringProp(setStringProp, getStringProp)
 
 
import XMonad.Util.Run(spawnPipe)
 
import XMonad.Util.Run(spawnPipe)
import XMonad.Util.Paste(sendKey)
+
import XMonad.Util.StringProp(setStringProp, getStringProp)
import Graphics.X11.Xinerama(getScreenInfo)
+
import XMonad
+
import Control.Applicative(Applicative((<*>)), (<*), (<$), liftA2)
+
import Control.Monad(Monad(return, (>>=), (>>)), Functor(..),
+
                    (=<<), mapM, sequence, (<=<), guard, liftM, zipWithM_)
+
import Data.Function((.), const, ($), flip, id, on)
+
import Data.IORef(IORef, newIORef, readIORef, modifyIORef)
+
import Data.List((++), foldr, filter, zip, map, all, concatMap,
+
                length, repeat, tail, unzip, zipWith, maximum, unwords, isPrefixOf,
+
                intercalate, maximumBy, nub)
+
import Data.Maybe(Maybe(..), maybe, catMaybes, fromMaybe,
+
                  maybeToList)
+
import Data.Monoid(Monoid(mconcat), All(All))
+
import System.IO(IO, Handle, hPutStrLn)
+
 
+
import XMonad.Util.Timer
+
import XMonad.Layout.Reflect
+
  
-- import XMonad.Layout.WMII
+
import XMonad.Util.Replace (replace)
import Data.Traversable (traverse)
+
import XMonad.Layout.BorderResize (borderResize)
import Data.Foldable (traverse_)
+
import XMonad.Layout.WindowArranger
-- import XMonad.Layout.Manual
+
import XMonad.Layout.NoFrillsDecoration
import Data.IORef
+
import XMonad.Layout.SimplestFloat
  
import qualified Data.Set as S
+
import XMonad.Layout.LimitWindows
 
+
import Data.List
-- import Chords
+
import Control.Monad
  
 +
import XMonad.Hooks.ManageHelpers
 +
import XMonad.Layout.Magnifier
 +
import Data.Monoid
 
main :: IO ()
 
main :: IO ()
 
main = do
 
main = do
 +
    replace
 
     spawner <- mkSpawner
 
     spawner <- mkSpawner
 
     pressedKeys <- newIORef M.empty; let ?pressedKeys = pressedKeys
 
     pressedKeys <- newIORef M.empty; let ?pressedKeys = pressedKeys
Line 96: Line 83:
 
     let ?spawner = spawner
 
     let ?spawner = spawner
 
     checkTopicConfig myTopics myTopicConfig
 
     checkTopicConfig myTopics myTopicConfig
     xmonad . withUrgencyHook FocusHook . myConfig =<< mapM xmobarScreen =<< getScreens
+
     xmonad . ewmh . withUrgencyHook FocusHook . myConfig =<< mapM xmobarScreen =<< getScreens
 +
 
 +
sofficeToolbox = className =? "OpenOffice.org 3.1" <&&> isInProperty "WM_PROTOCOLS" "WM_TAKE_FOCUS"
 +
 
 +
logCrossingEvs e@(CrossingEvent { }) = trace (show e) >> return (All True)
 +
logCrossingEvs _ = return (All True)
  
 
myConfig hs = let c = defaultConfig {
 
myConfig hs = let c = defaultConfig {
       layoutHook = myLayout
+
       layoutHook = myLayout  
 
     , focusedBorderColor = "#ff0000"
 
     , focusedBorderColor = "#ff0000"
     , startupHook = do
+
     , startupHook = checkKeymap (myConfig []) (myKeys c)
        return ()
+
        {-
        checkKeymap (myConfig []) (myKeys c)
+
        mapM_ snd
    --   grabChords sampleChords
+
            <=< filterM (\(n,_) -> isNothing . W.peek . W.view n . windowset <$> get)
 +
            . M.toList
 +
            . M.filterWithKey (\k _ -> k `elem` ["web","irc","documents"])
 +
            . topicActions
 +
            $ myTopicConfig
 +
            -}
 
     , terminal = "urxvt"
 
     , terminal = "urxvt"
 
     , modMask = mod4Mask
 
     , modMask = mod4Mask
 
     , logHook = do
 
     , logHook = do
        ewmhDesktopsLogHook
 
 
         multiPP'
 
         multiPP'
 
             (mergePPOutputs [pprWindowSet myTopicConfig,dynamicLogString . onlyTitle])
 
             (mergePPOutputs [pprWindowSet myTopicConfig,dynamicLogString . onlyTitle])
Line 114: Line 110:
 
             myPP { ppTitle = const "" }
 
             myPP { ppTitle = const "" }
 
             hs
 
             hs
         updatePointer (TowardsCentre 0.2 0.2)
+
         -- updatePointer (TowardsCentre 0.2 0.2)
    , handleEventHook = mconcat [
+
        -- mapM_ (runQuery doFloat) =<< filterM (runQuery sofficeToolbox) . W.integrate' . W.stack . W.workspace . W.current . windowset =<< get
            -- evHook 0.05 1000 sampleChords,
+
    , handleEventHook = logCrossingEvs
            ewmhDesktopsEventHook]
+
 
     , workspaces = myTopics
 
     , workspaces = myTopics
     , manageHook = composeAll [
+
     , manageHook = composeAll
                     -- fmap ("Shiretoko" `isInfixOf`) className --> doShift "web" <+> ,
+
                     [manageSpawn ?spawner
                     manageSpawn ?spawner,
+
--                   ,isFullscreen --> doFullFloat
                    isFullscreen --> doFullFloat,
+
                     ,manageDocks
                     manageDocks]
+
                    -- ,sofficeToolbox -->  ((ask >>= doF . W.sink)) -- (ask >>= \w -> liftX (asks display >>= io . flip raiseWindow w) >> doIgnore)
 +
                     ]
 
     } in additionalKeysP c (myKeys c)
 
     } in additionalKeysP c (myKeys c)
  
 
myXPConfig :: XPConfig
 
myXPConfig :: XPConfig
myXPConfig = greenXPConfig { font = "xft:Profont:pixelsize=15:autohint=true" }
+
myXPConfig = greenXPConfig --  { font = "xft:Profont:pixelsize=15:autohint=true" }
  
gsConfig = defaultGSConfig { gs_navigate = neiu `M.union` gs_navigate (defaultGSConfig `asTypeOf` defaultGSConfig) }
+
gsConfig = defaultGSConfig { gs_navigate = neiu `M.union` gs_navigate (defaultGSConfig`asTypeOf`gsConfig) }
     where neiu = M.map (\(x,y) (a,b) -> (x+a,y+b)) $ M.fromList
+
     where neiu = M.insert (0,xK_space) (const (0,0)) $ M.map (\(x,y) (a,b) -> (x+a,y+b)) $ M.fromList
 
             [((0,xK_n),(-1,0))
 
             [((0,xK_n),(-1,0))
 
             ,((0,xK_e),(0,1))
 
             ,((0,xK_e),(0,1))
Line 137: Line 133:
  
 
-------------------- Layout ----------------------------------
 
-------------------- Layout ----------------------------------
myLayout = avoidStruts $ named "M" m ||| named "F" (noBorders Full)
+
myLayout = avoidStruts
     where m = lessBorders Screen
+
        . onWorkspace "floatTest" (named "F" $ borderResize $ noFrillsDeco shrinkText defaultTheme $ windowArrange simplestFloat)
             $ layoutHintsToCenter
+
        . onWorkspace "gimp" (named "G" $ gimp)
             $ addTabs shrinkText defaultTheme
+
        . onWorkspace "movie" (magnifier m)
             $ configurableNavigation (navigateColor "#ffff00")
+
        $ m ||| named "F" (noBorders Full)
             $ boringAuto
+
     where nav = configurableNavigation (navigateColor "#ffff00")
             $ subLayout [] Simplest
+
          m = named "M"
 +
            . lessBorders Screen
 +
             . layoutHintsToCenter
 +
             . addTabs shrinkText defaultTheme
 +
             . nav
 +
             . boringAuto
 +
             . subLayout [] Simplest
 
             $ mosaic 1.5 [7,5,2]
 
             $ mosaic 1.5 [7,5,2]
            -- $ wmii 0.03 1.3
+
          gimp = withIM 0.11 (Role "gimp-toolbox")
--            $ manual 0.2
+
              . 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-d", layoutScreens 2 $ TwoPane 0.5 0.5)
     , ("M4-p", shellPromptHere ?spawner myXPConfig)
+
     ,("S-M-d", rescreen)
     -- , ("M3-p", shellPromptHere ?spawner myXPConfig)
+
     ,("M-S-b", restart "openbox" False)
  
     -- , ((modm, xK_v), sendMessage $ Split 0.5 U)
+
     -- ,("M-r", inputPrompt myXPConfig "Eval" >>= flip whenJust (spawn . ("xmessage -default okay "++) <=< evalExpressionWithReturn defaultEvalConfig))
    -- , ((modm .|. shiftMask, xK_v), addLeft)
+
    -- , ((modm .|. controlMask, xK_v), addRight)
+
  
 
     ,("M-S-o"  , withFocused $ sendMessage . UnMerge  )
 
     ,("M-S-o"  , withFocused $ sendMessage . UnMerge  )
Line 178: Line 183:
 
     ,("M-p",  shellPromptHere ?spawner myXPConfig)
 
     ,("M-p",  shellPromptHere ?spawner myXPConfig)
 
     ,("M-x", submap $ M.fromList subMaps)
 
     ,("M-x", submap $ M.fromList subMaps)
     ,("M-r", submap $ defaultSublMap c  )
+
     ,("M-g", submap $ defaultSublMap c  )
  
 
     ,("M-S-.", focusDown)
 
     ,("M-S-.", focusDown)
Line 185: Line 190:
 
     ,("M-S-a", currentTopicAction myTopicConfig)
 
     ,("M-S-a", currentTopicAction myTopicConfig)
 
     ,("M-a", warpToCentre >> goToSelected gsConfig)
 
     ,("M-a", warpToCentre >> goToSelected gsConfig)
     ,("M-<Tab>", switchNthLastFocused myTopicConfig 1)
+
    -- swap among non-visible topics, regardless of the number of screens I'm using
 +
     ,("M-<Tab>", switchNthLastFocused myTopicConfig . succ . length . W.visible . windowset =<< get )
  
    ,("M-g"  , warpToCentre >> promptedGoto )
 
    ,("M-S-g", warpToCentre >> promptedShift)
 
 
     ,("M-s"  , warpToCentre >> promptedGoto )
 
     ,("M-s"  , warpToCentre >> promptedGoto )
 
     ,("M-S-s", warpToCentre >> promptedShift)
 
     ,("M-S-s", warpToCentre >> promptedShift)
Line 208: Line 212:
 
         ,(""    , 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 218: Line 222:
 
-- 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]
  
Line 235: Line 239:
 
           ((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 >>= spawnDescendantHere ?spawner . terminal),
+
           ((0, xK_c), asks config >>= spawnHere ?spawner . terminal),
 
           ((0, xK_k), kill)
 
           ((0, xK_k), kill)
 
           ]
 
           ]
Line 293: Line 297:
  
 
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 332: Line 336:
 
   , "xmobar"
 
   , "xmobar"
 
   , "wip"
 
   , "wip"
 +
  , "floatTest"
 
   ]
 
   ]
  
Line 358: Line 363:
 
                         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")
 
 
       , ("xmobar",    spawnShellIn "wip/x11-wm/xmobar/Plugins" >*> 2)
 
       , ("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")
 
       , ("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",      spawnOn ?spawner "mail" "urxvt -e mutt")
       , ("irc",        spawn "urxvt -e ssh engage")
+
       , ("irc",        spawnOn ?spawner "irc" "urxvt -e ssh engage.uwaterloo.ca")
      , ("dashboard",  spawnShell)
+
       , ("web",        spawnOn ?spawner "web" "firefox")
       , ("web",        spawnDescendantHere ?spawner "firefox")
+
       , ("pdf",        spawnOn ?spawner "pdf" "okular")
      , ("movie",      spawnShell)
+
       , ("gimp",      spawnHere ?spawner "gimp")
       , ("pdf",        spawn "okular")
+
       , ("gimp",      spawnDescendantHere ?spawner "gimp")
+
 
       ]
 
       ]
 
   }
 
   }
Line 377: Line 379:
 
     -- color <- randomBg' (HSV 255 255)
 
     -- color <- randomBg' (HSV 255 255)
 
     t <- asks (terminal . config)
 
     t <- asks (terminal . config)
     spawnDescendantHere ?spawner $ "cd " ++ dir ++ " && " ++ t -- ++ " -bg " ++ color
+
     spawnHere ?spawner $ "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)

Revision as of 01:12, 25 October 2009

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

-- current darcs as of 2009-10-24
{-# OPTIONS_GHC -W -fno-warn-missing-signatures #-}
{-# LANGUAGE NoMonomorphismRestriction, ImplicitParams, FlexibleInstances #-}
 
import XMonad
import qualified XMonad.StackSet as W
import qualified Data.Map as M
 
import Control.Monad.Instances ()
 
-- Update these with:  ghc -ddump-minimal-imports
import Control.Applicative((<*), liftA2)
import Control.Monad(Monad(return, (>>=), (>>)), Functor(..), (=<<), mapM, sequence, (<=<), zipWithM_)
import Data.Function((.), const, ($), flip)
import Data.IORef(newIORef)
import Data.List((++), filter, zip, map, concatMap, length, repeat, zipWith, unwords, isPrefixOf, intercalate, nub)
import Data.Maybe(Maybe(Nothing), catMaybes, fromMaybe)
import Data.Monoid(Monoid(mconcat))
import Graphics.X11.Xinerama(getScreenInfo)
import System.IO(IO, Handle, hPutStrLn)
import XMonad.Actions.DwmPromote(dwmpromote)
-- import XMonad.Actions.Eval (evalExpressionWithReturn,defaultEvalConfig) -- From xmonad-extras
import XMonad.Actions.FloatSnap(Direction2D(..), snapGrow, snapMove, snapShrink)
import XMonad.Actions.GridSelect(gridselect, GSConfig(gs_navigate), defaultGSConfig, goToSelected)
import XMonad.Actions.Search(mathworld, wikipedia, multi, promptSearch)
import XMonad.Actions.SpawnOn -- (manageSpawn, mkSpawner, shellPromptHere, spawnOn)
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(ppTitle, ppLayout, ppVisible, ppHidden, ppCurrent, ppSep), dynamicLogString, defaultPP, xmobarColor, sjanssenPP)
import XMonad.Hooks.EwmhDesktops(ewmh)
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.IM(Property(Role), withIM)
import XMonad.Layout.LayoutHints(layoutHintsToCenter)
import XMonad.Layout.LayoutScreens(layoutScreens)
import XMonad.Layout.Mosaic(Aspect(Wider, Taller), mosaic)
import XMonad.Layout.MouseResizableTile(mouseResizableTile)
import XMonad.Layout.Named(named)
import XMonad.Layout.NoBorders(Ambiguity(Screen), lessBorders, noBorders)
import XMonad.Layout.PerWorkspace(onWorkspace)
import XMonad.Layout.Simplest(Simplest(..))
import XMonad.Layout.SubLayouts(GroupMsg(UnMergeAll, UnMerge, MergeAll), defaultSublMap, onGroup, pullGroup, pushWindow, subLayout)
import XMonad.Layout.Tabbed(defaultTheme, addTabs, fontName, shrinkText)
import XMonad.Layout.TwoPane(TwoPane(..))
import XMonad.Layout.WindowNavigation(Navigate(Swap, Go), configurableNavigation, navigateColor)
import XMonad.Prompt(XPConfig(font), XPrompt(showXPrompt), greenXPConfig, mkXPrompt)
import XMonad.Prompt.Input (inputPrompt)
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.Run(spawnPipe)
import XMonad.Util.StringProp(setStringProp, getStringProp)
 
import XMonad.Util.Replace (replace)
import XMonad.Layout.BorderResize (borderResize)
import XMonad.Layout.WindowArranger
import XMonad.Layout.NoFrillsDecoration
import XMonad.Layout.SimplestFloat
 
import XMonad.Layout.LimitWindows
import Data.List
import Control.Monad
 
import XMonad.Hooks.ManageHelpers
import XMonad.Layout.Magnifier
import Data.Monoid
main :: IO ()
main = do
    replace
    spawner <- mkSpawner
    pressedKeys <- newIORef M.empty; let ?pressedKeys = pressedKeys
    delay <- newIORef Nothing; let ?delay = delay
    let ?spawner = spawner
    checkTopicConfig myTopics myTopicConfig
    xmonad . ewmh . withUrgencyHook FocusHook . myConfig =<< mapM xmobarScreen =<< getScreens
 
sofficeToolbox = className =? "OpenOffice.org 3.1" <&&> isInProperty "WM_PROTOCOLS" "WM_TAKE_FOCUS"
 
logCrossingEvs e@(CrossingEvent { }) = trace (show e) >> return (All True)
logCrossingEvs _ = return (All True)
 
myConfig hs = let c = defaultConfig {
      layoutHook = myLayout 
    , focusedBorderColor = "#ff0000"
    , startupHook = checkKeymap (myConfig []) (myKeys c)
        {-
        mapM_ snd
            <=< filterM (\(n,_) -> isNothing . W.peek . W.view n . windowset <$> get)
            . M.toList
            . M.filterWithKey (\k _ -> k `elem` ["web","irc","documents"])
            . topicActions
            $ myTopicConfig
            -}
    , terminal = "urxvt"
    , modMask = mod4Mask
    , logHook = do
        multiPP'
            (mergePPOutputs [pprWindowSet myTopicConfig,dynamicLogString . onlyTitle])
            myPP
            myPP { ppTitle = const "" }
            hs
        -- updatePointer (TowardsCentre 0.2 0.2)
        -- mapM_ (runQuery doFloat) =<< filterM (runQuery sofficeToolbox) . W.integrate' . W.stack . W.workspace . W.current . windowset =<< get
    , handleEventHook = logCrossingEvs
    , workspaces = myTopics
    , manageHook = composeAll
                    [manageSpawn ?spawner
--                    ,isFullscreen --> doFullFloat
                    ,manageDocks
                     -- ,sofficeToolbox -->  ((ask >>= doF . W.sink)) -- (ask >>= \w -> liftX (asks display >>= io . flip raiseWindow w) >> doIgnore)
                    ]
    } in additionalKeysP c (myKeys c)
 
myXPConfig :: XPConfig
myXPConfig = greenXPConfig --  { font = "xft:Profont:pixelsize=15:autohint=true" }
 
gsConfig = defaultGSConfig { gs_navigate = neiu `M.union` gs_navigate (defaultGSConfig`asTypeOf`gsConfig) }
    where neiu = M.insert (0,xK_space) (const (0,0)) $ M.map (\(x,y) (a,b) -> (x+a,y+b)) $ M.fromList
            [((0,xK_n),(-1,0))
            ,((0,xK_e),(0,1))
            ,((0,xK_i),(1,0))
            ,((0,xK_u),(0,-1))]
 
-------------------- Layout ----------------------------------
myLayout = avoidStruts
         . onWorkspace "floatTest" (named "F" $ borderResize $ noFrillsDeco shrinkText defaultTheme $ windowArrange simplestFloat)
         . onWorkspace "gimp" (named "G" $ gimp)
         . onWorkspace "movie" (magnifier m)
         $ m ||| named "F" (noBorders Full)
    where nav = configurableNavigation (navigateColor "#ffff00")
          m = named "M"
            . lessBorders Screen
            . layoutHintsToCenter
            . addTabs shrinkText defaultTheme
            . nav
            . boringAuto
            . subLayout [] Simplest
            $ mosaic 1.5 [7,5,2]
          gimp = withIM 0.11 (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-d", layoutScreens 2 $ TwoPane 0.5 0.5)
    ,("S-M-d", rescreen)
    ,("M-S-b", restart "openbox" False)
 
    -- ,("M-r", inputPrompt myXPConfig "Eval" >>= flip whenJust (spawn . ("xmessage -default okay "++) <=< evalExpressionWithReturn defaultEvalConfig))
 
    ,("M-S-o"  , withFocused $ sendMessage . UnMerge   )
    ,("M-S-C-o", withFocused $ sendMessage . UnMergeAll)
    ,("M-C-m"  , withFocused $ sendMessage . MergeAll  )
    ,("M-C-."  , onGroup W.focusDown')
    ,("M-C-,"  , onGroup W.focusUp'  )
 
    ,("M-;", sendMessage Taller)
    ,("M-o", sendMessage Wider )
 
    ,("M-p",  shellPromptHere ?spawner 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)
    -- swap among non-visible topics, regardless of the number of screens I'm using
    ,("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 'XMonad.recompile False >>= flip Control.Monad.unless System.Exit.exitFailure'"
                            ++ "&& xmonad --restart")
    ,("M-S-q", spawn "~/wip/x11-wm/xmonad/rebuild.sh")
    ,("<Print>",  spawn "scrot")
    ]
    ++
    concatMap (\(m,f) -> lrud ("M-"++m) f)
        [("S-"  , sendMessage . Swap)
        ,("C-"  , sendMessage . pullGroup)
        ,("S-C-", sendMessage . pushWindow)
        ,(""    , sendMessage . Go)]
    ++ mediaKeys ++
    [("M-"++m++[key], screenWorkspace sc >>= flip whenJust (windows . f))
        | (f, m) <- [(W.view, ""), (W.shift, "S-")]
        , (key, sc) <- zip "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 ?spawner myXPConfig),
           ((0, xK_x), xmonadPrompt myXPConfig),
           ((0, xK_z), sshPrompt myXPConfig),
           ((shiftMask, xK_w), windowPromptGoto myXPConfig),
           ((0, xK_w), promptSearch myXPConfig wikipedia),
           ((0, xK_s), promptSearch myXPConfig multi),
           ((0, xK_m), promptSearch myXPConfig mathworld),
           ((0, xK_b), sendMessage ToggleStruts),
           ((0, xK_f), withFocused $ windows . W.sink),
           ((0, xK_v), refresh),
           ((0, xK_c), asks config >>= spawnHere ?spawner . terminal),
           ((0, xK_k), kill)
           ]
 
mediaKeys = [("<XF86AudioPlay>", mpcAct "toggle"),
             ("<XF86AudioStop>", hostPrompt),
             ("<XF86AudioNext>", mpcAct "next"),
             ("<XF86AudioPrev>", mpcAct "prev"),
             ("<XF86AudioMute>", spawn "ossmix vmix0-outvol 0"),
             ("S-<XF86AudioMute>", spawn "~/bin/speakers.sh"),
             ("<XF86AudioLowerVolume>",   spawn "ossmix vmix0-outvol -- -1"),
             ("S-<XF86AudioLowerVolume>", spawn "ossmix vmix0-outvol -- -0.1"),
             ("<XF86AudioRaiseVolume>",   spawn "ossmix vmix0-outvol +1"),
             ("S-<XF86AudioRaiseVolume>", spawn "ossmix vmix0-outvol +0.1"),
             ("<XF86Sleep>",              spawn "sudo sh -c 'echo mem > /sys/power/state'")]
    where mpcAct c = do
            h <- withDisplay $ flip getStringProp mpdHost
            spawn $ unwords ["export MPD_HOST="++fromMaybe "localhost" h,";","mpc",c]
 
mpdHost = "XMONAD_MPD_HOST"
 
-- Prompt for mpd host
data HostPrompt = HostPrompt
instance XPrompt HostPrompt where showXPrompt _ = "Pick MPD Host: "
hostPrompt = mkXPrompt HostPrompt myXPConfig (return . compl) f
    where compl s = nub $ filter (s `isPrefixOf`) ["localhost","dell"]
          f x = withDisplay $ \d -> setStringProp d mpdHost x
--------------------------------------------------------------
 
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 -> X PP
        pickPP ws = do
            let foc = W.tag . W.workspace . W.current $ windowset state
            put state { windowset = W.view ws $ windowset state }
            return $ if ws == foc then focusPP else unfocusPP
    io . zipWithM_ hPutStrLn handles
            =<< mapM (dynlStr <=< pickPP) . catMaybes
            =<< mapM screenWorkspace (zipWith const [0..] handles)
    put state
 
mergePPOutputs :: [PP -> X String] -> PP -> X String
mergePPOutputs x pp = fmap (intercalate (ppSep pp)) . sequence . 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" "" }
--------------------------------------------------------------
 
-------------------- X.Actions.TopicSpace --------------------
myTopics :: [Topic]
myTopics =
  [ "dashboard"
  , "web"
  , "haskell"
  , "irc"
  , "admin"
  , "documents"
  , "gimp"
  , "gitit"
  , "mail"
  , "movie"
  , "music"
  , "pdf"
  , "xmonad-conf"
  , "xmonad-contrib"
  , "xmonad-extras"
  , "xmonad-newconfig"
  , "xmobar"
  , "wip"
  , "floatTest"
  ]
 
myTopicConfig = TopicConfig
  { topicDirs = M.fromList $
      [ ("dashboard", "./")
      , ("haskell", "haskell")
      , ("xmonad-conf", ".xmonad")
      , ("xmonad-extras", "wip/x11-wm/xmonad/extras/xmonad-extras/XMonad")
      , ("xmonad-newconfig", "wip/x11-wm/xmonad/core/xmonad-newconfig")
      , ("xmonad-contrib", "wip/x11-wm/xmonad/contrib/XMonadContrib/XMonad")
      , ("xmobar", "wip/x11-wm/xmobar")
      , ("movie", "media/movie")
      , ("music", "media/music")
      , ("documents", "doc")
      , ("pdf", "ref")
      , ("gitit", "wip/gitit")
      , ("gimp", "./")
      , ("wip", "wip")
      ]
  , defaultTopicAction = const $ spawnShell >*> 2
  , defaultTopic = "dashboard"
  , maxTopicHistory = 10
  , topicActions = M.fromList $
      [ ("xmonad-conf", spawnShellIn ".xmonad/lib/XMonad/Layout" >>
                        spawn "urxvt -e vim ~/.xmonad/xmonad.hs")
      , ("xmonad-contrib", spawnShell >*> 2)
      , ("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",       spawnOn ?spawner "mail" "urxvt -e mutt")
      , ("irc",        spawnOn ?spawner "irc" "urxvt -e ssh engage.uwaterloo.ca")
      , ("web",        spawnOn ?spawner "web" "firefox")
      , ("pdf",        spawnOn ?spawner "pdf" "okular")
      , ("gimp",       spawnHere ?spawner "gimp")
      ]
  }
 
-- From the sample config in TopicSpace, these should probably be exported from that module
spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
 
spawnShellIn dir = do
    -- color <- randomBg' (HSV 255 255)
    t <- asks (terminal . config)
    spawnHere ?spawner $ "cd " ++ dir ++ " && " ++ t -- ++ " -bg " ++ color
 
wsgrid = gridselect gsConfig =<< 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)