xmonad.hs

import Control.Monad
import Data.Monoid
import Data.Ratio
import Graphics.X11.ExtraTypes.XF86
import qualified Data.Map as M
import qualified XMonad.Layout.IM as IM
import qualified XMonad.StackSet as W
import System.IO
import XMonad.Actions.CycleWS
import XMonad.Actions.UpdatePointer
import XMonad hiding (Point)
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.EwmhDesktops
import XMonad.Hooks.FadeInactive
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
import XMonad.Hooks.UrgencyHook
import XMonad.Layout.ComboP
import XMonad.Layout.Dishes
import XMonad.Layout.Grid
import XMonad.Layout.LayoutHints
import XMonad.Layout.Minimize
import XMonad.Layout.MultiToggle
import XMonad.Layout.MultiToggle.Instances
import XMonad.Layout.Named
import XMonad.Layout.NoBorders hiding (Never)
import XMonad.Layout.Reflect
import XMonad.Layout.ResizableTile
import XMonad.Layout.Tabbed
import XMonad.Layout.TwoPane
import XMonad.Layout.WorkspaceDir
import XMonad.Prompt
import XMonad.Prompt.AppLauncher as AL
import XMonad.Prompt.Shell
import XMonad.Util.EZConfig
import XMonad.Util.Run(spawnPipe, runProcessWithInput)
--import XMonad.Actions.UpdatePointer

myModMask = mod4Mask
myTerminal = "uxterm"

myDock = "killall trayer; trayer --SetPartialStrut true --height 8 --widthtype request --align right --edge top --transparent true --tint 0x000000"

myUrgencyConfig = urgencyConfig { suppressWhen = Visible }

xmobarStrip2 = xmobarStrip . concatMap (\x -> if (x == '}' || x == '{') then [] else [x])

spaces = [([d], [d]) | d <- ['a'..'z']]

programs = [ ("c", "google-chrome")
           , ("s", "sonata")
           , ("g", "gimp")
           , ("l", "xscreensaver-command -lock")
           , ("f", "firefox")
           , ("x", myTerminal ++ " -e ssh uni")
           , ("k", "kill $(pgrep -f libgcflashplayer)")
           ]

main = do
    xmproc <- spawnPipe "xmobar"
    spawn myDock
    cmds <- io getCommands
    xmonad $ withUrgencyHookC NoUrgencyHook myUrgencyConfig $ defaultConfig
        { manageHook = myManageHooks <+> manageDocks 
        , layoutHook = avoidStruts $ smartBorders $ workspaceDir "~" myLayout
        , logHook = do
            -- For fancy compositing -- run xcompmgr for this!
            fadeInactiveLogHook 0.8
            -- I like what this does, but it seems a bit buggy.
            -- updatePointer (Relative 0.5 0.5)
            (dynamicLogWithPP $ xmobarPP
                        { ppOutput = hPutStrLn xmproc
                        , ppTitle = xmobarColor "#2aa198" "" . xmobarStrip2
                        , ppUrgent = xmobarColor "yellow" "red" . xmobarStrip2
                        , ppCurrent = xmobarColor "#b58900" "" . wrap "[" "]"
                        })
        , modMask = myModMask
        , terminal = myTerminal
        , handleEventHook = myEventHook
        , workspaces = workspaces defaultConfig ++ [s | (k, s) <- spaces]
        } `removeKeysP`
        [ "M-S-c" 
        ] `additionalKeysP` (
        [ ("C-<Print>", spawn "sleep 0.2; scrot -s")
        , ("<Print>", spawn "scrot")
        , ("M-d", spawn "disp --restore; xmonad --restart; xmodmap ~/.Xmodmap")
        , ("M-S-q", spawn "xmonad --recompile; xmonad --restart")
        , ("M-q", spawn "xmonad --restart")
        , ("M-<Return>", spawn myTerminal)
        , ("M-S-<Return>", spawn $ myTerminal ++ " -class xterm-top")
        , ("M-C-<Return>", spawn $ myTerminal ++ " -class xterm-float")
        , ("M-z", windows W.swapMaster)
        , ("M-c", kill)
        , ("M-S-h", sendMessage MirrorShrink)
        , ("M-S-l", sendMessage MirrorExpand)
        , ("M-S-f", sendMessage $ Toggle FULL)
        , ("M-S-m", sendMessage $ Toggle MIRROR)
        , ("M-r", shellPrompt myXPConfig)
        -- Hack to make the launcher quicker to start.
        -- This may or may not be usefull, i can't remember....
        , ("M-g", mkXPrompt Shell myXPConfig (getShellCompl cmds) (spawn . encodeOutput))
        , ("M-<Esc>", toggleWS) --  <-- Really really usefull!!!
        , ("M-f", withFocused toggleFloating)
        , ("M-s", changeDir myXPConfig)
        , ("M-<Down>", spawn "mpc toggle")
        , ("M-<Up>", spawn "mpc stop")
        , ("M-<Left>", spawn "mpc prev")
        , ("M-<Right>", spawn "mpc next")
        , ("M-\\", withFocused (\f -> sendMessage (MinimizeWin f)))
        , ("M-S-\\", sendMessage RestoreNextMinimizedWin)
        , ("<XF86AudioPlay>", spawn "mpc toggle")
        , ("<XF86AudioStop>", spawn "mpc stop")
        , ("<XF86AudioPrev>", spawn "mpc prev")
        , ("<XF86AudioNext>", spawn "mpc next")
        , ("<XF86AudioRaiseVolume>", spawn "mpc volume +1")
        , ("<XF86AudioLowerVolume>", spawn "mpc volume -1")
        , ("<XF86AudioMute>", spawn "mpc volume 60")
        , ("M-<XF86AudioMute>", spawn "mpc volume 80")
        , ("<XF86Launch1>", spawn "xset dpms force off")
        , ("M-/", spawn "amixer set Mic toggle")
        -- Add in keys for launching programs and switching spaces.
        ] ++ programKeys ++ spaceKeys) `additionalKeys`
        -- Stuff for my lights. These are here because these keys don't have
        -- aliases in aditionalKeysP (they're actually f16-f19 or something...)
        [ ((0, xF86XK_Launch7), spawn "shet /tom/toggle_desk")
        , ((0, xF86XK_Launch8), spawn "shet /tom/toggle_bedside")
        , ((0, xF86XK_Launch9), spawn "shet /tom/toggle_reading")
        , ((0, xF86XK_Eject), spawn "shet /tom/exit")
        -- Switch between workspaces with the mouse.
        ] `additionalMouseBindings`
        [ ((myModMask, 6), (\w -> prevWS))
        , ((myModMask, 7), (\w -> nextWS))
        ]
        where
          myManageHooks = composeAll
                          [ isFullscreen --> doFullFloat
                          , className =? "xterm-float" --> doCenterFloat
                          , className =? "Wine" --> doFloat
                          , className =? "Xmessage" --> doCenterFloat
                          , className =? "MPlayer" --> doFloat
                          -- , resource  =? "desktop_window" --> doIgnore
                          -- , resource  =? "kdesktop"       --> doIgnore
                          , title =? "xfce4-notifyd"       --> doIgnore
                          ]
          myLayout = ((withTerm "Tall" tall) |||
                      (withTerm "Mirror Tall" $ Mirror tall) |||
                      (withTerm "Full" Full) |||
                      (withTerm "Grid" Grid) |||
                      (withTerm "Gimp" gimp))
                   where
                     tall = ResizableTall 1 (5/100) (1/2) []
                     -- Tabbed GIMP payout.
                     gimp = combineTwoP (TwoPane 0.03 0.11) (tabbed shrinkText defaultTheme)
                               (combineTwoP (TwoPane 0.03 0.85) 
                                            (tabbed shrinkText defaultTheme) 
                                            (tabbed shrinkText defaultTheme) 
                                            (Not $ Role "gimp-dock"))
                               (Role "gimp-toolbox")
                     -- Give a layout a name, and modify it to put xterm-top windows at the top.
                     withTerm n l = named n $
                                    minimize $
                                    layoutHints $
                                    Mirror $
                                    IM.withIM (0.15) (IM.ClassName "xterm-top") $ 
                                    Mirror l
          
          myXPConfig = defaultXPConfig {position = Top}
          -- Toggle a window between floating and tiled.
          toggleFloating w = windows (\s -> if M.member w (W.floating s)
                                               then W.sink w s 
                                               else (W.float w (W.RationalRect 0.25 0.25 0.5 0.5) s))
          -- Build lists of keyboard shortcuts from the above programs and spaces.
          programKeys = [("M-p " ++ k, spawn c) | (k, c) <- programs]
          spaceKeys = [("M-x " ++ k, windows $ W.greedyView s) | (k, s) <- spaces]
                      ++ [("M-S-x " ++ k, windows $ W.shift s) | (k, s) <- spaces]
          myEventHook = handleEventHook defaultConfig-- +++ fullscreenEventHook
            where x +++ y = mappend x y