mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-06 23:11:54 -07:00
Tabbed.hs: fixed centerText issues and some binding shadowing warnings
This patch fixes the centerText issue due to the inappropriate use of textExtends and textWidth. Those functions need a FontStruct id to operate, and this cannot be retrieved with queryFont (see comments in Graphics.X11.Xlib.Font). So we now get the FontStruct with loadQueryFont, we set the default Xorg fonts and we calculate things for (vertical and horizontal) centering. It also removes some binding shadows compiler warnings
This commit is contained in:
32
Tabbed.hs
32
Tabbed.hs
@@ -44,32 +44,30 @@ tabbed = Layout { doLayout = dolay, modifyLayout = const (return Nothing) }
|
|||||||
|
|
||||||
dolay :: Rectangle -> W.Stack Window -> X [(Window, Rectangle)]
|
dolay :: Rectangle -> W.Stack Window -> X [(Window, Rectangle)]
|
||||||
dolay sc (W.Stack w [] []) = return [(w,sc)]
|
dolay sc (W.Stack w [] []) = return [(w,sc)]
|
||||||
dolay sc@(Rectangle x y wid _) s@(W.Stack w _ _) = withDisplay $ \d ->
|
dolay sc@(Rectangle x y wid _) s@(W.Stack w _ _) = withDisplay $ \dpy ->
|
||||||
do activecolor <- io $ initColor d "#BBBBBB"
|
do activecolor <- io $ initColor dpy "#BBBBBB"
|
||||||
inactivecolor <- io $ initColor d "#888888"
|
inactivecolor <- io $ initColor dpy "#888888"
|
||||||
textcolor <- io $ initColor d "#000000"
|
textcolor <- io $ initColor dpy "#000000"
|
||||||
bgcolor <- io $ initColor d "#000000"
|
bgcolor <- io $ initColor dpy "#000000"
|
||||||
let ws = W.integrate s
|
let ws = W.integrate s
|
||||||
ts = gentabs x y wid (length ws)
|
ts = gentabs x y wid (length ws)
|
||||||
tws = zip ts ws
|
tws = zip ts ws
|
||||||
maketab (t,w) = newDecoration w t 1 bgcolor activecolor (drawtab t w) (focus w)
|
maketab (t,ow) = newDecoration ow t 1 bgcolor activecolor (drawtab t ow) (focus ow)
|
||||||
drawtab r@(Rectangle _ _ wt ht) w d w' gc =
|
drawtab r@(Rectangle _ _ wt ht) ow d w' gc =
|
||||||
do nw <- getName w
|
do nw <- getName ow
|
||||||
tabcolor <- (maybe inactivecolor (\focusw -> if focusw == w then activecolor else inactivecolor) . W.peek) `liftM` gets windowset
|
tabcolor <- (maybe inactivecolor (\focusw -> if focusw == ow then activecolor else inactivecolor) . W.peek) `liftM` gets windowset
|
||||||
io $ setForeground d gc tabcolor
|
io $ setForeground d gc tabcolor
|
||||||
io $ fillRectangles d w' gc [Rectangle 0 0 wt ht]
|
io $ fillRectangles d w' gc [Rectangle 0 0 wt ht]
|
||||||
io $ setForeground d gc textcolor
|
io $ setForeground d gc textcolor
|
||||||
centerText d w' gc r (show nw)
|
centerText d w' gc r (show nw)
|
||||||
centerText d w' gc (Rectangle _ _ wt ht) name =
|
centerText d w' gc (Rectangle _ _ wt ht) name =
|
||||||
do font <- io (fontFromGC d gc >>= queryFont d)
|
do fontst <- io $ loadQueryFont d "-misc-fixed-*-*-*-*-*-*-*-*-*-*-*-*"
|
||||||
-- let (_,namew,nameh,_) = textExtents font name -- textExtents causes a crash!
|
io $ setFont d gc (fontFromFontStruct fontst)
|
||||||
-- let nameh = ht `div` 2
|
let (_,asc,_,_) = textExtents fontst name
|
||||||
-- namew = textWidth font name -- textWidth also causes a crash!
|
width = textWidth fontst name
|
||||||
let nameh = ht - 6
|
|
||||||
namew = wt - 10
|
|
||||||
io $ drawString d w' gc
|
io $ drawString d w' gc
|
||||||
(fromIntegral (wt `div` 2) - fromIntegral (namew `div` 2))
|
(fromIntegral (wt `div` 2) - fromIntegral (width `div` 2))
|
||||||
(fromIntegral (ht `div` 2) + fromIntegral (nameh `div` 2)) name
|
(fromIntegral ht - fromIntegral (asc `div` 2)) name
|
||||||
forM tws maketab
|
forM tws maketab
|
||||||
return [ (w,shrink sc) ]
|
return [ (w,shrink sc) ]
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user