120 lines
2.9 KiB
Haskell
120 lines
2.9 KiB
Haskell
module Xmobar (mkBars) where
|
|
|
|
import XMonad.Layout.IndependentScreens (marshallPP)
|
|
|
|
import GHC.IO.Handle.Types (Handle)
|
|
import Text.Printf (printf)
|
|
|
|
import Data.List (intercalate, isPrefixOf)
|
|
import Graphics.X11.Types (Window)
|
|
|
|
import XMonad.Core
|
|
( Layout
|
|
, ScreenDetail
|
|
, ScreenId (S)
|
|
, withWindowSet
|
|
, WorkspaceId
|
|
, WindowSet
|
|
, description
|
|
, X
|
|
)
|
|
|
|
import XMonad (MonadIO)
|
|
import XMonad.Config (def)
|
|
import XMonad.Util.Run (hPutStrLn, spawnPipe)
|
|
import XMonad.Util.NamedWindows (getName)
|
|
import XMonad.Util.Loggers (Logger)
|
|
|
|
import XMonad.StackSet ( Workspace (..) , screen , workspace , current )
|
|
import qualified XMonad.StackSet as S
|
|
|
|
import XMonad.Hooks.DynamicLog
|
|
( PP
|
|
, ppCurrent
|
|
, ppExtras
|
|
, ppHidden
|
|
, ppHiddenNoWindows
|
|
, ppLayout
|
|
, ppOrder
|
|
, ppOutput
|
|
, ppSep
|
|
, ppTitle
|
|
, ppUrgent
|
|
, ppVisible
|
|
, shorten
|
|
, wrap
|
|
, xmobarAction
|
|
, xmobarColor
|
|
, dynamicLogWithPP
|
|
)
|
|
|
|
import HostConfig
|
|
( colorConfig
|
|
, fontConfig
|
|
, FontConfig
|
|
, fontName
|
|
, fontSize
|
|
|
|
, ColorConfig
|
|
, bgColor
|
|
, fgColor
|
|
, selFgColor
|
|
, selColor
|
|
, inactiveColor
|
|
, urgentColor
|
|
)
|
|
|
|
mkBars :: MonadIO m => [Int] -> m (X ())
|
|
mkBars screens = do
|
|
xmprocs <- mkXmprocs screens
|
|
return $ mapM_ dynamicLogWithPP $ zipWith mkPP xmprocs screens
|
|
|
|
mkXmprocs :: MonadIO m => [Int] -> m [Handle]
|
|
mkXmprocs = mapM (spawnPipe . printf "xmobar --screen='%d'")
|
|
|
|
mkPP :: Handle -> Int -> PP
|
|
mkPP bar nscreen = marshallPP (S nscreen) $ def
|
|
{ ppOutput = hPutStrLn bar
|
|
, ppCurrent = xmobarColor (selFgColor colorConfig) (selColor colorConfig)
|
|
, ppVisible = xmobarColor (fgColor colorConfig) ""
|
|
, ppHidden = xmobarColor (fgColor colorConfig) ""
|
|
, ppHiddenNoWindows = const ""
|
|
, ppUrgent = xmobarColor (urgentColor colorConfig) ""
|
|
, ppLayout = getLayoutIcon . layoutNameCleaner
|
|
, ppTitle = xmobarColor (selFgColor colorConfig) "" . shorten 100
|
|
, ppSep = xmobarColor (inactiveColor colorConfig) "" " | "
|
|
}
|
|
|
|
layoutNameCleaner = unwords . filter (not . (`elem` toClean)) . words
|
|
where
|
|
toClean =
|
|
[ "Simple"
|
|
, "Simplest"
|
|
, "Minimize"
|
|
, "Maximize"
|
|
, "ImageButtonDeco"
|
|
, "DefaultDecoration"
|
|
, "Spacing"
|
|
, "ReflectX"
|
|
, "ReflectY"
|
|
, "Tabbed"
|
|
, "0"
|
|
]
|
|
|
|
getLayoutIcon :: String -> String
|
|
getLayoutIcon "empty" = ""
|
|
getLayoutIcon x
|
|
| x `elem` icons = printf "<icon=%s/%s.xpm/>" iconsDir x
|
|
| otherwise = x
|
|
where
|
|
iconsDir = "/home/rilla/.xmonad/icons"
|
|
icons =
|
|
[ "3cols"
|
|
, "float"
|
|
, "full"
|
|
, "grid"
|
|
, "mtall"
|
|
, "tabs"
|
|
, "tall"
|
|
]
|