diff options
| -rw-r--r-- | news.md | 1 | ||||
| -rw-r--r-- | readme.md | 5 | ||||
| -rw-r--r-- | src/Config.hs | 56 | ||||
| -rw-r--r-- | src/Parsers.hs | 71 | ||||
| -rw-r--r-- | src/Window.hs | 49 |
5 files changed, 103 insertions, 79 deletions
@@ -10,6 +10,7 @@ _New features_ - New `TopP` and `BottomP` alignments, taking left and right paddings (thanks to Dmitry Malikov). - New `<freeratio>` field for memory monitor (Peter Simons). + - New `allDesktops` configuration option. ## Version 0.16 (Dec 3, 2012) @@ -247,6 +247,11 @@ Other configuration options: can be toggled manually (for example using the dbus interface) or automatically (by a plugin) to make it reappear. +`allDesktops` +: When set to True (the default is False), xmobar will tell the + window manager explicitily to be shown in all desktops, by + setting `_NET_WM_DESKTOP` to 0xffffffff. + `persistent` : When True the window status is fixed i.e. hiding or revealing is not possible. This option can be toggled at runtime. diff --git a/src/Config.hs b/src/Config.hs index 6ab3f8d..3eda6c3 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -51,24 +51,29 @@ import Plugins.DateZone -- | The configuration data type data Config = - Config { font :: String -- ^ Font - , bgColor :: String -- ^ Backgroud color - , fgColor :: String -- ^ Default font color - , position :: XPosition -- ^ Top Bottom or Static - , border :: Border -- ^ NoBorder TopB BottomB or FullB - , borderColor :: String -- ^ Border color - , hideOnStart :: Bool -- ^ Hide (Unmap) the window on - -- initialization - , lowerOnStart :: Bool -- ^ Lower to the bottom of the - -- window stack on initialization - , persistent :: Bool -- ^ Whether automatic hiding should - -- be enabled or disabled - , commands :: [Runnable] -- ^ For setting the command, the command arguments - -- and refresh rate for the programs to run (optional) - , sepChar :: String -- ^ The character to be used for indicating - -- commands in the output template (default '%') - , alignSep :: String -- ^ Separators for left, center and right text alignment - , template :: String -- ^ The output template + Config { font :: String -- ^ Font + , bgColor :: String -- ^ Backgroud color + , fgColor :: String -- ^ Default font color + , position :: XPosition -- ^ Top Bottom or Static + , border :: Border -- ^ NoBorder TopB BottomB or FullB + , borderColor :: String -- ^ Border color + , hideOnStart :: Bool -- ^ Hide (Unmap) the window on + -- initialization + , allDesktops :: Bool -- ^ Tell the WM to map to all desktops + , lowerOnStart :: Bool -- ^ lower to the bottom of the + -- window stack on initialization + , persistent :: Bool -- ^ Whether automatic hiding should + -- be enabled or disabled + , commands :: [Runnable] -- ^ For setting the command, + -- the command arguments + -- and refresh rate for the programs + -- to run (optional) + , sepChar :: String -- ^ The character to be used for indicating + -- commands in the output template + -- (default '%') + , alignSep :: String -- ^ Separators for left, center and + -- right text alignment + , template :: String -- ^ The output template } deriving (Read) data XPosition = Top @@ -97,18 +102,19 @@ data Border = NoBorder -- | The default configuration values defaultConfig :: Config defaultConfig = - Config { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - , bgColor = "#000000" - , fgColor = "#BFBFBF" + Config { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + , bgColor = "#000000" + , fgColor = "#BFBFBF" , position = Top , border = NoBorder - , borderColor = "#BFBFBF" - , hideOnStart = False + , borderColor = "#BFBFBF" + , hideOnStart = False , lowerOnStart = True - , persistent = False + , persistent = False + , allDesktops = False , commands = [ Run $ Date "%a %b %_d %Y * %H:%M:%S" "theDate" 10 , Run StdinReader] - , sepChar = "%" + , sepChar = "%" , alignSep = "}{" , template = "%StdinReader% }{ <fc=#00FF00>%uname%</fc> * <fc=#FF0000>%theDate%</fc>" } diff --git a/src/Parsers.hs b/src/Parsers.hs index 9faacb9..efff506 100644 --- a/src/Parsers.hs +++ b/src/Parsers.hs @@ -48,12 +48,13 @@ stringParser c a = manyTill (textParser c a <|> try (iconParser c a) <|> -- | Parses a maximal string without color markup. textParser :: String -> Maybe Action -> Parser [(Widget, ColorString, Maybe Action)] textParser c a = do s <- many1 $ - noneOf "<" <|> - (try $ notFollowedBy' (char '<') - (try (string "fc=") <|> - try (string "action=") <|> - try (string "/action>") <|> - try (string "icon=") <|> string "/fc>")) + noneOf "<" <|> + try (notFollowedBy' (char '<') + (try (string "fc=") <|> + try (string "action=") <|> + try (string "/action>") <|> + try (string "icon=") <|> + string "/fc>")) return [(Text s, c, a)] @@ -78,7 +79,7 @@ actionParser c = do s <- manyTill (try (textParser c a') <|> try (iconParser c a') <|> try (colorParser a') <|> actionParser c) (try $ string "</action>") return (concat s) - + -- | Parsers a string wrapped in a color specification. colorParser :: Maybe Action -> Parser [(Widget, ColorString, Maybe Action)] colorParser a = do @@ -154,33 +155,33 @@ parseConfig = runParser parseConf fields "Config" . stripComments return (x,s) perms = permute $ Config - <$?> pFont <|?> pBgColor - <|?> pFgColor <|?> pPosition - <|?> pBorder <|?> pBdColor - <|?> pHideOnStart <|?> pLowerOnStart - <|?> pPersistent <|?> pCommands - <|?> pSepChar <|?> pAlignSep - <|?> pTemplate + <$?> pFont <|?> pBgColor <|?> pFgColor <|?> pPosition + <|?> pBorder <|?> pBdColor <|?> pHideOnStart <|?> pAllDesktops + <|?> pLowerOnStart <|?> pPersistent <|?> pCommands + <|?> pSepChar <|?> pAlignSep <|?> pTemplate fields = [ "font", "bgColor", "fgColor", "sepChar", "alignSep" , "border", "borderColor" ,"template", "position" - , "hideOnStart", "lowerOnStart", "persistent", "commands" + , "allDesktops", "hideOnStart", "lowerOnStart" + , "persistent", "commands" ] - pFont = strField font "font" - pBgColor = strField bgColor "bgColor" - pFgColor = strField fgColor "fgColor" - pBdColor = strField borderColor "borderColor" - pSepChar = strField sepChar "sepChar" + pFont = strField font "font" + pBgColor = strField bgColor "bgColor" + pFgColor = strField fgColor "fgColor" + pBdColor = strField borderColor "borderColor" + pSepChar = strField sepChar "sepChar" pAlignSep = strField alignSep "alignSep" pTemplate = strField template "template" - pPosition = field position "position" $ tillFieldEnd >>= read' "position" - pHideOnStart = field hideOnStart "hideOnStart" $ tillFieldEnd >>= read' "hideOnStart" - pLowerOnStart = field lowerOnStart "lowerOnStart" $ tillFieldEnd >>= read' "lowerOnStart" - pPersistent = field persistent "persistent" $ tillFieldEnd >>= read' "persistent" - pBorder = field border "border" $ tillFieldEnd >>= read' "border" - pCommands = field commands "commands" $ readCommands + pPosition = readField position "position" + pHideOnStart = readField hideOnStart "hideOnStart" + pLowerOnStart = readField lowerOnStart "lowerOnStart" + pPersistent = readField persistent "persistent" + pBorder = readField border "border" + pAllDesktops = readField allDesktops "allDesktops" + + pCommands = field commands "commands" readCommands staticPos = do string "Static" wrapSkip (string "{") @@ -191,12 +192,17 @@ parseConfig = runParser parseConf fields "Config" . stripComments tillFieldEnd = staticPos <|> many (noneOf ",}\n\r") commandsEnd = wrapSkip (string "]") >> (string "}" <|> notNextRun) - notNextRun = do { string ","; notFollowedBy $ wrapSkip $ string "Run"; return ","} + notNextRun = do {string "," + ; notFollowedBy $ wrapSkip $ string "Run" + ; return "," + } readCommands = manyTill anyChar (try commandsEnd) >>= read' commandsErr . flip (++) "]" - strField e n = field e n . between (strDel "start" n) (strDel "end" n) . many $ noneOf "\"\n\r" - strDel t n = char '"' <?> strErr t n - strErr t n = "the " ++ t ++ " of the string field " ++ n ++ " - a double quote (\")." + strField e n = field e n . between (strDel "start" n) (strDel "end" n) . + many $ noneOf "\"\n\r" + strDel t n = char '"' <?> strErr t n + strErr t n = "the " ++ t ++ " of the string field " ++ n ++ + " - a double quote (\")." wrapSkip x = many space >> x >>= \r -> many space >> return r sepEndSpc = mapM_ (wrapSkip . try . string) @@ -204,12 +210,11 @@ parseConfig = runParser parseConf fields "Config" . stripComments field e n c = (,) (e defaultConfig) $ updateState (filter (/= n)) >> sepEndSpc [n,"="] >> wrapSkip c >>= \r -> fieldEnd >> return r - + readField a n = field a n $ tillFieldEnd >>= read' n read' d s = case reads s of [(x, _)] -> return x - _ -> fail $ "error reading the " ++ d ++ " field: " ++ s + _ -> fail $ "error reading the " ++ d ++ " field: " ++ s commandsErr :: String commandsErr = "commands: this usually means that a command could not be parsed.\n" ++ "The error could be located at the begining of the command which follows the offending one." - diff --git a/src/Window.hs b/src/Window.hs index ec50883..aff2c95 100644 --- a/src/Window.hs +++ b/src/Window.hs @@ -16,7 +16,7 @@ module Window where import Prelude -import Control.Monad (when) +import Control.Monad (when, unless) import Graphics.X11.Xlib hiding (textExtents, textWidth) import Graphics.X11.Xlib.Extras import Graphics.X11.Xinerama @@ -40,7 +40,7 @@ createWin d fs c = do (r,o) = setPosition (position c) srs (fi ht) win <- newWindow d (defaultScreenOfDisplay d) rootw r o when (lowerOnStart c) (lowerWindow d win) - when (not $ hideOnStart c) $ showWindow r c d win + unless (hideOnStart c) $ showWindow r c d win setProperties r c d win srs return (r,win) @@ -88,25 +88,32 @@ setPosition p rs ht = setProperties :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO () -setProperties r c d w srs = do - a1 <- internAtom d "_NET_WM_STRUT_PARTIAL" False - c1 <- internAtom d "CARDINAL" False - a2 <- internAtom d "_NET_WM_WINDOW_TYPE" False - c2 <- internAtom d "ATOM" False - v <- internAtom d "_NET_WM_WINDOW_TYPE_DOCK" False - p <- internAtom d "_NET_WM_PID" False +setProperties r c d w rs = do + pstrut <- internAtom d "_NET_WM_STRUT_PARTIAL" False + strut <- internAtom d "_NET_WM_STRUT" False + card <- internAtom d "CARDINAL" False + wtype <- internAtom d "_NET_WM_WINDOW_TYPE" False + atom <- internAtom d "ATOM" False + dock <- internAtom d "_NET_WM_WINDOW_TYPE_DOCK" False + pid <- internAtom d "_NET_WM_PID" False setTextProperty d w "xmobar" wM_CLASS setTextProperty d w "xmobar" wM_NAME ismapped <- isMapped d w - changeProperty32 d w a1 c1 propModeReplace $ - if ismapped - then map fi $ getStrutValues r (position c) (getRootWindowHeight srs) - else replicate 12 0 - changeProperty32 d w a2 c2 propModeReplace [fromIntegral v] - - getProcessID >>= changeProperty32 d w p c1 propModeReplace . return . fromIntegral + let svs = if ismapped + then map fi $ getStrutValues r + (position c) + (getRootWindowHeight rs) + else replicate 12 0 + changeProperty32 d w pstrut card propModeReplace svs + changeProperty32 d w strut card propModeReplace (take 4 svs) + changeProperty32 d w wtype atom propModeReplace [fi dock] + when (allDesktops c) $ do + desktop <- internAtom d "_NET_WM_DESKTOP" False + changeProperty32 d w desktop card propModeReplace [0xffffffff] + + getProcessID >>= changeProperty32 d w pid card propModeReplace . return . fi getRootWindowHeight :: [Rectangle] -> Int getRootWindowHeight srs = maximum (map getMaxScreenYCoord srs) @@ -115,7 +122,7 @@ getRootWindowHeight srs = maximum (map getMaxScreenYCoord srs) getStrutValues :: Rectangle -> XPosition -> Int -> [Int] getStrutValues r@(Rectangle x y w h) p rwh = - case p of + case p of OnScreen _ p' -> getStrutValues r p' rwh Top -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0] TopP _ _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0] @@ -126,10 +133,10 @@ getStrutValues r@(Rectangle x y w h) p rwh = BottomW _ _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw] BottomSize {} -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw] Static {} -> getStaticStrutValues p rwh - where st = fi y + fi h - sb = rwh - fi y - nx = fi x - nw = fi (x + fi w - 1) + where st = fi y + fi h + sb = rwh - fi y + nx = fi x + nw = fi (x + fi w - 1) -- get some reaonable strut values for static placement. getStaticStrutValues :: XPosition -> Int -> [Int] |