add utf8 support to the core system

darcs-hash:20080216080151-d6583-367d1e30dba8744259e35db87d3edae8dcc27950.gz

1 files changed, 23 insertions, 22 deletions

diff --git a/Xmobar.hs b/Xmobar.hs
index 4ee8772..16cc85e 100644
--- a/Xmobar.hs
+++ b/Xmobar.hs
@@ -4,12 +4,12 @@
 -- Module      :  Xmobar
 -- Copyright   :  (c) Andrea Rossato
 -- License     :  BSD-style (see LICENSE)
--- 
+--
 -- Maintainer  :  Andrea Rossato <andrea.rossato@unibz.it>
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- A status bar for the Xmonad Window Manager 
+-- A status bar for the Xmonad Window Manager
 --
 -----------------------------------------------------------------------------
 
@@ -44,6 +44,7 @@ import Control.Concurrent
 import Control.Concurrent.STM
 import Control.Exception hiding (handle)
 import Data.Bits
+import Data.Char
 import System.Posix.Types (Fd(..))
 
 import Config
@@ -63,7 +64,7 @@ data XConf =
     XConf { display :: Display
           , rect    :: Rectangle
           , window  :: Window
-          , fontS   :: FontStruct
+          , fontS   :: FontSet
           , config  :: Config
           }
 
@@ -75,9 +76,9 @@ runX xc f = runReaderT f xc
 eventLoop :: XConf -> [(Maybe ThreadId, TVar String)] -> IO ()
 eventLoop xc@(XConf d _ w fs c) v = block $ do
     tv <- atomically $ newTVar []
-    t <- myThreadId
+    t  <- myThreadId
     ct <- forkIO (checker t tv "" `catch` \_ -> return ())
-    go tv ct   
+    go tv ct
  where
     -- interrupt the drawing thread every time a var is updated
     checker t tvar ov = do
@@ -127,13 +128,13 @@ startCommand (com,s,ss)
 -- $window
 
 -- | The function to create the initial window
-createWin :: Display -> FontStruct -> Config -> IO (Rectangle,Window)
+createWin :: Display -> FontSet -> Config -> IO (Rectangle,Window)
 createWin d fs c = do
   let dflt = defaultScreen d
   r:_   <- getScreenInfo d
   rootw <- rootWindow d dflt
-  let (_,as,ds,_) = textExtents fs []
-      ht          = as + ds + 2
+  let (_,rl)      = wcTextExtents fs "Tg"
+      ht          = rect_height rl + 2
       (x,y,w,h,o) = setPosition (position c) r (fi ht)
   win <- mkUnmanagedWindow d (defaultScreenOfDisplay d) rootw x y w h o
   selectInput       d win (exposureMask .|. structureNotifyMask)
@@ -145,7 +146,7 @@ setPosition :: XPosition -> Rectangle -> Dimension -> (Position,Position,Dimensi
 setPosition p (Rectangle rx ry rw rh) ht =
     case p of
     Top                -> (rx      , ry    , rw   , h    , True)
-    TopW L i           -> (rx      , ry    , nw i , h    , True) 
+    TopW L i           -> (rx      , ry    , nw i , h    , True)
     TopW R i           -> (right  i, ry    , nw i , h    , True)
     TopW C i           -> (center i, ry    , nw i , h    , True)
     Bottom             -> (rx      , ny    , rw   , h    , True)
@@ -185,8 +186,8 @@ 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 
+      [lc,rc]    = if length (alignSep conf) == 2
+                   then alignSep conf
                    else alignSep defaultConfig
   i <- io $ atomically $ readTVar v
   let def     = [i,[],[]]
@@ -209,7 +210,7 @@ drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do
   bgcolor <- io $ initColor d $ bgColor c
   gc      <- io $ createGC  d w
   --let's get the fonts
-  io $ setFont d gc (fontFromFontStruct fs)
+--  io $ setFont d gc (fontFromFontStruct fs)
   -- create a pixmap to write to and fill it with a rectangle
   p <- io $ createPixmap d w wid ht
             (defaultDepthOfScreen (defaultScreenOfDisplay d))
@@ -217,7 +218,7 @@ drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do
   io $ setForeground d gc bgcolor
   io $ fillRectangle d p gc 0 0 wid ht
   -- write to the pixmap the new string
-  let strWithLenth = map (\(s,cl) -> (s,cl,textWidth fs s))
+  let strWithLenth = map (\(s,cl) -> (s,cl,wcTextEscapement fs s))
   printStrings p gc fs 1 L $ strWithLenth left
   printStrings p gc fs 1 R $ strWithLenth right
   printStrings p gc fs 1 C $ strWithLenth center
@@ -230,16 +231,16 @@ drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do
   io $ sync       d True
 
 -- | An easy way to print the stuff we need to print
-printStrings :: Drawable -> GC -> FontStruct -> Position
+printStrings :: Drawable -> GC -> FontSet -> Position
              -> Align -> [(String, String, Position)] -> X ()
 printStrings _ _ _ _ _ [] = return ()
 printStrings dr gc fontst offs a sl@((s,c,l):xs) = do
   r <- ask
   let (conf,d)             = (config &&& display) r
       Rectangle _ _ wid ht = rect r
-      (_,as,ds,_)          = textExtents fontst s
+      (_,rl) = wcTextExtents fontst s
       totSLen              = foldr (\(_,_,len) -> (+) len) 0 sl
-      valign               = (fi ht + fi as - fi ds) `div` 2
+      valign               = (fi ht + fi (rect_height rl)) `div` 2
       remWidth             = fi wid - fi totSLen
       offset               = case a of
                                C -> (remWidth + offs) `div` 2
@@ -249,14 +250,14 @@ printStrings dr gc fontst offs a sl@((s,c,l):xs) = do
                (f,',':b) -> do
                  fgc <- io $ initColor d f
                  bgc <- io $ initColor d b
-                 return (fgc,bgc) 
+                 return (fgc,bgc)
                (f,_) -> do
                  fgc <- io $ initColor d f
                  bgc <- io $ initColor d (bgColor conf)
-                 return (fgc,bgc) 
+                 return (fgc,bgc)
   io $ setForeground d gc fc
   io $ setBackground d gc bc
-  io $ drawImageString d dr gc offset valign s
+  io $ wcDrawImageString d dr fontst gc offset valign s
   printStrings dr gc fontst (offs + l) a xs
 
 {- $unmanwin
@@ -279,11 +280,11 @@ mkUnmanagedWindow :: Display
 mkUnmanagedWindow dpy scr rw x y w h o = do
   let visual   = defaultVisualOfScreen scr
       attrmask = cWOverrideRedirect
-  allocaSetWindowAttributes $ 
+  allocaSetWindowAttributes $
          \attributes -> do
            set_override_redirect attributes o
-           createWindow dpy rw x y w h 0 (defaultDepthOfScreen scr) 
-                        inputOutput visual attrmask attributes                                
+           createWindow dpy rw x y w h 0 (defaultDepthOfScreen scr)
+                        inputOutput visual attrmask attributes
 
 {- $utility
 Utilities