Difference between revisions of "Xmonad/Config archive/sereven's xmonad.hs one-host"
< Xmonad | Config archive
Jump to navigation
Jump to search
m (change banish mouse binding to avoid replacing default 'focus Master') |
m (Clean up, simplified a bit, nicer dzen strip fn, maybe instead of fromMaybe) |
||
Line 1: | Line 1: | ||
<haskell> |
<haskell> |
||
+ | ------ sereven.0.8.base.xmonad.hs ---------------- |
||
import XMonad |
import XMonad |
||
import qualified XMonad.StackSet as W |
import qualified XMonad.StackSet as W |
||
+ | import System.Environment (getEnvironment) |
||
− | ------ -- |
||
+ | import XMonad.Actions.DynamicWorkspaces |
||
− | import Data.Ratio ((%)) -- for Layout.IM |
||
+ | import XMonad.Actions.WindowNavigation |
||
− | ------ -- |
||
+ | import XMonad.Hooks.DynamicLog |
||
import XMonad.Hooks.ManageDocks |
import XMonad.Hooks.ManageDocks |
||
− | import XMonad.Hooks.ManageHelpers(doCenterFloat) |
+ | import XMonad.Hooks.ManageHelpers(doCenterFloat,composeOne,isFullscreen,doFullFloat,(-?>)) |
import XMonad.Hooks.UrgencyHook |
import XMonad.Hooks.UrgencyHook |
||
− | import XMonad. |
+ | import XMonad.Layout.IM -- (m%n) can be (m/n) don't need Data.Ratio |
+ | import XMonad.Layout.LayoutScreens |
||
− | ------ -- |
||
− | import XMonad. |
+ | import XMonad.Layout.NoBorders |
− | import XMonad. |
+ | import XMonad.Layout.PerWorkspace |
− | import XMonad.Actions.Warp |
||
− | ------ -- |
||
− | import XMonad.Layout.IM |
||
import XMonad.Layout.Reflect |
import XMonad.Layout.Reflect |
||
− | import XMonad.Layout.PerWorkspace |
||
import XMonad.Layout.ResizableTile |
import XMonad.Layout.ResizableTile |
||
+ | import XMonad.Layout.ToggleLayouts as TL |
||
+ | import XMonad.Layout.TwoPane |
||
import XMonad.Layout.WindowNavigation |
import XMonad.Layout.WindowNavigation |
||
− | import XMonad.Layout.NoBorders |
||
− | import qualified XMonad.Layout.ToggleLayouts as TL |
||
− | ------ -- |
||
import XMonad.Prompt |
import XMonad.Prompt |
||
import XMonad.Prompt.Shell |
import XMonad.Prompt.Shell |
||
import XMonad.Prompt.RunOrRaise |
import XMonad.Prompt.RunOrRaise |
||
+ | import XMonad.Util.EZConfig |
||
− | ------ -- |
||
import XMonad.Util.Run |
import XMonad.Util.Run |
||
import XMonad.Util.Scratchpad |
import XMonad.Util.Scratchpad |
||
− | import XMonad.Util. |
+ | import XMonad.Util.WorkspaceCompare (getSortByTag,getSortByIndex) |
+ | modKey = mod4Mask |
||
+ | sWorkspaces = [ [x] | x <- ['A'..'I'] ] -- /3 MINIMUM/ (easy to mod num wss) |
||
+ | ws2 = head . drop 1 $ sWorkspaces |
||
− | -- "Make it so, Mr. X!" -------------------- |
||
+ | ws3 = head . drop 2 $ sWorkspaces |
||
main = do |
main = do |
||
− | dz <- spawnPipe $ |
+ | dz <- spawnPipe $ dzenWith darkXPC |
− | + | home <- fmap (maybe "/home/svv/" (++"/") . lookup "HOME") getEnvironment |
|
+ | conf <- withWindowNavigation (xK_k, xK_h, xK_j, xK_l) $ |
||
− | let sKeys = keysWithPath "/home/gvg" conf |
||
− | + | withUrgencyHook NoUrgencyHook ( |
|
+ | defaultConfig |
||
− | conf {startupHook = return () >> checkKeymap conf sKeys} |
||
+ | { modMask = modKey |
||
− | `additionalKeysP` sKeys |
||
+ | , focusFollowsMouse = True |
||
+ | , terminal = "urxvtc" |
||
+ | , focusedBorderColor = "#694" |
||
+ | , normalBorderColor = "black" |
||
+ | , borderWidth = 1 |
||
+ | , workspaces = sWorkspaces |
||
+ | , layoutHook = sLayouts |
||
+ | , logHook = dynamicLogWithPP $ dzdarkPP home dz |
||
+ | , manageHook = sManageHook |
||
+ | } `additionalKeys` sKeys) |
||
+ | `additionalKeysP` sKeysP -- silly to use both, but.. meh.. |
||
+ | xmonad conf |
||
+ | sKeys = -- need normal bindings for testing ScreenWorkspaces |
||
− | -- using this XConfig |
||
+ | [ ((modKey .|. controlMask, xK_space), sendMessage TL.ToggleLayout ) |
||
+ | , ((modKey,xK_b) , sendMessage ToggleStruts) |
||
+ | , ((shiftMask,xK_F1), shellPrompt darkXPC) |
||
+ | , ((shiftMask,xK_F2), runOrRaisePrompt darkXPC) |
||
+ | , ((shiftMask,xK_F3), scratchpadSpawnActionTerminal "urxvt -pe tabbed") |
||
+ | -- for more screens, workspaces, or exploring ion style subframes |
||
− | sConfig hm dzh = defaultConfig |
||
− | + | , ((modKey, xK_backslash), selectWorkspace darkXPC) |
|
+ | , ((modKey .|. shiftMask ,xK_BackSpace), removeWorkspace) |
||
− | , manageHook = sManageHook |
||
− | , |
+ | , ((modKey , xK_F8), rescreen) |
+ | , ((modKey .|. shiftMask, xK_F8), layoutScreens 4 (Tall 2 (1/8) (1/2))) |
||
− | , logHook = dynamicLogWithPP $ dzdarkPP hm dzh |
||
+ | ] |
||
− | , borderWidth = 1 |
||
− | , focusedBorderColor = "cornsilk3" |
||
− | , normalBorderColor = "gray10" |
||
− | , focusFollowsMouse = True |
||
− | , modMask = mod4Mask |
||
− | , terminal = "urxvtc" |
||
− | } |
||
+ | sKeysP = -- TODO convert to additionalKeys |
||
− | |||
+ | [ ("M-C-k", sendMessage MirrorExpand) |
||
− | -- (frequently edited bits nearer the top) ------- |
||
− | |||
− | keysWithPath hm cfg = |
||
− | |||
− | [ ("M-<F1>", shellPrompt darkXPC) |
||
− | , ("M-<F2>", runOrRaisePrompt darkXPC) |
||
− | , ("M-<F3>", scratchpadSpawnAction cfg) |
||
− | , ("M-<F12>", spawn "xscreensaver-command -lock") |
||
− | |||
− | , ("M-x f", runOrRaise "firefox" (className =? "Firefox")) |
||
− | , ("M-x o", runOrRaise "opera" (className =? "Opera")) |
||
− | , ("M-x r", runOrRaise (hm ++ "/bin/shfmRun") (title =? "shellfm")) |
||
− | , ("M-x h", runOrRaise "hback" (className =? "Hback")) |
||
− | , ("M-x g", spawn "gimp") |
||
− | ] |
||
− | ++ -- vi directional window navigation similar to XMonad defaults |
||
− | [ ("M-k", sendMessage $ Go U) |
||
− | , ("M-j", sendMessage $ Go D) |
||
− | , ("M-h", sendMessage $ Go L) |
||
− | , ("M-l", sendMessage $ Go R) |
||
− | , ("M-S-k", sendMessage $ Swap U) -- shift shifts windows |
||
− | , ("M-S-j", sendMessage $ Swap D) |
||
− | , ("M-S-h", sendMessage $ Swap L) |
||
− | , ("M-S-l", sendMessage $ Swap R) |
||
− | , ("M-C-k", sendMessage MirrorExpand) -- ctrl controls size |
||
, ("M-C-j", sendMessage MirrorShrink) |
, ("M-C-j", sendMessage MirrorShrink) |
||
, ("M-C-h", sendMessage Shrink) |
, ("M-C-h", sendMessage Shrink) |
||
, ("M-C-l", sendMessage Expand) |
, ("M-C-l", sendMessage Expand) |
||
] |
] |
||
− | ++ -- |
+ | ++ -- workspace and screen keys ------------------------------------ |
+ | -- mod-<key> and mod-shift-<key> are as default |
||
-- mod-ctrl-<key> shifts focused window *and* view to <key>'s ws |
-- mod-ctrl-<key> shifts focused window *and* view to <key>'s ws |
||
[ (addtlmods ++ "M-" ++ [key], action tag) |
[ (addtlmods ++ "M-" ++ [key], action tag) |
||
− | | (tag, key) <- zip sWorkspaces " |
+ | | (tag, key) <- zip sWorkspaces "1234567890_=" |
− | , (addtlmods, action) <- [ ("", windows . W.greedyView) |
+ | , (addtlmods, action) <- [ ("", windows . W.greedyView) -- or W.view) |
, ("S-", windows . W.shift) |
, ("S-", windows . W.shift) |
||
, ("C-", \x -> (windows . W.shift) x >> (windows . W.view) x)] |
, ("C-", \x -> (windows . W.shift) x >> (windows . W.view) x)] |
||
− | ] |
||
− | ++ -- mod + m + {left arrow or 'a' key} does action with ws to "left" |
||
− | [ (m ++ "M-" ++ key, action) | key <- ["<L>","a"] |
||
− | , (m, action) <- [ ("", prevWS), ("S-", shiftToPrev), ("C-", shiftToPrev >> prevWS)] |
||
− | ] |
||
− | ++ -- mod + m + {right arrow or 'd' key} does action with ws to "right" |
||
− | [ (m ++ "M-" ++ key, action) | key <- ["<R>","d"] |
||
− | , (m, action) <- [ ("", nextWS), ("S-", shiftToNext), ("C-", shiftToNext >> nextWS)] |
||
− | ] |
||
− | ++ |
||
− | [ ("M-<Space>", sendMessage TL.ToggleLayout ) -- noBorders Full |
||
− | , ("M-b", sendMessage ToggleStruts) |
||
− | , ("M-C-b", warpToScreen 0 (1/2) 0) -- open XM dzen slave; exit mouse manually to collapse :( |
||
− | , ("M-S-b", warpToScreen 0 0 0) -- open sys dzen slave; exit mouse manually to collapse :( |
||
− | , ("M-S-m", warpToWindow 1 1) -- banish mouse to lower right of focused window |
||
] |
] |
||
+ | sManageHook = floatFullscreen <+> composeAll |
||
− | sWorkspaces = ["'%", "%", "%'"] ++ ["'*", "*", "*'"] ++ ["c", "m", "#"] ++ ["@", "SP"] |
||
+ | [ scratchpadManageHookDefault |
||
− | |||
+ | , className =? "Gimp" --> doShift ws3 -- don't float |
||
− | sManageHook = composeAll |
||
+ | , className =? "MPlayer" --> doShift ws2 |
||
− | [ doF avoidMaster |
||
+ | , title =? "shellfm" --> doShift ws2 |
||
− | , scratchpadManageHookDefault |
||
− | |||
− | , title =? "shellfm" --> doShift "'*" |
||
− | , className =? "Gimp" --> doShift "*" -- don't float, IM layout |
||
− | , className =? "MPlayer" --> doShift "*'" |
||
, title =? "" --> doFloat -- SOE graphics |
, title =? "" --> doFloat -- SOE graphics |
||
, title =? "shellfm" --> doFloat |
, title =? "shellfm" --> doFloat |
||
+ | , className =? "MPlayer" --> doFloat |
||
, className =? "Hback" --> doCenterFloat |
, className =? "Hback" --> doCenterFloat |
||
− | , className =? "MPlayer" --> doFloat |
||
, className =? "XFontSel" --> doCenterFloat |
, className =? "XFontSel" --> doCenterFloat |
||
, className =? "Xmessage" --> doCenterFloat |
, className =? "Xmessage" --> doCenterFloat |
||
] |
] |
||
+ | where floatFullscreen = composeOne [isFullscreen -?> doFullFloat] |
||
− | where avoidMaster :: W.StackSet i l a s sd -> W.StackSet i l a s sd |
||
− | avoidMaster = W.modify' $ \c -> case c of |
||
− | W.Stack t [] (r:rs) -> W.Stack t [r] rs |
||
− | otherwise -> c |
||
+ | sLayouts = |
||
− | sLayout = |
||
+ | smartBorders . avoidStruts $ |
||
− | avoidStruts $ configurableNavigation (noNavigateBorders) $ |
||
TL.toggleLayouts (noBorders Full) $ |
TL.toggleLayouts (noBorders Full) $ |
||
− | modWorkspace |
+ | modWorkspace ws3 reflectHoriz $ withIM (11/64) (Role "gimp-toolbox") $ |
+ | onWorkspace ws2 (TwoPane (1/118) (11/15)) $ |
||
ResizableTall 2 -- default number of masters |
ResizableTall 2 -- default number of masters |
||
(1/118) -- resize increment |
(1/118) -- resize increment |
||
− | (11/20) -- horizontal ratio |
+ | (11/20) -- horizontal ratio |
− | [5/4 -- master column ~ top/bottom |
+ | [5/4 -- master column ~ top/bottom |
,5/4 -- no effect w/ 2 masters |
,5/4 -- no effect w/ 2 masters |
||
,5/4 -- slave column ~ top/bottom |
,5/4 -- slave column ~ top/bottom |
||
] -- then defaults to (repeat 1) |
] -- then defaults to (repeat 1) |
||
+ | -- (theming, font, colors) ------------------ |
||
− | -- [gimp] -- Combining gimp-toolbox and gimp-dock into one works |
||
+ | darkXPC :: XPConfig |
||
− | -- well in IM layout roster column. Drag panes from gimp-dock or |
||
− | -- toolbox to top separator or bar of toolbox to add and re-arrange. |
||
− | |||
− | |||
− | -- (dzen and prompt XPConfig) -------------- |
||
− | |||
darkXPC = defaultXPConfig |
darkXPC = defaultXPConfig |
||
− | { font = "-*-dejavu sans mono-medium-r-*-*-17-*-*-*-*-*-*-*" |
+ | { font = "-*-dejavu sans mono-medium-r-*-*-17-*-*-*-*-*-*-*" |
− | , height = |
+ | , height = 28 |
− | , bgColor = "black" |
+ | , bgColor = "black" |
− | , fgColor = " |
+ | , fgColor = "#684" |
− | , bgHLight = " |
+ | , bgHLight = "#785" |
− | , fgHLight = "black" |
+ | , fgHLight = "black" |
− | , promptBorderWidth = 0 |
+ | , promptBorderWidth = 0 |
− | } |
+ | } |
+ | -- (dzen) ---------------------------------- |
||
− | -- adjust dzen position & width to screen; use XPConfig theming |
||
− | + | dzenWith :: XPConfig -> String |
|
+ | dzenWith xpc = -- use XPConfig theming |
||
− | dzenWithParams sx sw xpc = |
||
− | "dzen2 - |
+ | "dzen2 -xs 1 -ta l -h " ++ (show $ height xpc) |
− | ++ " - |
+ | ++ " -fn '" ++ font xpc ++ "'" |
− | ++ " - |
+ | ++ " -bg '" ++ bgColor xpc ++ "'" |
− | ++ " - |
+ | ++ " -fg '" ++ fgColor xpc ++ "'" |
− | ++ " -bg '" ++ (bgColor xpc) ++ "'" |
||
− | ++ " -fg '" ++ (fgColor xpc) ++ "'" |
||
− | ++ " -ta l" |
||
− | -- normal dzen config -- |
||
++ " -e 'onstart=lower'" |
++ " -e 'onstart=lower'" |
||
− | where xpos = sx + sw * 11 `div` 32 -- a`div`b screenwidth empty to left |
||
− | width = sx + sw - sw * 7 `div` 64 - xpos -- and c`div`d to right |
||
− | -- (space for .xinіtrc bar and tray) |
||
− | |||
− | stripDzen s = aux s [] -- strip dzen formatting to undo ppHidden |
||
− | where aux [] acc = acc |
||
− | aux x acc = (\(good,bad) -> aux (dropDzen bad) (acc++good)) $ span (/= '^') x |
||
− | where dropDzen b = drop 1 $ dropWhile (/= ')') b |
||
− | -- dropDzen doesn't properly handle "^^" or non-dzen ')' in text |
||
dzdarkPP hm dzIn = defaultPP |
dzdarkPP hm dzIn = defaultPP |
||
+ | { ppOutput = hPutStrLn dzIn |
||
− | { ppCurrent = wrap "^fg(#4d5)^p(;+7)^r(5x5)^p(+2;-7)^fg()" "" . dzenColor "#bca" "" |
||
− | , |
+ | , ppCurrent = wrap (dzfg hlightCol "^p(;+7)^r(5x5)^p(+2;-7)") "" . dzfg currentCol |
− | , |
+ | , ppVisible = dzfg visibleCol . ("^p(;+7)^ro(5x5)^p(+2;-7)" ++) |
+ | , ppHidden = dzfg hiddenCol |
||
− | , ppHiddenNoWindows = dzenColor "#554" "" |
||
+ | , ppHiddenNoWindows = dzfg fadedCol |
||
− | , ppUrgent = dzenColor "#d54" "" . (\s -> stripDzen s) |
||
+ | , ppUrgent = dzfg urgentCol . (\s -> stripDzen s) |
||
, ppWsSep = kernedsp |
, ppWsSep = kernedsp |
||
, ppSep = "" |
, ppSep = "" |
||
+ | , ppSort = fmap (.scratchpadFilterOutWorkspace) getSortByIndex |
||
, ppExtras = [xmonicon] |
, ppExtras = [xmonicon] |
||
, ppOrder = \(ws:_:_:xs) -> [" "] ++ [ws] ++ xs |
, ppOrder = \(ws:_:_:xs) -> [" "] ++ [ws] ++ xs |
||
+ | } -- for layouts and titles use something like ppOrder = \(ws:l:t:xs) -> [l,ws,t] ++ xs |
||
− | , ppOutput = hPutStrLn dzIn |
||
+ | where dzfg c = dzenColor c "" |
||
− | } |
||
− | + | hlightCol = "#4d5" |
|
+ | currentCol = "#bca" |
||
− | xpm path = wrap ("^i(" ++ path ++ "/.dzen/icons/") ".xpm)" |
||
+ | visibleCol = "#ab9" |
||
+ | hiddenCol = "#786" |
||
+ | fadedCol = "#554" |
||
+ | urgentCol = "#d54" |
||
+ | kernedsp = "^p(+12)" |
||
+ | xpm path = wrap ("^i(" ++ path ++ ".dzen/icons/") ".xpm)" |
||
xmonicon = io $ return . Just $ |
xmonicon = io $ return . Just $ |
||
kernedsp ++ "^p(;4)" ++ xpm hm "xmonad16" ++ "^p(;-4)" ++ kernedsp |
kernedsp ++ "^p(;4)" ++ xpm hm "xmonad16" ++ "^p(;-4)" ++ kernedsp |
||
+ | stripDzen :: String -> String -- strip dzen formatting to undo ppHidden |
||
− | -- for layouts and titles use something like ppOrder = \(ws:l:t:xs) -> [l,ws,t] ++ xs |
||
+ | stripDzen s = strip s [] |
||
+ | where strip [] acc = acc |
||
+ | strip x acc = let good = fst (span ('^' /=) x) |
||
+ | bad = snd (span ('^' /=) x) |
||
+ | in strip (drop 1 . dropWhile (')' /=) $ bad) (acc ++ good) |
||
</haskell> |
</haskell> |
Revision as of 09:38, 29 January 2009
------ sereven.0.8.base.xmonad.hs ----------------
import XMonad
import qualified XMonad.StackSet as W
import System.Environment (getEnvironment)
import XMonad.Actions.DynamicWorkspaces
import XMonad.Actions.WindowNavigation
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers(doCenterFloat,composeOne,isFullscreen,doFullFloat,(-?>))
import XMonad.Hooks.UrgencyHook
import XMonad.Layout.IM -- (m%n) can be (m/n) don't need Data.Ratio
import XMonad.Layout.LayoutScreens
import XMonad.Layout.NoBorders
import XMonad.Layout.PerWorkspace
import XMonad.Layout.Reflect
import XMonad.Layout.ResizableTile
import XMonad.Layout.ToggleLayouts as TL
import XMonad.Layout.TwoPane
import XMonad.Layout.WindowNavigation
import XMonad.Prompt
import XMonad.Prompt.Shell
import XMonad.Prompt.RunOrRaise
import XMonad.Util.EZConfig
import XMonad.Util.Run
import XMonad.Util.Scratchpad
import XMonad.Util.WorkspaceCompare (getSortByTag,getSortByIndex)
modKey = mod4Mask
sWorkspaces = [ [x] | x <- ['A'..'I'] ] -- /3 MINIMUM/ (easy to mod num wss)
ws2 = head . drop 1 $ sWorkspaces
ws3 = head . drop 2 $ sWorkspaces
main = do
dz <- spawnPipe $ dzenWith darkXPC
home <- fmap (maybe "/home/svv/" (++"/") . lookup "HOME") getEnvironment
conf <- withWindowNavigation (xK_k, xK_h, xK_j, xK_l) $
withUrgencyHook NoUrgencyHook (
defaultConfig
{ modMask = modKey
, focusFollowsMouse = True
, terminal = "urxvtc"
, focusedBorderColor = "#694"
, normalBorderColor = "black"
, borderWidth = 1
, workspaces = sWorkspaces
, layoutHook = sLayouts
, logHook = dynamicLogWithPP $ dzdarkPP home dz
, manageHook = sManageHook
} `additionalKeys` sKeys)
`additionalKeysP` sKeysP -- silly to use both, but.. meh..
xmonad conf
sKeys = -- need normal bindings for testing ScreenWorkspaces
[ ((modKey .|. controlMask, xK_space), sendMessage TL.ToggleLayout )
, ((modKey,xK_b) , sendMessage ToggleStruts)
, ((shiftMask,xK_F1), shellPrompt darkXPC)
, ((shiftMask,xK_F2), runOrRaisePrompt darkXPC)
, ((shiftMask,xK_F3), scratchpadSpawnActionTerminal "urxvt -pe tabbed")
-- for more screens, workspaces, or exploring ion style subframes
, ((modKey, xK_backslash), selectWorkspace darkXPC)
, ((modKey .|. shiftMask ,xK_BackSpace), removeWorkspace)
, ((modKey , xK_F8), rescreen)
, ((modKey .|. shiftMask, xK_F8), layoutScreens 4 (Tall 2 (1/8) (1/2)))
]
sKeysP = -- TODO convert to additionalKeys
[ ("M-C-k", sendMessage MirrorExpand)
, ("M-C-j", sendMessage MirrorShrink)
, ("M-C-h", sendMessage Shrink)
, ("M-C-l", sendMessage Expand)
]
++ -- workspace and screen keys ------------------------------------
-- mod-<key> and mod-shift-<key> are as default
-- mod-ctrl-<key> shifts focused window *and* view to <key>'s ws
[ (addtlmods ++ "M-" ++ [key], action tag)
| (tag, key) <- zip sWorkspaces "1234567890_="
, (addtlmods, action) <- [ ("", windows . W.greedyView) -- or W.view)
, ("S-", windows . W.shift)
, ("C-", \x -> (windows . W.shift) x >> (windows . W.view) x)]
]
sManageHook = floatFullscreen <+> composeAll
[ scratchpadManageHookDefault
, className =? "Gimp" --> doShift ws3 -- don't float
, className =? "MPlayer" --> doShift ws2
, title =? "shellfm" --> doShift ws2
, title =? "" --> doFloat -- SOE graphics
, title =? "shellfm" --> doFloat
, className =? "MPlayer" --> doFloat
, className =? "Hback" --> doCenterFloat
, className =? "XFontSel" --> doCenterFloat
, className =? "Xmessage" --> doCenterFloat
]
where floatFullscreen = composeOne [isFullscreen -?> doFullFloat]
sLayouts =
smartBorders . avoidStruts $
TL.toggleLayouts (noBorders Full) $
modWorkspace ws3 reflectHoriz $ withIM (11/64) (Role "gimp-toolbox") $
onWorkspace ws2 (TwoPane (1/118) (11/15)) $
ResizableTall 2 -- default number of masters
(1/118) -- resize increment
(11/20) -- horizontal ratio
[5/4 -- master column ~ top/bottom
,5/4 -- no effect w/ 2 masters
,5/4 -- slave column ~ top/bottom
] -- then defaults to (repeat 1)
-- (theming, font, colors) ------------------
darkXPC :: XPConfig
darkXPC = defaultXPConfig
{ font = "-*-dejavu sans mono-medium-r-*-*-17-*-*-*-*-*-*-*"
, height = 28
, bgColor = "black"
, fgColor = "#684"
, bgHLight = "#785"
, fgHLight = "black"
, promptBorderWidth = 0
}
-- (dzen) ----------------------------------
dzenWith :: XPConfig -> String
dzenWith xpc = -- use XPConfig theming
"dzen2 -xs 1 -ta l -h " ++ (show $ height xpc)
++ " -fn '" ++ font xpc ++ "'"
++ " -bg '" ++ bgColor xpc ++ "'"
++ " -fg '" ++ fgColor xpc ++ "'"
++ " -e 'onstart=lower'"
dzdarkPP hm dzIn = defaultPP
{ ppOutput = hPutStrLn dzIn
, ppCurrent = wrap (dzfg hlightCol "^p(;+7)^r(5x5)^p(+2;-7)") "" . dzfg currentCol
, ppVisible = dzfg visibleCol . ("^p(;+7)^ro(5x5)^p(+2;-7)" ++)
, ppHidden = dzfg hiddenCol
, ppHiddenNoWindows = dzfg fadedCol
, ppUrgent = dzfg urgentCol . (\s -> stripDzen s)
, ppWsSep = kernedsp
, ppSep = ""
, ppSort = fmap (.scratchpadFilterOutWorkspace) getSortByIndex
, ppExtras = [xmonicon]
, ppOrder = \(ws:_:_:xs) -> [" "] ++ [ws] ++ xs
} -- for layouts and titles use something like ppOrder = \(ws:l:t:xs) -> [l,ws,t] ++ xs
where dzfg c = dzenColor c ""
hlightCol = "#4d5"
currentCol = "#bca"
visibleCol = "#ab9"
hiddenCol = "#786"
fadedCol = "#554"
urgentCol = "#d54"
kernedsp = "^p(+12)"
xpm path = wrap ("^i(" ++ path ++ ".dzen/icons/") ".xpm)"
xmonicon = io $ return . Just $
kernedsp ++ "^p(;4)" ++ xpm hm "xmonad16" ++ "^p(;-4)" ++ kernedsp
stripDzen :: String -> String -- strip dzen formatting to undo ppHidden
stripDzen s = strip s []
where strip [] acc = acc
strip x acc = let good = fst (span ('^' /=) x)
bad = snd (span ('^' /=) x)
in strip (drop 1 . dropWhile (')' /=) $ bad) (acc ++ good)