1 files changed, 93 insertions, 0 deletions
diff --git a/XMonad/Hooks/DebugStack.hs b/XMonad/Hooks/DebugStack.hs
new file mode 100644
index 0000000..a07495d
--- /dev/null
+++ b/XMonad/Hooks/DebugStack.hs
@@ -0,0 +1,93 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.DebugStack
+-- Copyright   :  (c) Brandon S Allbery KF8NH, 2012
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  allbery.b@gmail.com
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Dump the state of the 'StackSet'.  A @logHook@ and @handleEventHook@ are
+-- also provided.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.DebugStack (debugStack
+                               ,debugStackString
+                               ,debugStackLogHook
+                               ,debugStackEventHook
+                               ) where
+
+import           XMonad.Core
+import qualified XMonad.StackSet         as W
+
+import           XMonad.Util.DebugWindow
+
+import           Graphics.X11.Types                  (Window)
+import           Graphics.X11.Xlib.Extras            (Event)
+
+import           Control.Monad                       (foldM)
+import           Data.Map                            (toList)
+import           Data.Monoid                         (All(..))
+
+-- | Print the state of the current window stack to @stderr@, which for most
+--   installations goes to @~/.xsession-errors@.  "XMonad.Util.DebugWindow"
+--   is used to display the individual windows.
+debugStack :: X ()
+debugStack =  debugStackString >>= trace
+
+-- | The above packaged as a 'logHook'.  (Currently this is identical.)
+debugStackLogHook :: X ()
+debugStackLogHook =  debugStack
+
+-- | The above packaged as a 'handleEventHook'.  You almost certainly do not
+--   want to use this unconditionally, as it will cause massive amounts of
+--   output and possibly slow @xmonad@ down severely.
+
+debugStackEventHook   :: Event -> X All
+debugStackEventHook _ =  debugStack >> return (All True)
+
+-- | Dump the state of the current 'StackSet' as a multiline 'String'.
+--   @
+--   stack [    mm
+--         ,(*) ww
+--         ,    ww
+--         ]
+--   float {    ww
+--         ,    ww
+--         }
+--   @
+--
+-- One thing I'm not sure of is where the zipper is when focus is on a
+-- floating window.
+debugStackString :: X String
+debugStackString =  withWindowSet $ \ws -> do
+                      s <- emit "stack" ("[","]") (W.peek ws)                    $ W.index    ws
+                      f <- emit "float" ("{","}") (W.peek ws) $ map fst $ toList $ W.floating ws
+                      return $ s ++ f
+  where
+    emit :: String -> (String,String) -> Maybe Window -> [Window] -> X String
+    emit title (lb,rb) _       [] = return $ title ++ " " ++ lb ++ rb ++ "]\n"
+    emit title (lb,rb) focused ws = do
+      (_,_,_,_,ss) <- foldM emit' (title,lb,rb,focused,"") ws
+      return $ ss                               ++
+               replicate (length title + 1) ' ' ++
+               rb                               ++
+               "\n"
+
+    emit' :: (String,String,String,Maybe Window,String)
+          -> Window
+          -> X (String,String,String,Maybe Window,String)
+    emit' (t,l,r,f,a) w = do
+      w' <- emit'' f w
+      return (replicate (length t) ' '
+             ,',' : replicate (length l - 1) ' '
+             ,r
+             ,f
+             ,a ++ t ++ " " ++ l ++ w' ++ "\n"
+             )
+    emit'' :: Maybe Window -> Window -> X String
+    emit'' focus win =
+      let fi f = if win == f then "(*) " else "    "
+       in (maybe "    " fi focus ++) `fmap` debugWindow win