From 713adde75fe94c38924cd60d7b3fe6f40ba7a5de Mon Sep 17 00:00:00 2001
From: Andrea Rossato <andrea.rossato@ing.unitn.it>
Date: Mon, 25 Jun 2007 14:21:59 +0200
Subject: * fixes some memory leak problems

After calling loadQueryFont the FontStruct returned must be freed after using it.
runInteractiveProcess leaks memory. runInteractiveCommand does not.

darcs-hash:20070625122159-d6583-39dac17754409bd3de9ba75d057b14b8fb6ce53e.gz
---
 xmobar.hs | 65 +++++++++++++++++++++++++++++++++------------------------------
 1 file changed, 34 insertions(+), 31 deletions(-)

diff --git a/xmobar.hs b/xmobar.hs
index f26ef61..46edfcf 100644
--- a/xmobar.hs
+++ b/xmobar.hs
@@ -125,20 +125,19 @@ runXMobar =
        eventLoop dwgf    
 
 -- | The event loop
-eventLoop :: (Display, Window, GC, FontStruct) -> Xbar ()
-eventLoop (d,w,g,f) =
+eventLoop :: (Display, Window) -> Xbar ()
+eventLoop (d,w) =
     do c <- ask
        cl <- io $ parseTemplate c (template c)
        i <- io $ execCommands c cl
        ps <- io $ parseString c i
-       io $ drawInWin c (d,w,g,f) ps
-       io $ sync d True
+       io $ drawInWin c (d,w) ps
        -- back again: we are never ending
        io $ threadDelay $ 100000 * refresh c
-       eventLoop (d,w,g,f)
+       eventLoop (d,w)
 
 -- | The function to create the initial window
-createWin :: Config -> IO (Display, Window, GC, FontStruct)
+createWin :: Config -> IO (Display, Window)
 createWin config =
   do dpy   <- openDisplay ""
      let dflt = defaultScreen dpy
@@ -149,27 +148,29 @@ createWin config =
             (fromIntegral $ width config) 
             (fromIntegral $ hight config)
      mapWindow dpy win
-     gc <- createGC dpy win
-     -- let's get the fonts
-     fontst <- loadQueryFont dpy (fonts config)
-     setFont dpy gc (fontFromFontStruct fontst)
-     -- finished
-     --freeGC dpy gc
-     return (dpy,win,gc,fontst)
+     return (dpy,win)
 
 -- | Draws in and updates the window
-drawInWin :: Config -> (Display, Window, GC, FontStruct) -> [(String, String)] -> IO ()
-drawInWin config (dpy, win, gc, fontst) str = 
-    do bgcolor  <- initColor dpy $ bgColor config
-       -- set window background 
-       setForeground dpy gc bgcolor
-       fillRectangle dpy win gc 0 0 
-                         (fromIntegral $ width config) 
-                         (fromIntegral $ hight config)
-       -- write
-       let strWithLenth = map (\(s,c) -> (s,c,textWidth fontst s)) str
-       printStrings config dpy win gc fontst 1 strWithLenth 
-       sync dpy True
+drawInWin :: Config -> (Display, Window) -> [(String, String)] -> IO ()
+drawInWin config (dpy, win) str = 
+     do bgcolor  <- initColor dpy $ bgColor config
+        gc <- createGC dpy win
+        --let's get the fonts
+        fontst <- loadQueryFont dpy (fonts config)
+        setFont dpy gc (fontFromFontStruct fontst)
+
+        -- set window background 
+        setForeground dpy gc bgcolor
+        fillRectangle dpy win gc 0 0 
+                          (fromIntegral $ width config) 
+                          (fromIntegral $ hight config)
+        -- write
+        let strWithLenth = map (\(s,c) -> (s,c,textWidth fontst s)) str
+        printStrings config dpy win gc fontst 1 strWithLenth 
+        -- free everything
+        freeFont dpy fontst
+        freeGC dpy gc
+        flush dpy
 
 -- $print
 
@@ -219,16 +220,18 @@ execCommands c ((s,com,ss):xs) =
 -- | Runs the external program
 runCom :: Config -> String -> IO String
 runCom c com =
-    do (i,o,e,p) <- runInteractiveProcess com (getOptions c com) Nothing Nothing
+    do (i,o,e,p) <- runInteractiveCommand (com ++ concat (map (' ':) $ getOptions c com))
+       -- the followinf leaks memory
+       --(i,o,e,p) <- runInteractiveProcess com (getOptions c com) Nothing Nothing
        exit <- waitForProcess p
-       let closeHandle = do hClose o
-                            hClose i
-                            hClose e
+       let closeHandles = do hClose o
+                             hClose i
+                             hClose e
        case exit of
          ExitSuccess -> do str <- hGetLine o
-                           closeHandle
+                           closeHandles
                            return str
-         _ -> do closeHandle
+         _ -> do closeHandles
                  return $ "Could not execute command " ++ com
 
 {- $parser
-- 
cgit v1.2.3