From e061a20dfcde3393791d4cecf6ab163cc88a0538 Mon Sep 17 00:00:00 2001
From: Andrea Rossato <andrea.rossato@unibz.it>
Date: Mon, 25 Jun 2007 15:57:22 +0200
Subject: Decoration.hs: added automatic font managment

newDecoration now takes also a fontname to set fonts in decorations that use them.
If an empty string is send the the default Xorg fonts will be loaded.

darcs-hash:20070625135722-32816-821258ce2bdafd1b61642caf7227ff52fe376742.gz
---
 Decoration.hs | 24 +++++++++++++++---------
 1 file changed, 15 insertions(+), 9 deletions(-)

(limited to 'Decoration.hs')

diff --git a/Decoration.hs b/Decoration.hs
index 6a9d606..6b63475 100644
--- a/Decoration.hs
+++ b/Decoration.hs
@@ -33,9 +33,9 @@ import Operations ( UnDoLayout(UnDoLayout) )
 -- You can use this module for writing other extensions.
 -- See, for instance, "XMonadContrib.Tabbed"
 
-newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel
-              -> (Display -> Window -> GC -> X ()) -> X () -> X Window
-newDecoration decfor (Rectangle x y w h) th fg bg draw click = do
+newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel -> String
+              -> (Display -> Window -> GC -> FontStruct -> X ()) -> X () -> X Window
+newDecoration decfor (Rectangle x y w h) th fg bg fn draw click = do
     d <- asks display
     rt <- asks theRoot
     win <- io $ createSimpleWindow d rt x y w h (fromIntegral th) fg bg
@@ -52,8 +52,8 @@ newDecoration decfor (Rectangle x y w h) th fg bg draw click = do
         handle_event (ButtonEvent {ev_window = thisw,ev_event_type = t})
             | t == buttonPress && thisw == win        = click
         handle_event (AnyEvent {ev_window = thisw, ev_event_type = t})
-            | thisw == win    && t == expose          = withGC win draw
-            | thisw == decfor && t == propertyNotify  = withGC win draw
+            | thisw == win    && t == expose          = withGC win fn draw
+            | thisw == decfor && t == propertyNotify  = withGC win fn draw
         handle_event _ = return ()
 
     addLayoutMessageHook hook
@@ -61,7 +61,13 @@ newDecoration decfor (Rectangle x y w h) th fg bg draw click = do
     return win
 
 -- FIXME: withGC should use bracket (but can't, unless draw is an IO thing)
-withGC :: Drawable -> (Display -> Drawable -> GC -> X ()) -> X ()
-withGC w f = withDisplay $ \d -> do gc <- io $ createGC d w
-                                    f d w gc
-                                    io $ freeGC d gc
+withGC :: Drawable -> String -> (Display -> Drawable -> GC -> FontStruct -> X ()) -> X ()
+withGC w fn f = withDisplay $ \d -> do gc <- io $ createGC d w
+                                       let fontname = if fn == "" 
+                                                      then "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
+                                                      else fn
+                                       font <- io $ loadQueryFont d fontname
+                                       io $ setFont d gc (fontFromFontStruct font)
+                                       f d w gc font
+                                       io $ freeGC d gc
+                                       io $ freeFont d font
-- 
cgit v1.2.3