xmonad config

import XMonad
import XMonad.Actions.CycleWS
import XMonad.Actions.Volume
import XMonad.Config.Desktop
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.EwmhDesktops
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
import XMonad.Hooks.SetWMName
import XMonad.Hooks.UrgencyHook
import System.IO
import XMonad.Layout.Circle
import XMonad.Layout.DecorationMadness
import qualified XMonad.Layout.Grid as G
import XMonad.Layout.HintedGrid
import XMonad.Layout.IM
import XMonad.Layout.NoBorders
import XMonad.Layout.PerWorkspace
import XMonad.Layout.Reflect
import XMonad.Prompt
import XMonad.Prompt.Shell
import qualified XMonad.StackSet as W
import XMonad.Util.Run(spawnPipe)
import XMonad.Util.EZConfig
import XMonad.Util.Scratchpad
import Data.List
import Data.Ratio
import Foreign.C.Types
import Debug.Trace

modm = mod3Mask -- caps-lock key for mod

myManageHook :: ManageHook
myManageHook = composeAll
            [ className =? "MPlayer"           --> doFloat
            , className =? "Gitk"              --> doFloat
            , className =? "Google-chrome"     --> doShift "1:web"
            , className =? "Chromium-browser"  --> doShift "1:web"
            , className =? "Firefox"           --> doShift "1:web"
            , className =? "Emacs"             --> doShift "2:emacs"
            , className =? "Pcmanfm"           --> doShift "4:files"
            , className =? "Vlc"               --> doShift "5:cinema"
                    , className =? "Vncviewer"         --> doShift "5:cinema"
            , className =? "Deluge"            --> doShift "6:torrent"
            , className =? "Gimp"              --> doShift "7:gimp"
            , className =? "Pidgin"            --> doShift "9:im"
            , className =? "Skype"             --> doShift "9:im"
            , className =? "feh"               --> doCenterFloat
                    , className =? "Speedcrunch"       --> doCenterFloat
                    , className =? "Gweather-applet-2" --> doCenterFloat
                    , className =? "Wicd-client.py"    --> doCenterFloat
                    , className =? "com-mathworks-util-PostVMInit" --> doCenterFloat
            , className =? "Paman"             --> doFloat
            , className =? "Pavucontrol"       --> doFloat
            , className =? "Xmessage"          --> doCenterFloat
            , isDialog                         --> doCenterFloat
            , className =? "Vncviewer"         --> doFullFloat
                    , isFullscreen                     --> doFullFloat
            , resource  =? "desktop_window"    --> doIgnore
            , className =? "Qt-subapplication" --> doIgnore
            , checkMenu                        --> doFloat
            , checkDialog                      --> doFloat
            , checkPopupMenu                   --> doFloat
            , scratchpadManageHook (W.RationalRect 0.25 0.2 0.5 0.5)
                    ]

getProp :: Atom -> Window -> X (Maybe [CLong])
getProp a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w

checkAtom name value = ask >>= \w -> liftX $ do
        a <- getAtom name
        val <- getAtom value
        mbr <- getProp a w
        return $ case mbr of
               Just r -> elem val $ map fromIntegral r
               _      -> False

checkDialog = checkAtom "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG"
checkMenu = checkAtom "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_MENU"
checkPopupMenu = checkAtom "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_POPUP_MENU"

-- shell prompt theme
mySP = defaultXPConfig
       { font = "xft:DejaVu Sans Mono:pixelsize=10"
       , bgColor           = "#000000"
       , fgColor           = "#f8f8f8"
       , fgHLight          = "#f8f8f8"
       , bgHLight          = "steelblue3"
       , borderColor       = "#191970"
       , promptBorderWidth = 1
       , position          = Top
       , height            = 20
       , defaultText       = []
       }

--  Strip xmobar markup. Useful to remove ppHidden color from ppUrgent
--   field. For example:
-- >     , ppHidden          = xmobarColor "gray20" "" . wrap "<" ">"
-- >     , ppUrgent          = xmobarColor "dark orange" "" .  xmobarStrip
xmobarStrip :: String -> String
xmobarStrip = strip [] where
    strip keep x
      | null x                 = keep
      | "<fc="  `isPrefixOf` x = strip keep (drop 1 . dropWhile (/= '>') $ x)
      | "</fc>" `isPrefixOf` x = strip keep (drop 5  x)
      | '<' == head x          = strip (keep ++ "<") (tail x)
      | otherwise              = let (good,x') = span (/= '<') x
                 in strip (keep ++ good) x'

myLayouts =  (layoutHook desktopConfig ||| G.Grid)
usualL l = smartBorders $ avoidStruts $ l
gimpL = usualL $ withIM (0.11) (Role "gimp-toolbox") $ reflectHoriz $ withIM (0.15) (Role "gimp-dock") myLayouts
termL = usualL G.Grid

imL = usualL $ withIM (1%7) skype $ reflectHoriz $ withIM (1%7) pidgin myLayouts
      where
    pidgin = And (ClassName "Pidgin") (Role "buddy_list")
    skype  = (ClassName "Skype") `And` (Not (Title "Options")) `And` (Not (Role "Chats")) `And` (Not (Role "CallWindowForm"))

main = do
  xmproc <- spawnPipe "xmobar ~/.xmobarrc"
  -- dzen <- spawnPipe "dzen2"
  xmonad $ withUrgencyHook NoUrgencyHook desktopConfig {
           modMask = modm
             , normalBorderColor = "#333333"
         , focusedBorderColor = "#191970"
         , workspaces = ["1:web", "2:emacs", "3:term", "4:files", "5:cinema", "6:torrent", "7:gimp","8:misc","9:im"]
             , terminal = "urxvtc -sw -si"
         , logHook = takeTopFocus >> (dynamicLogWithPP $ xmobarPP
                          { ppOutput = hPutStrLn xmproc
                          , ppTitle = xmobarColor "#6666ff" "" . shorten 100
                      , ppUrgent = xmobarColor "grey" "#3A0E76" . Main.xmobarStrip
                          }) >> ewmhDesktopsLogHook
                                  >> setWMName "LG3D"
         -- ,  logHook = dynamicLogWithPP $ dzenPP { ppOutput = hPutStrLn dzen }
         , layoutHook = onWorkspace "7:gimp" gimpL $ onWorkspace "9:im" imL $ onWorkspace "3:term" termL $ usualL myLayouts
         , borderWidth = 1
         , manageHook = myManageHook <+> manageDocks
         } `additionalKeys`
         [ ((modm, xK_p), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"")
         ] `additionalKeysP`
         [ ("M-`",         scratchpadSpawnActionTerminal "urxvtc -bg rgba:0000/0000/0000/eeee") -- scratch
         , ("M-C-c",       spawn "speedcrunch") -- calculator
         , ("M-C-r",       refresh) -- refresh
         , ("M-<Left>",    prevWS ) -- left workspace
         , ("M-<Right>",   nextWS ) -- right workspace
         , ("M-C-<Left>",  shiftToPrev >> prevWS ) -- schlep left workspace
         , ("M-C-<Right>", shiftToNext >> nextWS ) -- schlep right workspace
         , ("M-s",         shellPrompt mySP) -- shell
             , ("C-1",         shellPrompt mySP) -- shell
         , ("M-C--",       spawn "transset-df -a --dec .1")
         , ("M-C-=",       spawn "transset-df -a --inc .1")
             , ("<XF86AudioMute>",toggleMute >> return ())
             , ("<XF86AudioLowerVolume>",lowerVolume 3 >> return ())
             , ("<XF86AudioRaiseVolume>",raiseVolume 3 >> return ())
             ]

takeTopFocus = withWindowSet $ maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek

atom_WM_TAKE_FOCUS = getAtom "WM_TAKE_FOCUS"
takeFocusX w = withWindowSet $ \ws -> do
         dpy <- asks display
         wmtakef <- atom_WM_TAKE_FOCUS
         wmprot <- atom_WM_PROTOCOLS
         protocols <- io $ getWMProtocols dpy w
         if (wmtakef `elem` protocols) then
             do
               io $ allocaXEvent $ \ev -> do
                    setEventType ev clientMessage
                                setClientMessageEvent ev w wmprot 32 wmtakef currentTime
                    sendEvent dpy w False noEventMask ev else
             return ()