ShowWName now uses Timer and XUtils to display the workspace name

darcs-hash:20080113091107-32816-dc4979a584b798df3be8d7b1cd49cb3f5a1dd80e.gz

1 files changed, 42 insertions, 33 deletions

diff --git a/XMonad/Layout/ShowWName.hs b/XMonad/Layout/ShowWName.hs
index 7eef687..6110871 100644
--- a/XMonad/Layout/ShowWName.hs
+++ b/XMonad/Layout/ShowWName.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
+{-# LANGUAGE PatternGuards, TypeSynonymInstances, MultiParamTypeClasses #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.ShowWName
@@ -9,9 +9,7 @@
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- This is a layout modifier that will show the workspace name using
--- dzen.
---
+-- This is a layout modifier that will show the workspace name
 -----------------------------------------------------------------------------
 
 module XMonad.Layout.ShowWName
@@ -27,7 +25,8 @@ import XMonad
 import qualified XMonad.StackSet as S
 import XMonad.Layout.LayoutModifier
 import XMonad.Util.Font
-import XMonad.Util.Dzen
+import XMonad.Util.Timer
+import XMonad.Util.XUtils
 
 -- $usage
 -- You can use this module with the following in your
@@ -41,21 +40,23 @@ import XMonad.Util.Dzen
 --
 -- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
--- | XXX
+-- | A layout modifier to show the workspace name when switching
 showWName :: l a -> ModifiedLayout ShowWName l a
-showWName = ModifiedLayout (SWN True defaultSWNConfig)
+showWName = ModifiedLayout (SWN True defaultSWNConfig Nothing)
 
--- | XXX
+-- | A layout modifier to show the workspace name when switching. It
+-- is possible to provide a costum configuration.
 showWName' :: SWNConfig -> l a -> ModifiedLayout ShowWName l a
-showWName' c = ModifiedLayout (SWN True c)
+showWName' c = ModifiedLayout (SWN True c Nothing)
 
-data ShowWName a = SWN Bool SWNConfig deriving (Read, Show)
+type ShowWNState = Maybe (TimerId, Window)
+data ShowWName a = SWN Bool SWNConfig ShowWNState deriving (Read, Show)
 
-data SWNConfig = 
-    SWNC { swn_font    :: String
-         , swn_bgcolor :: String
-         , swn_color   :: String
-         , swn_fade    :: Rational
+data SWNConfig =
+    SWNC { swn_font    :: String   -- ^ Font name 
+         , swn_bgcolor :: String   -- ^ Backgorund color
+         , swn_color   :: String   -- ^ String color
+         , swn_fade    :: Rational -- ^ Time in seconds of the name visibility
     } deriving (Read, Show)
 
 defaultSWNConfig :: SWNConfig
@@ -67,29 +68,37 @@ defaultSWNConfig =
          }
 
 instance LayoutModifier ShowWName Window where
-    redoLayout (SWN True  c) r _ wrs = flashName c r >> return (wrs, Just $ SWN False c)
-    redoLayout (SWN False _) _ _ wrs = return (wrs, Nothing)
+    redoLayout (SWN True  c (Just (_,w))) r _ wrs = deleteWindow w >> flashName c r wrs
+    redoLayout (SWN True  c  Nothing    ) r _ wrs = flashName c r wrs
+    redoLayout (SWN False _  _          ) _ _ wrs = return (wrs, Nothing)
+
+    handleMess (SWN _ c (Just (i,w))) m
+        | Just e    <- fromMessage m = handleTimer i e (deleteWindow w >> return Nothing)
+        | Just Hide <- fromMessage m = do deleteWindow w
+                                          return . Just $ SWN True c Nothing
 
-    handleMess (SWN _ c) m
-                    | Just Hide <- fromMessage m = return . Just $ SWN True c
-                    | otherwise                  = return Nothing
+    handleMess (SWN _ c s) m
+        | Just Hide <- fromMessage m = return . Just $ SWN True c s
+        | otherwise                  = return Nothing
 
-flashName :: SWNConfig -> Rectangle -> X ()
-flashName c (Rectangle _ _ wh ht) = do
+flashName :: SWNConfig -> Rectangle -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a))
+flashName c (Rectangle _ _ wh ht) wrs = do
   d <- asks display
   n <- withWindowSet (return . S.tag . S.workspace . S.current)
   f <- initXMF (swn_font c)
   width       <- textWidthXMF d f n
   (_,as,ds,_) <- textExtentsXMF f n
+  let hight = as + ds
+      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 "" "" (swn_bgcolor c) (swn_color c) AlignCenter n
   releaseXMF f
-  let hight = as + ds + 2
-      y     = (fromIntegral ht - hight) `div` 2
-      x     = (fromIntegral wh - width) `div` 2
-      args  = [ "-fn", swn_font    c
-              , "-fg", swn_color   c
-              , "-bg", swn_bgcolor c
-              , "-x" , show x
-              , "-y" , show y
-              , "-w" , show $ 3 * (width + 2)
-              ]
-  dzenWithArgs n args ((swn_fade c) `seconds`)
+  io $ sync d False
+  i <- startTimer (swn_fade c)
+  return (wrs, Just $ SWN False c $ Just (i,w))
+
+-- | Short-hand for 'fromIntegral'
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral