[xmonad] xmobar, dual-head, and avoidStruts
lithis
xmonad at selg.hethrael.org
Mon Nov 3 12:29:02 EST 2008
On Sun, 2008/11/02 19:56:56 -0800, Andrew Sackville-West wrote:
> 2. a way to get a second xmobar instance to show on a different screen
> without using Static
Juraj Hercek wrote a patch to support xmobar on a second
screen a while ago. I can’t find the patch itself, but I’ve
attached an old version of Xmobar.hs with the patch applied.
Things have changed since then, but you might be able to get
it up to date.
However, I think the second instance would show the same
info as the first instance, at the same location. You would
have to tell the second xmobar to use a different config.
On Mon, 2008/11/03 08:29:00 -0800, Andrew Sackville-West wrote:
> So I call this a hack because I don't understand what all the
> coordinates mean in the case statement. I just mimicked the one for
> Top since that is where I put it anyway. I suspect there needs to be a
> little math done to a Static position so that it will work in any
> position. Can anybody provide insight into what those coordinates
> represent? Then I could possible put together a proper fix.
From
http://standards.freedesktop.org/wm-spec/1.3/ar01s05.html :
_NET_WM_STRUT_PARTIAL, left, right, top, bottom,
left_start_y, left_end_y, right_start_y, right_end_y,
top_start_x, top_end_x, bottom_start_x,
bottom_end_x,CARDINAL[12]/32
Top -> [ 0 -- 0 pixels wide on the left.
, 0 -- 0 pixels wide on the right.
, nh -- nh pixels tall on the top.
, 0 -- 0 pixels tall on the bottom.
, 0 -- Not on the left.
, 0 -- Not on the left.
, 0 -- Not on the right.
, 0 -- Not on the right.
, nx -- Its left side is at nx on the top.
, nw -- It is nw pixels wide on the top.
, 0 -- Not on the bottom.
, 0] -- Not on the bottom.
As you mentioned, your fix won’t work in all positions (such
as the bottom of the screen). The difficulty is how to
handle screens that aren’t aligned exactly at their tops and
bottoms. For example, screens of two different resolutions,
or one screen above another screen, or the second screen to
the right and at a vertical offset from the first screen.
I would argue that a partial solution that handles the most
common cases (yours is a start) would be better than
nothing. I also like Juraj’s patch.
-------------- next part --------------
{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module : Xmobar
-- Copyright : (c) Andrea Rossato
-- License : BSD-style (see LICENSE)
--
-- Maintainer : Andrea Rossato <andrea.rossato at unibz.it>
-- Stability : unstable
-- Portability : unportable
--
-- A status bar for the Xmonad Window Manager
--
-----------------------------------------------------------------------------
module Xmobar (-- * Main Stuff
-- $main
X, XConf (..), runX
, eventLoop
-- * Program Execution
-- $command
, startCommand
-- * Window Management
-- $window
, createWin, updateWin
-- * Printing
-- $print
, drawInWin, printStrings
) where
import Prelude hiding (catch)
import Graphics.X11.Xlib hiding (textExtents, textWidth)
import Graphics.X11.Xlib.Extras
import Graphics.X11.Xinerama
import Control.Arrow ((&&&))
import Control.Monad.Reader
import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception hiding (handle)
import Data.Bits
import Data.Char
import Config
import Parsers
import Commands
import Runnable
import XUtil
-- $main
--
-- The Xmobar data type and basic loops and functions.
-- | The X type is a ReaderT
type X = ReaderT XConf IO
-- | The ReaderT inner component
data XConf =
XConf { display :: Display
, rect :: Rectangle
, window :: Window
, fontS :: XFont
, config :: Config
}
-- | Runs the ReaderT
runX :: XConf -> X () -> IO ()
runX xc f = runReaderT f xc
-- | The event loop
eventLoop :: XConf -> [(Maybe ThreadId, TVar String)] -> IO ()
eventLoop xc@(XConf d _ w fs c) v = block $ do
tv <- atomically $ newTVar []
t <- myThreadId
ct <- forkIO (checker t tv "" `catch` \_ -> return ())
go tv ct
where
-- interrupt the drawing thread every time a var is updated
checker t tvar ov = do
nval <- atomically $ do
nv <- fmap concat $ mapM readTVar (map snd v)
guard (nv /= ov)
writeTVar tvar nv
return nv
throwDynTo t ()
checker t tvar nval
-- Continuously wait for a timer interrupt or an expose event
go tv ct = do
catchDyn (unblock $ allocaXEvent $ \e ->
handle tv ct =<< (nextEvent' d e >> getEvent e))
(\() -> runX xc (updateWin tv) >> return ())
go tv ct
-- event hanlder
handle _ ct (ConfigureEvent {ev_window = win}) = do
rootw <- rootWindow d (defaultScreen d)
when (win == rootw) $ block $ do
killThread ct
destroyWindow d w
(r',w') <- createWin d fs c
eventLoop (XConf d r' w' fs c) v
handle tvar _ (ExposeEvent {}) = runX xc (updateWin tvar)
handle _ _ _ = return ()
-- $command
-- | Runs a command as an independent thread and returns its thread id
-- and the TVar the command will be writing to.
startCommand :: (Runnable,String,String) -> IO (Maybe ThreadId, TVar String)
startCommand (com,s,ss)
| alias com == "" = do var <- atomically $ newTVar is
atomically $ writeTVar var "Could not parse the template"
return (Nothing,var)
| otherwise = do var <- atomically $ newTVar is
let cb str = atomically $ writeTVar var (s ++ str ++ ss)
h <- forkIO $ start com cb
return (Just h,var)
where is = s ++ "Updating..." ++ ss
-- $window
-- | The function to create the initial window
createWin :: Display -> XFont -> Config -> IO (Rectangle,Window)
createWin d fs c = do
let dflt = defaultScreen d
screens <- getScreenInfo d
rootw <- rootWindow d dflt
(as,ds) <- textExtents fs "0"
let ht = as + ds + 4
(r,o) = setPosition (position c) screens (fi ht)
win <- newWindow d (defaultScreenOfDisplay d) rootw r o
selectInput d win (exposureMask .|. structureNotifyMask)
setProperties r c d win
mapWindow d win
return (r,win)
setPosition :: XPosition -> [Rectangle] -> Dimension -> (Rectangle,Bool)
setPosition p rectangles ht =
case p of
OnScreen i pos -> setPosition pos [rectangles !! i] ht
Top -> (Rectangle rx ry rw h , True)
TopW L i -> (Rectangle rx ry (nw i) h , True)
TopW R i -> (Rectangle (right i) ry (nw i) h , True)
TopW C i -> (Rectangle (center i) ry (nw i) h , True)
Bottom -> (Rectangle rx ny rw h , True)
BottomW L i -> (Rectangle rx ny (nw i) h , True)
BottomW R i -> (Rectangle (right i) ny (nw i) h , True)
BottomW C i -> (Rectangle (center i) ny (nw i) h , True)
Static cx cy cw ch -> (Rectangle (fi cx ) (fi cy) (fi cw) (fi ch), True)
where
Rectangle rx ry rw rh = head rectangles
ny = ry + fi (rh - ht)
center i = rx + (fi $ div (remwid i) 2)
right i = rx + (fi $ remwid i)
remwid i = rw - pw (fi i)
pw i = rw * (min 100 i) `div` 100
nw = fi . pw . fi
h = fi ht
setProperties :: Rectangle -> Config -> Display -> Window -> IO ()
setProperties r c d w = 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
changeProperty32 d w a1 c1 propModeReplace $ map fi $ getStrutValues r (position c)
changeProperty32 d w a2 c2 propModeReplace [fromIntegral v]
getStrutValues :: Rectangle -> XPosition -> [Int]
getStrutValues r@(Rectangle x _ w h) p =
case p of
OnScreen _ np -> getStrutValues r np
Top -> [0, 0, nh, 0, 0, 0, 0, 0, nx, nw, 0, 0]
TopW _ _ -> [0, 0, nh, 0, 0, 0, 0, 0, nx, nw, 0, 0]
Bottom -> [0, 0, 0, nh, 0, 0, 0, 0, 0, 0, nx, nw]
BottomW _ _ -> [0, 0, 0, nh, 0, 0, 0, 0, 0, 0, nx, nw]
_ -> [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
where nh = fi h
nx = fi x
nw = fi (x + fi w - 1)
updateWin :: TVar String -> X ()
updateWin v = do
xc <- ask
let (conf,rec) = (config &&& rect) xc
[lc,rc] = if length (alignSep conf) == 2
then alignSep conf
else alignSep defaultConfig
i <- io $ atomically $ readTVar v
let def = [i,[],[]]
[l,c,r] = case break (==lc) i of
(le,_:re) -> case break (==rc) re of
(ce,_:ri) -> [le,ce,ri]
_ -> def
_ -> def
ps <- io $ mapM (parseString conf) [l,c,r]
drawInWin rec ps
-- $print
-- | Draws in and updates the window
drawInWin :: Rectangle -> [[(String, String)]] -> X ()
drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do
r <- ask
let (c,d ) = (config &&& display) r
(w,fs) = (window &&& fontS ) r
strLn = io . mapM (\(s,cl) -> textWidth d fs s >>= \tw -> return (s,cl,fi tw))
bgcolor <- io $ initColor d $ bgColor c
gc <- io $ createGC d w
-- create a pixmap to write to and fill it with a rectangle
p <- io $ createPixmap d w wid ht
(defaultDepthOfScreen (defaultScreenOfDisplay d))
-- the fgcolor of the rectangle will be the bgcolor of the window
io $ setForeground d gc bgcolor
io $ fillRectangle d p gc 0 0 wid ht
-- write to the pixmap the new string
printStrings p gc fs 1 L =<< strLn left
printStrings p gc fs 1 R =<< strLn right
printStrings p gc fs 1 C =<< strLn center
-- copy the pixmap with the new string to the window
io $ copyArea d p w gc 0 0 wid ht 0 0
-- free up everything (we do not want to leak memory!)
io $ freeGC d gc
io $ freePixmap d p
-- resync
io $ sync d True
-- | An easy way to print the stuff we need to print
printStrings :: Drawable -> GC -> XFont -> Position
-> Align -> [(String, String, Position)] -> X ()
printStrings _ _ _ _ _ [] = return ()
printStrings dr gc fontst offs a sl@((s,c,l):xs) = do
r <- ask
(as,ds) <- io $ textExtents fontst s
let (conf,d) = (config &&& display) r
Rectangle _ _ wid _ = rect r
totSLen = foldr (\(_,_,len) -> (+) len) 0 sl
valign = fi $ as + ds
remWidth = fi wid - fi totSLen
offset = case a of
C -> (remWidth + offs) `div` 2
R -> remWidth - 1
L -> offs
(fc,bc) = case (break (==',') c) of
(f,',':b) -> (f, b )
(f, _) -> (f, bgColor conf)
io $ printString d dr fontst gc fc bc offset valign s
printStrings dr gc fontst (offs + l) a xs
More information about the xmonad
mailing list