Sun Aug 16 22:25:20 EEST 2009  Sergei Trofimovich <slyfox@inbox.ru>
  * fixed "Abnormally high cpu load on X" (11 issue in tracker)
  
    Steps to reproduce are described in
    http://code.google.com/p/xmobar/issues/detail?id=11
  
    I've noticed large bunch of XAllocNamedColor calls/sec
    in xmobar ltrace log.
    This patch introduces simple hackish color cachig. It's more PoC,
    than real fix.
diff -rN -u old-xmobar/XUtil.hsc new-xmobar/XUtil.hsc
--- old-xmobar/XUtil.hsc	2009-08-16 22:26:45.107628493 +0300
+++ new-xmobar/XUtil.hsc	2009-08-16 22:26:45.126628260 +0300
@@ -33,12 +33,14 @@
 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.Posix.Types (Fd(..))
 import System.IO
+import System.IO.Unsafe (unsafePerformIO)
 #if defined XFT || defined UTF8
 import Foreign.C
 import qualified System.IO.UTF8 as UTF8 (readFile,hGetLine)
@@ -187,9 +189,31 @@
 initColor dpy c = (initColor' dpy c) `catch`
                   (const . return $ DynPixel False (blackPixel dpy $ defaultScreen dpy))
 
+type ColorCache = [(String, Color)]
+
+-- dark magic: enable hack
+{-# NOINLINE colorCache #-}
+colorCache :: IORef ColorCache
+colorCache = unsafePerformIO $ newIORef []
+
+getCachedColor :: String -> IO (Maybe Color)
+getCachedColor color_name = do
+  result <- lookup color_name `fmap` readIORef colorCache
+  return result
+
+putCachedColor :: String -> Color -> IO ()
+putCachedColor color_name color_id = do
+    modifyIORef colorCache $ \cache -> (color_name,color_id) : cache
+
 initColor' :: Display -> String -> IO DynPixel
 initColor' dpy c = do
-  (c', _) <- allocNamedColor dpy colormap c
+  cached_color <- getCachedColor c
+  c' <- do
+      case cached_color of
+          Just col -> return col
+          _        -> do (c'', _) <- allocNamedColor dpy colormap c
+                         putCachedColor c c''
+                         return c''
   return $ DynPixel True (color_pixel c')
   where colormap = defaultColormap dpy (defaultScreen dpy)
 
@@ -197,7 +221,8 @@
 withColors d cs f = do
   ps <- mapM (io . initColor d) cs
   r  <- f $ map pixel ps
-  io $ freeColors d cmap (map pixel $ filter allocated ps) 0
+  -- there is color leak in 'putCachedColor'. might be freed at xmobar shutdown
+  -- io $ freeColors d cmap (map pixel $ filter allocated ps) 0
   return r
   where
     cmap = defaultColormap d (defaultScreen d)