From fefeae79de28446d46dc21e193aa34fcd4fe9002 Mon Sep 17 00:00:00 2001
From: Jochen Keil <jochen.keil@gmail.com>
Date: Wed, 22 Aug 2012 20:52:52 +0200
Subject: Make it possible to delay Hide, Reveal and Toggle signals

Previously Hide, Reveal and Toggle were immediate actions. This is the
same behaviour as if called now with 0 as parameter.
If the parameter is a positive non zero value it is taken as a delay for
the requested action.
After the delay (implemented using threadDelay) a new signal is sent
with zero with no timeout being effective immediately. This is necessary
to evaluate the persistency flag after the delay because it might have
changed in the meantime.
Effectively this means that it is possible to cancel the delayed
operation by calling TogglePersistent.
---
 src/Plugins/BufferedPipeReader.hs |  4 ++--
 src/Signal.hs                     |  6 +++---
 src/Xmobar.hs                     | 25 ++++++++++++++++++-------
 3 files changed, 23 insertions(+), 12 deletions(-)

(limited to 'src')

diff --git a/src/Plugins/BufferedPipeReader.hs b/src/Plugins/BufferedPipeReader.hs
index 04512e4..a2ea2a3 100644
--- a/src/Plugins/BufferedPipeReader.hs
+++ b/src/Plugins/BufferedPipeReader.hs
@@ -60,7 +60,7 @@ instance Exec BufferedPipeReader where
         writer tc ts otb = do
             (to, tg, dt, ntb) <- update
             cb dt
-            when tg $ putMVar signal Reveal
+            when tg $ putMVar signal $ Reveal 0
             when (to /= 0) $ sfork $ reset to tg ts ntb
             writer tc ts ntb
 
@@ -80,5 +80,5 @@ instance Exec BufferedPipeReader where
         reset to tg ts tb = do
             threadDelay ( to * 100 * 1000 )
             readTVarIO tb >>= \b -> when b $ do
-                when tg $ putMVar signal Hide
+                when tg $ putMVar signal $ Hide 0
                 atomically (readTVar ts) >>= maybe (return ()) cb
diff --git a/src/Signal.hs b/src/Signal.hs
index 44fe4f9..8b3b325 100644
--- a/src/Signal.hs
+++ b/src/Signal.hs
@@ -36,9 +36,9 @@ instance Exception WakeUp
 data SignalType = Wakeup
                 | Reposition
                 | ChangeScreen
-                | Hide
-                | Reveal
-                | Toggle
+                | Hide   Int
+                | Reveal Int
+                | Toggle Int
                 | TogglePersistent
     deriving (Read, Show)
 
diff --git a/src/Xmobar.hs b/src/Xmobar.hs
index 79234d2..f531cb4 100644
--- a/src/Xmobar.hs
+++ b/src/Xmobar.hs
@@ -146,9 +146,9 @@ eventLoop tv xc@(XConf d _ w fs cfg) signal = do
             ncfg <- updateConfigPosition cfg
             reposWindow ncfg
 
-         Hide ->   hide
-         Reveal -> reveal
-         Toggle -> toggle
+         Hide   t -> hide   (t*100*1000)
+         Reveal t -> reveal (t*100*1000)
+         Toggle t -> toggle (t*100*1000)
 
          TogglePersistent -> eventLoop
             tv xc { config = cfg { persistent = not $ persistent cfg } } signal
@@ -156,16 +156,27 @@ eventLoop tv xc@(XConf d _ w fs cfg) signal = do
     where
         isPersistent = not $ persistent cfg
 
-        hide   = when isPersistent (hideWindow d w) >> eventLoop tv xc signal
+        hide t | t == 0    = do
+            when isPersistent $ hideWindow d w
+            eventLoop tv xc signal
+               | otherwise = do
+            void $ forkIO
+                 $ threadDelay t >> atomically (putTMVar signal $ Hide 0)
+            eventLoop tv xc signal
 
-        reveal = if isPersistent
-            then do
+        reveal t | t == 0 =
+            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
+                 | otherwise = do
+            void $ forkIO
+                 $ threadDelay t >> atomically (putTMVar signal $ Reveal 0)
+            eventLoop tv xc signal
 
-        toggle = isMapped d w >>= \b -> if b then hide else reveal
+        toggle t = isMapped d w >>= \b -> if b then hide t else reveal t
 
         reposWindow rcfg = do
           r' <- repositionWin d w fs rcfg
-- 
cgit v1.2.3