[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