Add XMonad.Actions.ShowText

Ignore-this: 5f4818f7ec9ad37df58e73d4bb8b5590

darcs-hash:20121225202635-2383e-eb5cae938eb65f8d89feea63d38df6b3df5e3fde.gz

1 files changed, 110 insertions, 0 deletions

diff --git a/XMonad/Actions/ShowText.hs b/XMonad/Actions/ShowText.hs
new file mode 100644
index 0000000..bc8bc00
--- /dev/null
+++ b/XMonad/Actions/ShowText.hs
@@ -0,0 +1,110 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.ShowText
+-- Copyright   :  (c) Mario Pastorelli (2012)
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  pastorelli.mario@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- ShowText displays text for sometime on the screen
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.ShowText
+    ( -- * Usage
+      -- $usage
+      defaultSTConfig
+    , handleTimerEvent
+    , flashText
+    , ShowTextConfig(..)
+    ) where
+
+import Control.Monad (when)
+import Data.Map (Map,empty,insert,lookup)
+import Prelude hiding (lookup)
+import XMonad
+import XMonad.StackSet (current,screen)
+import XMonad.Util.Font (Align(AlignCenter)
+                       , initXMF
+                       , releaseXMF
+                       , textExtentsXMF
+                       , textWidthXMF)
+import XMonad.Util.Timer (startTimer)
+import XMonad.Util.XUtils (createNewWindow
+                         , deleteWindow
+                         , fi
+                         , showWindow
+                         , paintAndWrite)
+import qualified XMonad.Util.ExtensibleState as ES
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.ShowText
+--
+-- Then add the event hook handler:
+--
+-- > xmonad { handleEventHook = myHandleEventHooks <+> handleTimerEvent }
+--
+-- You can then use flashText in your keybindings:
+--
+-- > ((modMask, xK_Right), flashText defaultSTConfig 1 "->" >> nextWS)
+--
+
+-- ShowText contains the map with timers as keys and created windows as values
+newtype ShowText = ShowText (Map Atom Window)
+    deriving (Read,Show,Typeable)
+
+instance ExtensionClass ShowText where
+    initialValue = ShowText empty
+
+-- | Utility to modify a ShowText
+modShowText :: (Map Atom Window -> Map Atom Window) -> ShowText -> ShowText
+modShowText f (ShowText m) = ShowText $ f m
+
+data ShowTextConfig =
+    STC { st_font :: String -- ^ Font name
+        , st_bg   :: String -- ^ Background color
+        , st_fg   :: String -- ^ Foreground color
+    }
+
+defaultSTConfig :: ShowTextConfig
+defaultSTConfig =
+    STC { st_font = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"
+        , st_bg   = "black"
+        , st_fg   = "white"
+    }
+
+-- | Handles timer events that notify when a window should be removed
+handleTimerEvent :: Event -> X ()
+handleTimerEvent (ClientMessageEvent _ _ _ dis _ mtyp d) = do
+    (ShowText m) <- ES.get :: X ShowText
+    a <- io $ internAtom dis "XMONAD_TIMER" False
+    when (mtyp == a && length d >= 1)
+         (whenJust (lookup (fromIntegral $ d !! 0) m) deleteWindow)
+handleTimerEvent _ = return ()
+
+-- | Shows a window in the center of the screen with the given text
+flashText :: ShowTextConfig -> Rational -> String -> X ()
+flashText c i s = do
+  f <- initXMF (st_font c)
+  d <- asks display
+  sc <- gets $ fi . screen . current . windowset
+  width <- textWidthXMF d f s
+  (as,ds) <- textExtentsXMF f s
+  let hight = as + ds
+      ht    = displayHeight d sc
+      wh    = displayWidth d sc
+      y     = (fi ht - hight + 2) `div` 2
+      x     = (fi wh - width + 2) `div` 2
+  w <- createNewWindow (Rectangle (fi x) (fi y) (fi width) (fi hight))
+                      Nothing "" True
+  showWindow w
+  paintAndWrite w f (fi width) (fi hight) 0 (st_bg c) ""
+                (st_fg c) (st_bg c) [AlignCenter] [s]
+  releaseXMF f
+  io $ sync d False
+  t <- startTimer i
+  ES.modify $ modShowText (insert (fromIntegral t) w)