From 5d8f8d2014fd164ca73ec2c43daa9276352dc63b Mon Sep 17 00:00:00 2001
From: Andrea Rossato <andrea.rossato@ing.unitn.it>
Date: Wed, 10 Feb 2010 13:29:27 +0100
Subject: fix ghc-6.12.1 warnings andd fix issue 17

Ignore-this: 868a877e7a107ddc8bc4085f3eb7fc8ae64597ee
ghc-6.12.1 has native support for locales (very cool indeed!!), which
simplify the code - unless for the compatibility layer with past ghc
versions. xmobar has now support for every locale supported by ghc.

The rest of the patch are just redundant import warnings and some
xmobar.cabal updates.

darcs-hash:20100210122927-d6583-e131c86cf89ce26adea9aa2ae06467bfdc40e14b.gz
---
 XUtil.hsc | 74 +++++++++++++++++++++++++++++++--------------------------------
 1 file changed, 36 insertions(+), 38 deletions(-)

(limited to 'XUtil.hsc')

diff --git a/XUtil.hsc b/XUtil.hsc
index 2a61283..afdc782 100644
--- a/XUtil.hsc
+++ b/XUtil.hsc
@@ -16,7 +16,6 @@ module XUtil
     , initFont
     , initCoreFont
     , initUtf8Font
-    , releaseFont
     , textExtents
     , textWidth
     , printString
@@ -32,19 +31,18 @@ module XUtil
     ) where
 
 import Control.Concurrent
-import Control.Monad
 import Control.Monad.Trans
 import Data.IORef
 import Foreign
 import Graphics.X11.Xlib hiding (textExtents, textWidth)
 import qualified Graphics.X11.Xlib as Xlib (textExtents, textWidth)
 import Graphics.X11.Xlib.Extras
+import System.Mem.Weak ( addFinalizer )
 import System.Posix.Types (Fd(..))
 import System.IO
-import System.IO.Unsafe (unsafePerformIO)
 #if defined XFT || defined UTF8
-import Foreign.C
 # if __GLASGOW_HASKELL__ < 612
+import Foreign.C
 import qualified System.IO.UTF8 as UTF8 (readFile,hGetLine)
 # else
 import qualified System.IO as UTF8 (readFile,hGetLine)
@@ -82,49 +80,46 @@ data XFont =Core FontStruct
 initFont :: Display ->String -> IO XFont
 initFont d s =
 #ifdef XFT
-  if xftPrefix `isPrefixOf` s then
-     do setupLocale
-        xftdraw <- xftFontOpen d (defaultScreenOfDisplay d) (drop (length xftPrefix) s)
-        return (Xft xftdraw)
-  else
+       let xftPrefix = "xft:" in
+       if  xftPrefix `isPrefixOf` s then
+           fmap Xft $ initXftFont d s
+       else
 #endif
-#ifdef UTF8
-      (setupLocale >> initUtf8Font d s >>= return . Utf8)
+#if defined UTF8 ||  __GLASGOW_HASKELL__ >= 612
+           fmap Utf8 $ initUtf8Font d s
 #else
-      (initCoreFont d s >>= return . Core)
-#endif
-#ifdef XFT
-  where xftPrefix = "xft:"
-#endif
-
-releaseFont :: Display -> XFont -> IO ()
-#ifdef XFT
-releaseFont d (Xft xftfont) = xftFontClose    d xftfont
+           fmap Core $ initCoreFont d s
 #endif
-releaseFont d (Utf8     fs) = releaseUtf8Font d fs
-releaseFont d (Core     fs) = releaseCoreFont d fs
 
 -- | Given a fontname returns the font structure. If the font name is
 --  not valid the default font will be loaded and returned.
 initCoreFont :: Display -> String -> IO FontStruct
-initCoreFont dpy s = catch (getIt dpy) (fallBack dpy)
-      where getIt    d = loadQueryFont d s
-            fallBack d = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
-
-releaseCoreFont :: Display -> FontStruct -> IO ()
-releaseCoreFont d = freeFont d
+initCoreFont d s = do
+  f <- catch getIt fallBack
+  addFinalizer f (freeFont d f)
+  return f
+      where getIt    = loadQueryFont d s
+            fallBack = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
 
 -- | Given a fontname returns the font structure. If the font name is
 --  not valid the default font will be loaded and returned.
 initUtf8Font :: Display -> String -> IO FontSet
-initUtf8Font dpy s = do
-  (_,_,fs) <- catch (getIt dpy) (fallBack dpy)
-  return fs
-      where getIt    d = createFontSet d s
-            fallBack d = const $ createFontSet d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
+initUtf8Font d s = do
+  setupLocale
+  (_,_,f) <- catch getIt fallBack
+  addFinalizer f (freeFontSet d f)
+  return f
+      where getIt    = createFontSet d s
+            fallBack = const $ createFontSet d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
 
-releaseUtf8Font :: Display -> FontSet -> IO ()
-releaseUtf8Font d = freeFontSet d
+#ifdef XFT
+initXftFont :: Display -> String -> IO XftFont
+initXftFont d s = do
+  setupLocale
+  f <- xftFontOpen d (defaultScreenOfDisplay d) (drop 4 s)
+  addFinalizer f (xftFontClose d f)
+  return f
+#endif
 
 textWidth :: Display -> XFont -> String -> IO Int
 textWidth _   (Utf8 fs) s = return $ fi $ wcTextEscapement fs s
@@ -251,11 +246,14 @@ io = liftIO
 fi :: (Integral a, Num b) => a -> b
 fi = fromIntegral
 
-#if defined XFT || defined UTF8
+#if __GLASGOW_HASKELL__ < 612 && (defined XFT || defined UTF8)
 #include <locale.h>
 foreign import ccall unsafe "locale.h setlocale"
     setlocale :: CInt -> CString -> IO CString
 
-setupLocale :: IO CString
-setupLocale = withCString "" $ setlocale (#const LC_ALL)
+setupLocale :: IO ()
+setupLocale = withCString "" (setlocale $ #const LC_ALL) >> return ()
+# else
+setupLocale :: IO ()
+setupLocale = return ()
 #endif
-- 
cgit v1.2.3