From c2218350dfd21f60707e34eb1db112a0ae2ba548 Mon Sep 17 00:00:00 2001 From: "allbery.b" Date: Sun, 3 Aug 2014 04:05:30 +0200 Subject: 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 --- XMonad/Hooks/DebugStack.hs | 113 ++++++++++++++++++++++++++------------------- 1 file changed, 65 insertions(+), 48 deletions(-) (limited to 'XMonad/Hooks') 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) -- cgit v1.2.3