add reminder functionality to UrgencyHook

I'm considering rewriting remindWhen and suppressWhen as UrgencyHookModifiers, so to speak. Bleh.

darcs-hash:20080824200548-78224-8589b08cc15bcb9506c0e86df832c1d7a73efaa8.gz

1 files changed, 91 insertions, 33 deletions

diff --git a/XMonad/Hooks/UrgencyHook.hs b/XMonad/Hooks/UrgencyHook.hs
index 037a4b8..befb99a 100644
--- a/XMonad/Hooks/UrgencyHook.hs
+++ b/XMonad/Hooks/UrgencyHook.hs
@@ -53,7 +53,8 @@ module XMonad.Hooks.UrgencyHook (
                                  -- * Stuff for your config file:
                                  withUrgencyHook, withUrgencyHookC,
                                  UrgencyConfig(..), urgencyConfig,
-                                 SuppressWhen(..),
+                                 SuppressWhen(..), RemindWhen(..),
+                                 minutes,
                                  focusUrgent,
                                  dzenUrgencyHook,
                                  DzenUrgencyHook(..), seconds,
@@ -72,6 +73,7 @@ import qualified XMonad.StackSet as W
 import XMonad.Hooks.EventHook
 import XMonad.Util.Dzen (dzenWithArgs, seconds)
 import XMonad.Util.NamedWindows (getName)
+import XMonad.Util.Timer (TimerId, startTimer, handleTimer)
 
 import Control.Applicative ((<$>))
 import Control.Monad (when)
@@ -193,19 +195,18 @@ import Foreign (unsafePerformIO)
 -- Hopefully you already read the section on how to configure xmonad. If not,
 -- hopefully you know where to find it.
 
--- | This is the method to enable an urgency hook. It suppresses urgency status
--- for windows that are currently visible. If you'd like to change that behavior,
--- use 'withUrgencyHookC'.
+-- | This is the method to enable an urgency hook. It uses the default
+-- 'urgencyConfig' to control behavior. To change this, use 'withUrgencyHook'
+-- instead.
 withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) =>
                    h -> XConfig l -> XConfig (HandleEvent (WithUrgencyHook h) l)
 withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf
 
--- | If you'd like to configure *when* to trigger the urgency hook, call this
--- function with a custom 'UrgencyConfig'. Or, by example:
+-- | This lets you modify the defaults set in 'urgencyConfig'. An example:
 --
 -- > withUrgencyHookC dzenUrgencyHook { ... } urgencyConfig { suppressWhen = Focused }
 --
--- (Don't type the @...@, you dolt.) See documentation on your options at 'SuppressWhen'.
+-- (Don't type the @...@, you dolt.) See 'UrgencyConfig' for details on configuration.
 withUrgencyHookC :: (LayoutClass l Window, UrgencyHook h) =>
                     h -> UrgencyConfig -> XConfig l -> XConfig (HandleEvent (WithUrgencyHook h) l)
 withUrgencyHookC hook urgConf conf = conf {
@@ -213,16 +214,13 @@ withUrgencyHookC hook urgConf conf = conf {
         logHook = cleanupUrgents (suppressWhen urgConf) >> logHook conf
     }
 
--- | Global configuration, applicable to all types of 'UrgencyHook'.
+-- | Global configuration, applied to all types of 'UrgencyHook'. See
+-- 'urgencyConfig' for the defaults.
 data UrgencyConfig = UrgencyConfig
-    { suppressWhen :: SuppressWhen -- ^ see 'SuppressWhen' for options
+    { suppressWhen :: SuppressWhen -- ^ when to trigger the urgency hook
+    , remindWhen   :: RemindWhen   -- ^ when to re-trigger the urgency hook
     } deriving (Read, Show)
 
--- | The default 'UrgencyConfig'. Use a variation of this in your config just
--- as you use a variation of defaultConfig for your xmonad definition.
-urgencyConfig :: UrgencyConfig
-urgencyConfig = UrgencyConfig { suppressWhen = Visible }
-
 -- | A set of choices as to /when/ you should (or rather, shouldn't) be notified of an urgent window.
 -- The default is 'Visible'. Prefix each of the following with \"don't bug me when\":
 data SuppressWhen = Visible  -- ^ the window is currently visible
@@ -231,6 +229,26 @@ data SuppressWhen = Visible  -- ^ the window is currently visible
                   | Never    -- ^ ... aww, heck, go ahead and bug me, just in case.
                   deriving (Read, Show)
 
+-- | A set of choices as to when you want to be re-notified of an urgent
+-- window. Perhaps you focused on something and you miss the dzen popup bar. Or
+-- you're AFK. Or you feel the need to be more distracted. I don't care.
+--
+-- The interval arguments are in seconds. See the 'minutes' helper.
+data RemindWhen = Dont                    -- ^ triggering once is enough
+                | Repeatedly Int Interval -- ^ repeat <arg1> times every <arg2> seconds
+                | Every Interval          -- ^ repeat every <arg1> until the urgency hint is cleared
+                deriving (Read, Show)
+
+-- | A prettified way of multiplying by 60. Use like: @(5 `minutes`)@.
+minutes :: Rational -> Rational
+minutes secs = secs * 60
+
+-- | The default 'UrgencyConfig'. suppressWhen = Visible, remindWhen = Dont.
+-- Use a variation of this in your config just as you use a variation of
+-- defaultConfig for your xmonad definition.
+urgencyConfig :: UrgencyConfig
+urgencyConfig = UrgencyConfig { suppressWhen = Visible, remindWhen = Dont }
+
 -- | Focuses the most recently urgent window. Good for what ails ya -- I mean, your keybindings.
 -- Example keybinding:
 --
@@ -255,7 +273,32 @@ readUrgents = io $ readIORef urgents
 withUrgents :: ([Window] -> X a) -> X a
 withUrgents f = readUrgents >>= f
 
-data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig deriving (Read, Show)
+adjustUrgents :: ([Window] -> [Window]) -> X ()
+adjustUrgents f = io $ modifyIORef urgents f
+
+type Interval = Rational
+
+-- | An urgency reminder, as reified for 'RemindWhen'.
+-- The last value is the countdown number, for 'Repeatedly'.
+data Reminder = Reminder { timer     :: TimerId
+                         , window    :: Window
+                         , interval  :: Interval
+                         , remaining :: Maybe Int
+                         } deriving Eq
+
+-- | Stores the list of urgency reminders.
+{-# NOINLINE reminders #-}
+reminders :: IORef [Reminder]
+reminders = unsafePerformIO (newIORef [])
+
+readReminders :: X [Reminder]
+readReminders = io $ readIORef reminders
+
+adjustReminders :: ([Reminder] -> [Reminder]) -> X ()
+adjustReminders f = io $ modifyIORef reminders f
+
+data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig
+    deriving (Read, Show)
 
 -- The Non-ICCCM Manifesto:
 -- Note: Some non-standard choices have been made in this implementation to
@@ -270,33 +313,48 @@ data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig deriving (Read, Show)
 -- set urgency if a window is visible. If you have a better idea, please, let us
 -- know!
 instance UrgencyHook h => EventHook (WithUrgencyHook h) where
-    handleEvent wuh event =
-      case event of
+    handleEvent wuh event = case event of
         PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do
           when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do
               WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
               if (testBit flags urgencyHintBit) then do
-                  -- Add to list of urgents.
                   adjustUrgents (\ws -> if elem w ws then ws else w : ws)
-                  -- Call the urgencyHook.
                   callUrgencyHook wuh w
-                else do
-                  -- Remove from list of urgents.
-                  adjustUrgents (delete w)
-              -- Call logHook after IORef has been modified.
-              userCode =<< asks (logHook . config)
-        DestroyWindowEvent {ev_window = w} -> do
-          adjustUrgents (delete w)
+                else
+                  clearUrgency w
+              userCode =<< asks (logHook . config) -- call *after* IORef has been modified
+        DestroyWindowEvent {ev_window = w} ->
+          clearUrgency w
         _ ->
-          return ()
-
-adjustUrgents :: ([Window] -> [Window]) -> X ()
-adjustUrgents f = io $ modifyIORef urgents f
+          mapM_ handleReminder =<< readReminders
+      where clearUrgency w = adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window)
+            handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder
 
 callUrgencyHook :: UrgencyHook h => WithUrgencyHook h -> Window -> X ()
-callUrgencyHook (WithUrgencyHook hook UrgencyConfig { suppressWhen = sw }) w =
-    whenX (not <$> shouldSuppress sw w)
-          (userCode $ urgencyHook hook w)
+callUrgencyHook (WithUrgencyHook hook UrgencyConfig { suppressWhen = sw, remindWhen = rw }) w =
+    whenX (not <$> shouldSuppress sw w) $ do
+        userCode $ urgencyHook hook w
+        case rw of
+            Repeatedly times int -> addReminder w int $ Just times
+            Every int            -> addReminder w int Nothing
+            Dont                 -> return ()
+
+addReminder :: Window -> Rational -> Maybe Int -> X ()
+addReminder w int times = do
+    timerId <- startTimer int
+    let reminder = Reminder timerId w int times
+    adjustReminders (\rs -> if w `elem` map window rs then rs else reminder : rs)
+
+reminderHook :: UrgencyHook h => WithUrgencyHook h -> Reminder -> X (Maybe a)
+reminderHook (WithUrgencyHook hook _) reminder = do
+    case remaining reminder of
+        Just x | x > 0 -> remind $ Just (x - 1)
+        Just _         -> adjustReminders $ delete reminder
+        Nothing        -> remind Nothing
+    return Nothing
+  where remind remaining' = do userCode $ urgencyHook hook (window reminder)
+                               adjustReminders $ delete reminder
+                               addReminder (window reminder) (interval reminder) remaining'
 
 shouldSuppress :: SuppressWhen -> Window -> X Bool
 shouldSuppress sw w = elem w <$> suppressibleWindows sw