debug-debug

Ignore-this: cbb2b1d99293e3a4d02a256c2733aeb0
Various fixes and enhancements to DebugWindow and DebugStack. ManageDebug
requires these fixes, but some of them are significant even if not using
ManageDebug.

darcs-hash:20140803020530-181ff-f11b9446cddb31d970d1e227e63ec6ec5a45a0d2.gz

1 files changed, 65 insertions, 48 deletions

diff --git a/XMonad/Hooks/DebugStack.hs b/XMonad/Hooks/DebugStack.hs
index a07495d..bb42696 100644
--- a/XMonad/Hooks/DebugStack.hs
+++ b/XMonad/Hooks/DebugStack.hs
@@ -1,26 +1,30 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.DebugStack
--- Copyright   :  (c) Brandon S Allbery KF8NH, 2012
+-- Copyright   :  (c) Brandon S Allbery KF8NH, 2014
 -- 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
+-- Dump the state of the 'StackSet'. A @logHook@ and @handleEventHook@ are
 -- also provided.
 --
 -----------------------------------------------------------------------------
 
 module XMonad.Hooks.DebugStack (debugStack
+                               ,debugStackFull
                                ,debugStackString
+                               ,debugStackFullString
                                ,debugStackLogHook
+                               ,debugStackFullLogHook
                                ,debugStackEventHook
+                               ,debugStackFullEventHook
                                ) where
 
 import           XMonad.Core
-import qualified XMonad.StackSet         as W
+import qualified XMonad.StackSet                                       as W
 
 import           XMonad.Util.DebugWindow
 
@@ -28,66 +32,79 @@ import           Graphics.X11.Types                  (Window)
 import           Graphics.X11.Xlib.Extras            (Event)
 
 import           Control.Monad                       (foldM)
-import           Data.Map                            (toList)
+import           Data.Map                            (member)
 import           Data.Monoid                         (All(..))
+import           Data.List                           (intercalate)
 
--- | 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.
+-- | Print the state of the current window stack for the current workspace 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.)
+-- | Print the state of the current window stack for all workspaces to
+--   @stderr@, which for most installations goes to @~/.xsession-errors@.
+--   "XMonad.Util.DebugWindow" is used to display the individual windows.
+debugStackFull :: X ()
+debugStackFull =  debugStackFullString >>= trace
+
+-- | 'debugStack' packaged as a 'logHook'. (Currently this is identical.)
 debugStackLogHook :: X ()
 debugStackLogHook =  debugStack
 
--- | The above packaged as a 'handleEventHook'.  You almost certainly do not
+-- | 'debugStackFull packaged as a 'logHook'. (Currently this is identical.)
+debugStackFullLogHook :: X ()
+debugStackFullLogHook =  debugStackFull
+
+-- | 'debugStack' 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'.
+-- | 'debugStackFull' 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.
+
+debugStackFullEventHook   :: Event -> X All
+debugStackFullEventHook _ =  debugStackFull >> return (All True)
+
+-- | Dump the state of the current workspace in the 'StackSet' as a multiline 'String'.
+debugStackString :: X String
+debugStackString =  withWindowSet $ debugStackWs . W.workspace . W.current
+
+-- | Dump the state of all workspaces in the 'StackSet' as a multiline 'String'.
+-- @@@ this is in stackset order, which is roughly lru-ish
+debugStackFullString :: X String
+debugStackFullString =  withWindowSet $ fmap (intercalate "\n") . mapM debugStackWs . W.workspaces
+
+-- | Dump the state of a workspace in the current 'StackSet' as a multiline 'String'.
 --   @
---   stack [    mm
---         ,(*) ww
---         ,    ww
---         ]
---   float {    ww
---         ,    ww
---         }
+--   Workspace "foo::
+--     mm
+--   * 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
+--   * indicates the focused window, ^ indicates a floating window
+debugStackWs   :: W.Workspace String (Layout Window) Window -> X String
+debugStackWs w =  withWindowSet $ \ws -> do
+  let cur = if wt == W.currentTag ws then " (current)" else ""
+      wt  = W.tag w
+  s <- emit ws $ W.integrate' . W.stack $ w
+  return $ intercalate "\n" $ ("Workspace " ++ show wt ++ cur):s
   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)
+    emit       :: WindowSet -> [Window] -> X [String]
+    emit _  [] =  return ["    -empty workspace-"]
+    emit ww ws = do
+      (_,ss) <- foldM emit' (ww,[]) ws
+      return ss
+
+    emit' :: (WindowSet,[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
+          -> X (WindowSet,[String])
+    emit' (ws,a) w' = do
+      let focus = if Just w' == W.peek ws then '*' else ' '
+          float = if w' `member` W.floating ws then '^' else ' '
+      s <- debugWindow w'
+      return (ws,(focus:float:s):a)