Merge remote-tracking branch 'jrk/dbusstuff' into jrk

4 files changed, 86 insertions, 13 deletions

diff --git a/readme.md b/readme.md
index 05f441f..2d18f67 100644
--- a/readme.md
+++ b/readme.md
@@ -340,9 +340,71 @@ An example using the `dbus-send` command line utility:
             "string:Toggle"
 
 It is also possible to send multiple signals at once:
+
         # send to another screen, reveal and toggle the persistent flag
         dbus-send [..] \
-            "string:ChangeScreen" "string:Reveal" "string:TogglePersistent"
+            "string:ChangeScreen" "string:Reveal 0" "string:TogglePersistent"
+
+### Example for using the DBus IPC interface with XMonad
+
+Bind the key which should {,un}map xmobar to a dummy value. This is necessary
+for {,un}grabKey in xmonad.
+
+    ((0, xK_Alt_L   ), return ())
+
+Also, install `avoidStruts` layout modifier from `XMonad.Hooks.ManageDocks`
+
+Finally, install these two event hooks (`handleEventHook` in `XConfig`)
+`myDocksEventHook` is a replacement for `docksEventHook` which reacts on unmap
+events as well (which `docksEventHook` doesn't).
+
+    import qualified XMonad.Util.ExtensibleState as XS
+
+    data DockToggleTime = DTT { lastTime :: Time } deriving (Eq, Show, Typeable)
+
+    instance ExtensionClass DockToggleTime where
+        initialValue = DTT 0
+
+    toggleDocksHook :: Int -> KeySym -> Event -> X All
+    toggleDocksHook to ks ( KeyEvent { ev_event_display = d
+                                     , ev_event_type    = et
+                                     , ev_keycode       = ekc
+                                     , ev_time          = etime
+                                     } ) =
+            io (keysymToKeycode d ks) >>= toggleDocks >> return (All True)
+        where
+        toggleDocks kc
+            | ekc == kc && et == keyPress = do
+                safeSendSignal ["Reveal 0", "TogglePersistent"]
+                XS.put ( DTT etime )
+            | ekc == kc && et == keyRelease = do
+                gap <- XS.gets ( (-) etime . lastTime )
+                safeSendSignal [ "TogglePersistent"
+                               , "Hide " ++ show (if gap < 400 then to else 0)
+                               ]
+            | otherwise = return ()
+
+        safeSendSignal s = catchX (io $ sendSignal s) (return ())
+        sendSignal    = withSession . callSignal
+        withSession mc = connectSession >>= \c -> callNoReply c mc >> disconnect c
+        callSignal :: [String] -> MethodCall
+        callSignal s = ( methodCall
+                         ( objectPath_    "/org/Xmobar/Control" )
+                         ( interfaceName_ "org.Xmobar.Control"  )
+                         ( memberName_    "SendSignal"          )
+                       ) { methodCallDestination = Just $ busName_ "org.Xmobar.Control"
+                         , methodCallBody        = map toVariant s
+                         }
+
+    toggleDocksHook _ _ _ = return (All True)
+
+    myDocksEventHook :: Event -> X All
+    myDocksEventHook e = do
+        when (et == mapNotify || et == unmapNotify) $
+            whenX ((not `fmap` (isClient w)) <&&> runQuery checkDock w) refresh
+        return (All True)
+        where w  = ev_window e
+              et = ev_event_type e
 
 
 ## The Output Template
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