Merge for pull request #53

11 files changed, 458 insertions, 176 deletions

diff --git a/src/Commands.hs b/src/Commands.hs
index 1bfbb94..b501022 100644
--- a/src/Commands.hs
+++ b/src/Commands.hs
@@ -30,18 +30,22 @@ import Data.Char
 import System.Process
 import System.Exit
 import System.IO (hClose)
+
+import Signal
 import XUtil
 
 class Show e => Exec e where
-    alias :: e -> String
-    alias e    = takeWhile (not . isSpace) $ show e
-    rate  :: e -> Int
-    rate _     = 10
-    run   :: e -> IO String
-    run _      = return ""
-    start :: e -> (String -> IO ()) -> IO ()
-    start e cb = go
+    alias   :: e -> String
+    alias   e    = takeWhile (not . isSpace) $ show e
+    rate    :: e -> Int
+    rate    _    = 10
+    run     :: e -> IO String
+    run     _    = return ""
+    start   :: e -> (String -> IO ()) -> IO ()
+    start   e cb = go
         where go = run e >>= cb >> tenthSeconds (rate e) >> go
+    trigger :: e -> (Maybe SignalType -> IO ()) -> IO ()
+    trigger _ sh  = sh Nothing
 
 data Command = Com Program Args Alias Rate
                deriving (Show,Read,Eq)
diff --git a/src/Config.hs b/src/Config.hs
index 4405314..47358b0 100644
--- a/src/Config.hs
+++ b/src/Config.hs
@@ -28,6 +28,7 @@ import {-# SOURCE #-} Runnable
 import Plugins.Monitors
 import Plugins.Date
 import Plugins.PipeReader
+import Plugins.BufferedPipeReader
 import Plugins.CommandReader
 import Plugins.StdinReader
 import Plugins.XMonadLog
@@ -56,6 +57,8 @@ data Config =
            , borderColor    :: String     -- ^ Border color
            , lowerOnStart   :: Bool       -- ^ Lower to the bottom of the
                                           --   window stack on initialization
+           , persistent     :: Bool       -- ^ Whether automatic hiding should
+                                          --   be enabled or disabled
            , commands       :: [Runnable] -- ^ For setting the command, the command arguments
                                           --   and refresh rate for the programs to run (optional)
            , sepChar        :: String     -- ^ The character to be used for indicating
@@ -95,6 +98,7 @@ defaultConfig =
            , border = NoBorder
            , borderColor  = "#BFBFBF"
            , lowerOnStart = True
+           , persistent   = False
            , commands = [ Run $ Date "%a %b %_d %Y * %H:%M:%S" "theDate" 10
                         , Run StdinReader]
            , sepChar  = "%"
@@ -113,7 +117,7 @@ infixr :*:
 -- the 'Runnable.Runnable' Read instance. To install a plugin just add
 -- the plugin's type to the list of types (separated by ':*:') appearing in
 -- this function's type signature.
-runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*:
+runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*:
 #ifdef INOTIFY
                  Mail :*: MBox :*:
 #endif
diff --git a/src/IPC/DBus.hs b/src/IPC/DBus.hs
new file mode 100644
index 0000000..469a7c6
--- /dev/null
+++ b/src/IPC/DBus.hs
@@ -0,0 +1,64 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  DBus
+-- Copyright   :  (c) Jochen Keil
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Jochen Keil <jochen dot keil at gmail dot com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- DBus IPC module for Xmobar
+--
+-----------------------------------------------------------------------------
+
+module IPC.DBus ( runIPC ) where
+
+import Prelude hiding (catch)
+
+import DBus
+import DBus.Client
+import Control.Monad (join, when)
+import Control.Concurrent
+import Control.Exception (catch)
+import System.IO (stderr, hPutStrLn)
+
+import Signal
+import Plugins.Utils (safeHead)
+
+busName :: BusName
+busName = busName_ "org.Xmobar.Control"
+
+objectPath :: ObjectPath
+objectPath = objectPath_ "/org/Xmobar/Control"
+
+interfaceName :: InterfaceName
+interfaceName = interfaceName_ "org.Xmobar.Control"
+
+runIPC :: MVar SignalType -> IO ()
+runIPC mvst = catch exportConnection printException
+    where
+    printException :: ClientError -> IO ()
+    printException = hPutStrLn stderr . clientErrorMessage
+    exportConnection = do
+        client <- connectSession
+        requestName client busName [ nameDoNotQueue ]
+        export client objectPath [ sendSignalMethod mvst ]
+
+sendSignalMethod :: MVar SignalType -> Method
+sendSignalMethod mvst = method interfaceName sendSignalName
+    (signature_ [variantType $ toVariant $ (undefined :: SignalType)])
+    (signature_ [])
+    sendSignalMethodCall
+    where
+    sendSignalName :: MemberName
+    sendSignalName = memberName_ "SendSignal"
+
+    sendSignalMethodCall :: MethodCall -> IO Reply
+    sendSignalMethodCall mc = do
+        when ( methodCallMember mc == sendSignalName ) $ sendSignal $
+            join $ safeHead $ map fromVariant $ methodCallBody mc
+        return ( replyReturn [] )
+
+    sendSignal :: Maybe SignalType -> IO ()
+    sendSignal = maybe (return ()) (putMVar mvst)
diff --git a/src/Main.hs b/src/Main.hs
index 4c3f351..5ef5db6 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -36,6 +36,8 @@ import System.Environment
 import System.Posix.Files
 import Control.Monad (unless)
 
+import Signal (setupSignalHandler)
+
 -- $main
 
 -- | The main entry point
@@ -55,9 +57,10 @@ main = do
   conf  <- doOpts c o
   fs    <- initFont d (font conf)
   cls   <- mapM (parseTemplate conf) (splitTemplate conf)
-  vars  <- mapM (mapM startCommand) cls
+  sig   <- setupSignalHandler
+  vars  <- mapM (mapM $ startCommand sig) cls
   (r,w) <- createWin d fs conf
-  startLoop (XConf d r w fs conf) vars
+  startLoop (XConf d r w fs conf) sig vars
 
 -- | Splits the template in its parts
 splitTemplate :: Config -> [String]
diff --git a/src/Parsers.hs b/src/Parsers.hs
index f5f00a9..c92480e 100644
--- a/src/Parsers.hs
+++ b/src/Parsers.hs
@@ -131,13 +131,15 @@ parseConfig = runParser parseConf fields "Config" . stripComments
               <$?> pFont         <|?> pBgColor
               <|?> pFgColor      <|?> pPosition
               <|?> pBorder       <|?> pBdColor
-              <|?> pLowerOnStart <|?> pCommands
-              <|?> pSepChar      <|?> pAlignSep
-              <|?> pTemplate
+              <|?> pLowerOnStart <|?> pPersistent
+              <|?> pCommands     <|?> pSepChar
+              <|?> pAlignSep     <|?> pTemplate
 
       fields    = [ "font", "bgColor", "fgColor", "sepChar", "alignSep"
                   , "border", "borderColor" ,"template", "position"
-                  , "lowerOnStart", "commands"]
+                  , "lowerOnStart", "persistent", "commands"
+                  ]
+
       pFont     = strField font     "font"
       pBgColor  = strField bgColor  "bgColor"
       pFgColor  = strField fgColor  "fgColor"
@@ -148,6 +150,7 @@ parseConfig = runParser parseConf fields "Config" . stripComments
 
       pPosition     = field position     "position"     $ tillFieldEnd >>= read' "position"
       pLowerOnStart = field lowerOnStart "lowerOnStart" $ tillFieldEnd >>= read' "lowerOnStart"
+      pPersistent   = field persistent   "persistent"   $ tillFieldEnd >>= read' "persistent"
       pBorder       = field border       "border"       $ tillFieldEnd >>= read' "border"
       pCommands     = field commands     "commands"     $ readCommands
 
diff --git a/src/Plugins/BufferedPipeReader.hs b/src/Plugins/BufferedPipeReader.hs
new file mode 100644
index 0000000..be6a652
--- /dev/null
+++ b/src/Plugins/BufferedPipeReader.hs
@@ -0,0 +1,83 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Plugins.BufferedPipeReader
+-- Copyright   :  (c) Jochen Keil
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Jochen Keil <jochen dot keil at gmail dot com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A plugin for reading (temporarily) from named pipes with reset
+--
+-----------------------------------------------------------------------------
+
+module Plugins.BufferedPipeReader where
+
+import Control.Monad(forM_, when)
+import Control.Concurrent
+import Control.Concurrent.STM
+import System.IO
+import System.IO.Unsafe(unsafePerformIO)
+
+import Plugins
+import Signal
+
+data BufferedPipeReader = BufferedPipeReader String [(Int, Bool, String)]
+    deriving (Read, Show)
+
+signal :: MVar SignalType
+signal = unsafePerformIO newEmptyMVar
+
+instance Exec BufferedPipeReader where
+    alias      ( BufferedPipeReader a _  )    = a
+
+    trigger br@( BufferedPipeReader _ _  ) sh =
+        takeMVar signal >>= sh . Just >> trigger br sh
+
+    start      ( BufferedPipeReader _ ps ) cb = do
+
+        (chan, str, rst) <- initV
+        forM_ ps $ \p -> forkIO $ reader p chan
+        writer chan str rst
+
+        where
+        initV :: IO ( TChan (Int, Bool, String), TMVar String, TVar Bool )
+        initV = atomically $ do
+            tc <- newTChan
+            ts <- newEmptyTMVar
+            tb <- newTVar False
+            return (tc, ts, tb)
+
+        reader :: (Int, Bool, FilePath) -> TChan (Int, Bool, String) -> IO ()
+        reader p@(to, tg, fp) tc = do
+            openFile fp ReadWriteMode >>= hGetLineSafe >>= \dt ->
+                atomically $ writeTChan tc (to, tg, dt)
+            reader p tc
+
+        writer :: TChan (Int, Bool, String) -> TMVar String -> TVar Bool -> IO ()
+        writer tc ts otb = do
+            (to, tg, dt, ntb) <- update
+            cb dt
+            when tg $ putMVar signal Reveal
+            when (to /= 0) $ sfork $ reset to tg ts ntb
+            writer tc ts ntb
+
+            where
+            sfork :: IO () -> IO ()
+            sfork f = forkIO f >> return ()
+
+            update :: IO (Int, Bool, String, TVar Bool)
+            update = atomically $ do
+                (to, tg, dt) <- readTChan tc
+                when (to == 0) $ tryPutTMVar ts dt >> return ()
+                writeTVar otb False
+                tb <- newTVar True
+                return (to, tg, dt, tb)
+
+        reset :: Int -> Bool -> TMVar String -> TVar Bool -> IO ()
+        reset to tg ts tb = do
+            threadDelay ( to * 100 * 1000 )
+            readTVarIO tb >>= \b -> when b $ do
+                when tg $ putMVar signal Hide
+                atomically (tryTakeTMVar ts) >>= maybe (return ()) cb
diff --git a/src/Plugins/Utils.hs b/src/Plugins/Utils.hs
index 1dbcd40..bbfa84f 100644
--- a/src/Plugins/Utils.hs
+++ b/src/Plugins/Utils.hs
@@ -15,7 +15,7 @@
 ------------------------------------------------------------------------------
 
 
-module Plugins.Utils (expandHome, changeLoop) where
+module Plugins.Utils (expandHome, changeLoop, safeHead) where
 
 import Control.Monad
 import Control.Concurrent.STM
@@ -37,3 +37,7 @@ changeLoop s f = atomically s >>= go
             new <- s
             guard (new /= old)
             return new)
+
+safeHead :: [a] -> Maybe a
+safeHead    [] = Nothing
+safeHead (x:_) = Just x
diff --git a/src/Runnable.hs b/src/Runnable.hs
index 56fedb3..84d9b77 100644
--- a/src/Runnable.hs
+++ b/src/Runnable.hs
@@ -29,8 +29,9 @@ import Commands
 data Runnable = forall r . (Exec r, Read r, Show r) => Run r
 
 instance Exec Runnable where
-     start (Run a) = start a
-     alias (Run a) = alias a
+     start   (Run a) = start   a
+     alias   (Run a) = alias   a
+     trigger (Run a) = trigger a
 
 instance Show Runnable where
     show (Run x) = show x
diff --git a/src/Signal.hs b/src/Signal.hs
new file mode 100644
index 0000000..3c341f9
--- /dev/null
+++ b/src/Signal.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE DeriveDataTypeable, CPP #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Signal
+-- Copyright   :  (c) Andrea Rosatto
+--             :  (c) Jose A. Ortega Ruiz
+--             :  (c) Jochen Keil
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Signal handling, including DBUS when available
+--
+-----------------------------------------------------------------------------
+
+module Signal where
+
+import Data.Typeable (Typeable)
+import Control.Concurrent
+import Control.Exception hiding (handle)
+import System.Posix.Signals
+
+#ifdef DBUS
+import DBus (IsVariant(..))
+import Control.Monad ((>=>))
+
+import Plugins.Utils (safeHead)
+#endif
+
+data WakeUp = WakeUp deriving (Show,Typeable)
+instance Exception WakeUp
+
+data SignalType = Wakeup
+                | Reposition
+                | ChangeScreen
+                | Hide
+                | Reveal
+                | Toggle
+                | TogglePersistent
+    deriving (Read, Show)
+
+#ifdef DBUS
+instance IsVariant SignalType where
+    toVariant   = toVariant . show
+    fromVariant = fromVariant >=> parseSignalType
+#endif
+
+parseSignalType :: String -> Maybe SignalType
+parseSignalType = fmap fst . safeHead . reads
+
+-- | Signal handling
+setupSignalHandler :: IO (MVar SignalType)
+setupSignalHandler = do
+   tid   <- newEmptyMVar
+   installHandler sigUSR2 (Catch $ updatePosHandler tid) Nothing
+   installHandler sigUSR1 (Catch $ changeScreenHandler tid) Nothing
+   return tid
+
+updatePosHandler :: MVar SignalType -> IO ()
+updatePosHandler sig = do
+   putMVar sig Reposition
+   return ()
+
+changeScreenHandler :: MVar SignalType -> IO ()
+changeScreenHandler sig = do
+   putMVar sig ChangeScreen
+   return ()
diff --git a/src/Window.hs b/src/Window.hs
new file mode 100644
index 0000000..0ffa139
--- /dev/null
+++ b/src/Window.hs
@@ -0,0 +1,167 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Window
+-- Copyright   :  (c) 2011-12 Jose A. Ortega Ruiz
+--             :  (c) 2012 Jochen Keil
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Window manipulation functions
+--
+-----------------------------------------------------------------------------
+
+module Window where
+
+import Prelude hiding (catch)
+import Control.Monad (when)
+import Graphics.X11.Xlib hiding (textExtents, textWidth)
+import Graphics.X11.Xlib.Extras
+import Graphics.X11.Xinerama
+
+import Data.Maybe(fromMaybe)
+import System.Posix.Process (getProcessID)
+
+import Config
+import XUtil
+
+-- $window
+
+-- | The function to create the initial window
+createWin :: Display -> XFont -> Config -> IO (Rectangle,Window)
+createWin d fs c = do
+  let dflt = defaultScreen d
+  srs     <- getScreenInfo d
+  rootw   <- rootWindow d dflt
+  (as,ds) <- textExtents fs "0"
+  let ht    = as + ds + 4
+      (r,o) = setPosition (position c) srs (fi ht)
+  win <- newWindow  d (defaultScreenOfDisplay d) rootw r o
+  setProperties r c d win srs
+  when (lowerOnStart c) (lowerWindow d win)
+  mapWindow         d win
+  return (r,win)
+
+-- | Updates the size and position of the window
+repositionWin :: Display -> Window -> XFont -> Config -> IO Rectangle
+repositionWin d win fs c = do
+  srs     <- getScreenInfo d
+  (as,ds) <- textExtents fs "0"
+  let ht    = as + ds + 4
+      (r,_) = setPosition (position c) srs (fi ht)
+  moveResizeWindow d win (rect_x r) (rect_y r) (rect_width r) (rect_height r)
+  setProperties r c d win srs
+  return r
+
+setPosition :: XPosition -> [Rectangle] -> Dimension -> (Rectangle,Bool)
+setPosition p rs ht =
+  case p' of
+    Top -> (Rectangle rx ry rw h, True)
+    TopW a i -> (Rectangle (ax a i) ry (nw i) h, True)
+    TopSize a i ch -> (Rectangle (ax a i) ry (nw i) (mh ch), True)
+    Bottom -> (Rectangle rx ny rw h, True)
+    BottomW a i -> (Rectangle (ax a i) ny (nw i) h, True)
+    BottomSize a i ch  -> (Rectangle (ax a i) (ny' ch) (nw i) (mh ch), True)
+    Static cx cy cw ch -> (Rectangle (fi cx) (fi cy) (fi cw) (fi ch), True)
+    OnScreen _ p'' -> setPosition p'' [scr] ht
+  where
+    (scr@(Rectangle rx ry rw rh), p') =
+      case p of OnScreen i x -> (fromMaybe (head rs) $ safeIndex i rs, x)
+                _ -> (head rs, p)
+    ny       = ry + fi (rh - ht)
+    center i = rx + fi (div (remwid i) 2)
+    right  i = rx + fi (remwid i)
+    remwid i = rw - pw (fi i)
+    ax L     = const rx
+    ax R     = right
+    ax C     = center
+    pw i     = rw * min 100 i `div` 100
+    nw       = fi . pw . fi
+    h        = fi ht
+    mh h'    = max (fi h') h
+    ny' h'   = ry + fi (rh - mh h')
+    safeIndex i = lookup i . zip [0..]
+
+setProperties :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()
+setProperties r c d w srs = do
+  a1 <- internAtom d "_NET_WM_STRUT_PARTIAL"    False
+  c1 <- internAtom d "CARDINAL"                 False
+  a2 <- internAtom d "_NET_WM_WINDOW_TYPE"      False
+  c2 <- internAtom d "ATOM"                     False
+  v  <- internAtom d "_NET_WM_WINDOW_TYPE_DOCK" False
+  p  <- internAtom d "_NET_WM_PID"              False
+
+  setTextProperty d w "xmobar" wM_CLASS
+  setTextProperty d w "xmobar" wM_NAME
+
+  changeProperty32 d w a1 c1 propModeReplace $ map fi $
+    getStrutValues r (position c) (getRootWindowHeight srs)
+  changeProperty32 d w a2 c2 propModeReplace [fromIntegral v]
+
+  getProcessID >>= changeProperty32 d w p c1 propModeReplace . return . fromIntegral
+
+getRootWindowHeight :: [Rectangle] -> Int
+getRootWindowHeight srs = maximum (map getMaxScreenYCoord srs)
+  where
+    getMaxScreenYCoord sr = fi (rect_y sr) + fi (rect_height sr)
+
+getStrutValues :: Rectangle -> XPosition -> Int -> [Int]
+getStrutValues r@(Rectangle x y w h) p rwh =
+    case p of
+    OnScreen _ p'   -> getStrutValues r p' rwh
+    Top             -> [0, 0, st,  0, 0, 0, 0, 0, nx, nw,  0,  0]
+    TopW    _ _     -> [0, 0, st,  0, 0, 0, 0, 0, nx, nw,  0,  0]
+    TopSize      {} -> [0, 0, st,  0, 0, 0, 0, 0, nx, nw,  0,  0]
+    Bottom          -> [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, nx, nw]
+    BottomW _ _     -> [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, nx, nw]
+    BottomSize   {} -> [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, nx, nw]
+    Static       {} -> getStaticStrutValues p rwh
+    where st = fi y + fi h
+          sb = rwh - fi y
+          nx = fi x
+          nw = fi (x + fi w - 1)
+
+-- get some reaonable strut values for static placement.
+getStaticStrutValues :: XPosition -> Int -> [Int]
+getStaticStrutValues (Static cx cy cw ch) rwh
+    -- if the yPos is in the top half of the screen, then assume a Top
+    -- placement, otherwise, it's a Bottom placement
+    | cy < (rwh `div` 2) = [0, 0, st,  0, 0, 0, 0, 0, xs, xe,  0,  0]
+    | otherwise          = [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, xs, xe]
+    where st = cy + ch
+          sb = rwh - cy
+          xs = cx -- a simple calculation for horizontal (x) placement
+          xe = xs + cw
+getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+
+drawBorder :: Border -> Display -> Drawable -> GC -> Pixel
+              -> Dimension -> Dimension -> IO ()
+drawBorder b d p gc c wi ht =  case b of
+  NoBorder -> return ()
+  TopB       -> drawBorder (TopBM 0) d p gc c w h
+  BottomB    -> drawBorder (BottomBM 0) d p gc c w h
+  FullB      -> drawBorder (FullBM 0) d p gc c w h
+  TopBM m    -> sf >> drawLine d p gc 0 (fi m) (fi w) 0
+  BottomBM m -> let rw = fi h - fi m in
+                 sf >> drawLine d p gc 0 rw (fi w) rw
+  FullBM m   -> let pad = 2 * fi m; mp = fi m in
+                 sf >> drawRectangle d p gc mp mp (w - pad) (h - pad)
+  where sf = setForeground d gc c
+        (w, h) = (wi - 1, ht - 1)
+
+hideWindow :: Display -> Window -> IO ()
+hideWindow d w = do
+    a <- internAtom d "_NET_WM_STRUT_PARTIAL"    False
+    c <- internAtom d "CARDINAL"                 False
+    changeProperty32 d w a c propModeReplace $ replicate 12 0
+    unmapWindow d w
+    sync d False
+
+showWindow :: Display -> Window -> IO ()
+showWindow d w = mapWindow d w >> sync d False
+
+isMapped :: Display -> Window -> IO Bool
+isMapped d w = fmap ism $ getWindowAttributes d w
+    where ism (WindowAttributes { wa_map_state = wms }) = wms /= waIsUnmapped
diff --git a/src/Xmobar.hs b/src/Xmobar.hs
index c348f99..2dbba11 100644
--- a/src/Xmobar.hs
+++ b/src/Xmobar.hs
@@ -39,19 +39,21 @@ import Control.Arrow ((&&&))
 import Control.Monad.Reader
 import Control.Concurrent
 import Control.Concurrent.STM
-import Control.Exception hiding (handle)
+import Control.Exception (catch, SomeException(..))
 import Data.Bits
-import Data.Maybe(fromMaybe)
-import Data.Typeable (Typeable)
-import System.Posix.Process (getProcessID)
-import System.Posix.Signals
 
 import Config
 import Parsers
 import Commands
 import Runnable
+import Signal
+import Window
 import XUtil
 
+#ifdef DBUS
+import IPC.DBus
+#endif
+
 -- $main
 --
 -- The Xmobar data type and basic loops and functions.
@@ -72,16 +74,10 @@ data XConf =
 runX :: XConf -> X () -> IO ()
 runX xc f = runReaderT f xc
 
-data WakeUp = WakeUp deriving (Show,Typeable)
-instance Exception WakeUp
-
-data SignalType = Wakeup | Reposition | ChangeScreen
-
 -- | Starts the main event loop and threads
-startLoop :: XConf -> [[(Maybe ThreadId, TVar String)]] -> IO ()
-startLoop xcfg@(XConf _ _ w _ _) vs = do
+startLoop :: XConf -> MVar SignalType -> [[(Maybe ThreadId, TVar String)]] -> IO ()
+startLoop xcfg@(XConf _ _ w _ _) sig vs = do
     tv <- atomically $ newTVar []
-    sig <- setupSignalHandler
     _ <- forkIO (checker tv [] vs sig `catch`
                    \(SomeException _) -> void (putStrLn "Thread checker failed"))
 #ifdef THREADED_RUNTIME
@@ -90,6 +86,9 @@ startLoop xcfg@(XConf _ _ w _ _) vs = do
     _ <- forkIO (eventer sig `catch`
 #endif
                    \(SomeException _) -> void (putStrLn "Thread eventer failed"))
+#ifdef DBUS
+    runIPC sig
+#endif
     eventLoop tv xcfg sig
   where
     -- Reacts on events from X
@@ -147,7 +146,27 @@ eventLoop tv xc@(XConf d _ w fs cfg) signal = do
             ncfg <- updateConfigPosition cfg
             reposWindow ncfg
 
+         Hide ->   hide
+         Reveal -> reveal
+         Toggle -> toggle
+
+         TogglePersistent -> eventLoop
+            tv xc { config = cfg { persistent = not $ persistent cfg } } signal
+
     where
+        isPersistent = not $ persistent cfg
+
+        hide   = when isPersistent (hideWindow d w) >> eventLoop tv xc signal
+
+        reveal = if isPersistent
+            then do
+                r' <- repositionWin d w fs cfg
+                showWindow d w
+                eventLoop tv (XConf d r' w fs cfg) signal
+            else eventLoop tv xc signal
+
+        toggle = isMapped d w >>= \b -> if b then hide else reveal
+
         reposWindow rcfg = do
           r' <- repositionWin d w fs rcfg
           eventLoop tv (XConf d r' w fs rcfg) signal
@@ -163,149 +182,24 @@ eventLoop tv xc@(XConf d _ w fs cfg) signal = do
             o ->
               return (ocfg {position = OnScreen 1 o})
 
-
--- | Signal handling
-setupSignalHandler :: IO (MVar SignalType)
-setupSignalHandler = do
-   tid   <- newEmptyMVar
-   installHandler sigUSR2 (Catch $ updatePosHandler tid) Nothing
-   installHandler sigUSR1 (Catch $ changeScreenHandler tid) Nothing
-   return tid
-
-updatePosHandler :: MVar SignalType -> IO ()
-updatePosHandler sig = do
-   putMVar sig Reposition
-   return ()
-
-changeScreenHandler :: MVar SignalType -> IO ()
-changeScreenHandler sig = do
-   putMVar sig ChangeScreen
-   return ()
-
 -- $command
 
 -- | Runs a command as an independent thread and returns its thread id
 -- and the TVar the command will be writing to.
-startCommand :: (Runnable,String,String) -> IO (Maybe ThreadId, TVar String)
-startCommand (com,s,ss)
+startCommand :: MVar SignalType
+             -> (Runnable,String,String)
+             -> IO (Maybe ThreadId, TVar String)
+startCommand sig (com,s,ss)
     | alias com == "" = do var <- atomically $ newTVar is
                            atomically $ writeTVar var (s ++ ss)
                            return (Nothing,var)
     | otherwise       = do var <- atomically $ newTVar is
                            let cb str = atomically $ writeTVar var (s ++ str ++ ss)
                            h <- forkIO $ start com cb
+                           _ <- forkIO $ trigger com ( maybe (return ()) (putMVar sig) )
                            return (Just h,var)
     where is = s ++ "Updating..." ++ ss
 
--- $window
-
--- | The function to create the initial window
-createWin :: Display -> XFont -> Config -> IO (Rectangle,Window)
-createWin d fs c = do
-  let dflt = defaultScreen d
-  srs     <- getScreenInfo d
-  rootw   <- rootWindow d dflt
-  (as,ds) <- textExtents fs "0"
-  let ht    = as + ds + 4
-      (r,o) = setPosition (position c) srs (fi ht)
-  win <- newWindow  d (defaultScreenOfDisplay d) rootw r o
-  setProperties r c d win srs
-  when (lowerOnStart c) (lowerWindow d win)
-  mapWindow         d win
-  return (r,win)
-
--- | Updates the size and position of the window
-repositionWin :: Display -> Window -> XFont -> Config -> IO Rectangle
-repositionWin d win fs c = do
-  srs     <- getScreenInfo d
-  (as,ds) <- textExtents fs "0"
-  let ht    = as + ds + 4
-      (r,_) = setPosition (position c) srs (fi ht)
-  moveResizeWindow d win (rect_x r) (rect_y r) (rect_width r) (rect_height r)
-  setProperties r c d win srs
-  return r
-
-setPosition :: XPosition -> [Rectangle] -> Dimension -> (Rectangle,Bool)
-setPosition p rs ht =
-  case p' of
-    Top -> (Rectangle rx ry rw h, True)
-    TopW a i -> (Rectangle (ax a i) ry (nw i) h, True)
-    TopSize a i ch -> (Rectangle (ax a i) ry (nw i) (mh ch), True)
-    Bottom -> (Rectangle rx ny rw h, True)
-    BottomW a i -> (Rectangle (ax a i) ny (nw i) h, True)
-    BottomSize a i ch  -> (Rectangle (ax a i) (ny' ch) (nw i) (mh ch), True)
-    Static cx cy cw ch -> (Rectangle (fi cx) (fi cy) (fi cw) (fi ch), True)
-    OnScreen _ p'' -> setPosition p'' [scr] ht
-  where
-    (scr@(Rectangle rx ry rw rh), p') =
-      case p of OnScreen i x -> (fromMaybe (head rs) $ safeIndex i rs, x)
-                _ -> (head rs, p)
-    ny       = ry + fi (rh - ht)
-    center i = rx + fi (div (remwid i) 2)
-    right  i = rx + fi (remwid i)
-    remwid i = rw - pw (fi i)
-    ax L     = const rx
-    ax R     = right
-    ax C     = center
-    pw i     = rw * min 100 i `div` 100
-    nw       = fi . pw . fi
-    h        = fi ht
-    mh h'    = max (fi h') h
-    ny' h'   = ry + fi (rh - mh h')
-    safeIndex i = lookup i . zip [0..]
-
-setProperties :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()
-setProperties r c d w srs = do
-  a1 <- internAtom d "_NET_WM_STRUT_PARTIAL"    False
-  c1 <- internAtom d "CARDINAL"                 False
-  a2 <- internAtom d "_NET_WM_WINDOW_TYPE"      False
-  c2 <- internAtom d "ATOM"                     False
-  v  <- internAtom d "_NET_WM_WINDOW_TYPE_DOCK" False
-  p  <- internAtom d "_NET_WM_PID"              False
-
-  setTextProperty d w "xmobar" wM_CLASS
-  setTextProperty d w "xmobar" wM_NAME
-
-  changeProperty32 d w a1 c1 propModeReplace $ map fi $
-    getStrutValues r (position c) (getRootWindowHeight srs)
-  changeProperty32 d w a2 c2 propModeReplace [fromIntegral v]
-
-  getProcessID >>= changeProperty32 d w p c1 propModeReplace . return . fromIntegral
-
-getRootWindowHeight :: [Rectangle] -> Int
-getRootWindowHeight srs = maximum (map getMaxScreenYCoord srs)
-  where
-    getMaxScreenYCoord sr = fi (rect_y sr) + fi (rect_height sr)
-
-getStrutValues :: Rectangle -> XPosition -> Int -> [Int]
-getStrutValues r@(Rectangle x y w h) p rwh =
-    case p of
-    OnScreen _ p'   -> getStrutValues r p' rwh
-    Top             -> [0, 0, st,  0, 0, 0, 0, 0, nx, nw,  0,  0]
-    TopW    _ _     -> [0, 0, st,  0, 0, 0, 0, 0, nx, nw,  0,  0]
-    TopSize      {} -> [0, 0, st,  0, 0, 0, 0, 0, nx, nw,  0,  0]
-    Bottom          -> [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, nx, nw]
-    BottomW _ _     -> [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, nx, nw]
-    BottomSize   {} -> [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, nx, nw]
-    Static       {} -> getStaticStrutValues p rwh
-    where st = fi y + fi h
-          sb = rwh - fi y
-          nx = fi x
-          nw = fi (x + fi w - 1)
-
--- get some reaonable strut values for static placement.
-getStaticStrutValues :: XPosition -> Int -> [Int]
-getStaticStrutValues (Static cx cy cw ch) rwh
-    -- if the yPos is in the top half of the screen, then assume a Top
-    -- placement, otherwise, it's a Bottom placement
-    | cy < (rwh `div` 2) = [0, 0, st,  0, 0, 0, 0, 0, xs, xe,  0,  0]
-    | otherwise          = [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, xs, xe]
-    where st = cy + ch
-          sb = rwh - cy
-          xs = cx -- a simple calculation for horizontal (x) placement
-          xe = xs + cw
-getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
-
 updateWin :: TVar [String] -> X ()
 updateWin v = do
   xc <- ask
@@ -346,21 +240,6 @@ drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do
     -- resync
     io $ sync       d True
 
-drawBorder :: Border -> Display -> Drawable -> GC -> Pixel
-              -> Dimension -> Dimension -> IO ()
-drawBorder b d p gc c wi ht =  case b of
-  NoBorder -> return ()
-  TopB       -> drawBorder (TopBM 0) d p gc c w h
-  BottomB    -> drawBorder (BottomBM 0) d p gc c w h
-  FullB      -> drawBorder (FullBM 0) d p gc c w h
-  TopBM m    -> sf >> drawLine d p gc 0 (fi m) (fi w) 0
-  BottomBM m -> let rw = fi h - fi m in
-                 sf >> drawLine d p gc 0 rw (fi w) rw
-  FullBM m   -> let pad = 2 * fi m; mp = fi m in
-                 sf >> drawRectangle d p gc mp mp (w - pad) (h - pad)
-  where sf = setForeground d gc c
-        (w, h) = (wi - 1, ht - 1)
-
 -- | An easy way to print the stuff we need to print
 printStrings :: Drawable -> GC -> XFont -> Position
              -> Align -> [(String, String, Position)] -> X ()