petulant.hs

import Control.Applicative
import Control.Monad
import Data.Map.Strict (Map, (!))
import qualified Data.Map.Strict as Map
import Data.Monoid
import Data.String
import Data.Text
import Language.Haskell.TH
import System.Exit
import System.IO
import Text.Regex.Posix
import XMonad
import XMonad.Util.Run(spawnPipe)
import XMonad.Hooks.DynamicLog
import XMonad.Layout.NoBorders
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
import XMonad.Util.EZConfig
import XMonad.Util.WorkspaceCompare
import XMonad.Layout.Named
import XMonad.Layout.Gaps
import XMonad.Layout
import XMonad.Layout.Fullscreen
import XMonad.Layout.PerWorkspace (onWorkspace)
import XMonad.Layout.Renamed
import qualified Data.Map as M
import XMonad.StackSet as W (focusUp, focusDown, sink, shift, greedyView)
import XMonad.Hooks.SetWMName
import XMonad.Layout.Tabbed
import XMonad.Layout.Spacing
import XMonad.Hooks.UrgencyHook
import System.Directory (getHomeDirectory)
import XMonad.Hooks.EwmhDesktops
 
main = do
   status <- spawnPipe myDzenStatus

   icons <- loadIconPaths
 
   xmonad $ withUrgencyHook NoUrgencyHook  $ ewmh defaultConfig
    {
     manageHook         = manageDocks <+> myManageHook <+> manageHook defaultConfig
    , logHook            = myLogHook status
    , terminal           = "urxvt"
    , borderWidth        = 1
    , normalBorderColor  = "#777777"
    , focusedBorderColor = "#333377"
    , layoutHook         = avoidStruts $ myLayoutHook icons
    , workspaces         = myWorkspaces icons
    , startupHook        = docksStartupHook <+> setWMName  "LG3D"
    , handleEventHook    =  docksEventHook <+>handleEventHook defaultConfig <+> XMonad.Hooks.EwmhDesktops.fullscreenEventHook
    }
     `additionalKeys`
        [
          ((mod4Mask,xK_v), spawn "gvim")
        , ((mod1Mask,xK_b), sendMessage ToggleStruts)
        , ((mod4Mask,xK_f), spawn ("firefox"))
        ]
 
myLayoutHook :: IconPaths -> _ 
myLayoutHook icons 
  = onWorkspace (icons ! "ws_web")  webLayout
  $ onWorkspace (icons ! "ws_creative") playLayout
  $ onWorkspace (icons ! "ws_play") playLayout
  $ standardLayout
  where
    standardLayout = avoidStruts $ tabbed shrinkText myTabTheme||| tall ||| Mirror tall ||| noBorders Full
    tall           = renamed [Replace "Gaps"] $ spacing 4 $ Tall 1 (5/100) (2/(1+(toRational(sqrt(5)::Double))))
    webLayout      = avoidStruts $ tabbed shrinkText myTabTheme ||| playLayout
    playLayout     = noBorders ( fullscreenFull Full )
 
myLogHook h  = dynamicLogWithPP $ myDzenPP { ppOutput                         = hPutStrLn h }
 
myDzenStatus = "/usr/bin/dzen2 -xs '1'  -ta 'l' -e 'button2=;' "    ++ myDzenStyle
myDzenFont   = " -fn '-*-terminus-*-*-*-*-*-*-*-*-*-*-*'"
myDzenStyle  = " -w '600'  -h '20' -fg '#777777' -bg '#222222'" ++ myDzenFont
 
getIconPath :: String -> IO String
getIconPath iconName = do
    hd <- getHomeDirectory
    return $ "^i(" ++ hd ++ ".xmonad/dzen2/" ++ iconName ++ ")"
 
myDzenPP = dzenPP
    { ppCurrent         = dzenColor "#3399ff" "" . current
    , ppHidden          = dzenColor "#777777" "" . hidden
    , ppHiddenNoWindows = dzenColor "#333333" "" . hiddenNoWin
    , ppUrgent          = dzenColor "#ff0000" "" . urgent
    , ppVisible         = dzenColor "#2277dd" "" . visible
    , ppLayout          = dzenColor "#aaaaaa" "" . justWrap
    , ppTitle           = dzenColor "#ffffff" "" . justWrap
    , ppSep             = dzenColor "#111111" ""   sepString
    }
    where
     sepString    =  "^ro(1x20)"
     iconWrap     =  wrap         "^i(/home/wantthisgone/.xmonad/dzen2/has_win.xbm)"  " "
     justWrap     =  wrap         " "     " "
 
-- checks if it has a color bitmap ( xpm ) and then sets the different looks for it based on state
     current      =  txtreplace   ".xpm"  "_current.xpm"   .  iconWrap
     hidden       =  txtreplace   ".xpm"  "_current.xpm"   .  justWrap
     hiddenNoWin  =  txtreplace   ".xpm"  "_inactive.xpm"  .  justWrap
     urgent       =  txtreplace   ".xpm"  "_urgent.xpm"    .  justWrap
     visible      =  txtreplace   ".xpm"  "_visible.xpm"   .  justWrap
 
myManageHook = composeAll
    [
        (className  =? "Firefox" <&&> resource =? "Dialog") --> doFloat
    ,   manageDocks
    ]   where viewShift =  ask >>= doF . W.sink
 
myWorkspaces icons =
    [ icons ! "ws_web"
    , icons ! "ws_chat"
    , icons ! "ws_work"
    , icons ! "ws_creative"
    , icons ! "ws_play"
    , "6"
    , "7"
    , "8"
    , icons ! "ws_misc"
    ]
 
-- Tab theme
tabFont                   = "-*-terminus-*-*-*-8-*-*-*-*-*-*-*"
 
myTabTheme :: Theme
myTabTheme                = defaultTheme
    { fontName            = tabFont
    , inactiveBorderColor = colorBlackAlt
    , inactiveColor       = colorBlack
    , inactiveTextColor   = colorWhite
    , activeBorderColor   = colorGray
    , activeColor         = colorBlackAlt
    , activeTextColor     = colorGreen
    , urgentBorderColor   = colorGray
    , urgentTextColor     = colorGreen
    , decoHeight          = 14
    }
-- I want the workspace icons to be set via the getIconPath function.
 
-- Workspace names/icons

type IconPaths = Map String String
loadIconPaths :: IO IconPaths
loadIconPaths = traverse getIconPath $ Map.fromList 
    [ ("ws_web",       "fox.xbm")
    , ("ws_chat",      "cat.xbm")
    , ("ws_work",      "bug_01.xbm")
    , ("ws_creative",  "face.xbm")
    , ("ws_play",      "controller.xbm")
    , ("ws_misc",      "slackware.xbm")
    ]

-- Color definitions
colorBlack           = "#020202" --Background (Dzen_BG)
colorBlackAlt        = "#1c1c1c" --Black Xdefaults
colorGray            = "#444444" --Gray       (Dzen_FG2)
colorGrayAlt         = "#161616" --Gray dark
colorWhite           = "#a9a6af" --Foreground (Shell_FG)
colorWhiteAlt        = "#9d9d9d" --White dark (Dzen_FG)
colorMagenta         = "#8e82a2"
colorBlue            = "#3475aa"
colorRed             = "#d74b73"
colorGreen           = "#99cc66"
 
txtreplace::String -> String -> String -> String
txtreplace  needle replacement haystack = unpack (replace (pack needle) (pack replacement) (pack haystack))