From 5d8f8d2014fd164ca73ec2c43daa9276352dc63b Mon Sep 17 00:00:00 2001 From: Andrea Rossato 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 --- Main.hs | 1 - Runnable.hs | 1 - XUtil.hsc | 74 +++++++++++++++++++++++++++++------------------------------- Xmobar.hs | 1 - xmobar.cabal | 17 +++++++++----- 5 files changed, 47 insertions(+), 47 deletions(-) diff --git a/Main.hs b/Main.hs index 74ed8cd..1a0653f 100644 --- a/Main.hs +++ b/Main.hs @@ -64,7 +64,6 @@ main = do vars <- mapM startCommand cl (r,w) <- createWin d fs conf eventLoop (XConf d r w fs conf) vars - releaseFont d fs -- | Reads the configuration files or quits with an error readConfig :: FilePath -> IO (Config,[String]) diff --git a/Runnable.hs b/Runnable.hs index fe39c80..4cd33dd 100644 --- a/Runnable.hs +++ b/Runnable.hs @@ -23,7 +23,6 @@ module Runnable where import Control.Monad import Text.Read -import Text.ParserCombinators.ReadPrec import Config (runnableTypes) import Commands 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 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 diff --git a/Xmobar.hs b/Xmobar.hs index 6292c46..898bd2e 100644 --- a/Xmobar.hs +++ b/Xmobar.hs @@ -40,7 +40,6 @@ import Control.Concurrent import Control.Concurrent.STM import Control.Exception hiding (handle) import Data.Bits -import Data.Char import Data.Maybe(fromMaybe) import Data.Typeable (Typeable) diff --git a/xmobar.cabal b/xmobar.cabal index 7bddedd..6fb7ffe 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -34,23 +34,28 @@ flag with_inotify executable xmobar main-is: Main.hs other-Modules: Xmobar, Config, Parsers, Commands, XUtil, Runnable, Plugins - ghc-options: -funbox-strict-fields -Wall ghc-prof-options: -prof -auto-all + if true + ghc-options: -funbox-strict-fields -Wall + if impl (ghc == 6.10.1) && arch (x86_64) - ghc-options: -O0 + ghc-options: -O0 + + if impl (ghc >= 6.12.1) + ghc-options: -fno-warn-unused-do-bind if flag(small_base) - build-depends: base == 4.*, containers, process, old-time, old-locale, bytestring, directory + build-depends: base == 4.*, containers, process, old-time, old-locale, bytestring, directory else - build-depends: base < 3 + build-depends: base < 3 if flag(with_xft) build-depends: utf8-string, X11-xft >= 0.2 cpp-options: -DXFT - if flag(with_utf8) + if flag(with_utf8) && impl (ghc < 6.12.1) build-depends: utf8-string cpp-options: -DUTF8 @@ -58,4 +63,4 @@ executable xmobar build-depends: hinotify cpp-options: -DINOTIFY - build-depends: X11>=1.3.0, mtl, unix, parsec, filepath, stm + build-depends: X11>=1.3.0, mtl, unix, parsec, filepath, stm -- cgit v1.2.3