twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-15 12:13:57 -07:00
Code Issues Packages Projects Releases Wiki Activity

debug-debug

Browse Source 
Various fixes and enhancements to DebugWindow and DebugStack. ManageDebug
requires these fixes, but some of them are significant even if not using
ManageDebug.
This commit is contained in:
allbery.b
2014-08-03 02:05:30 +00:00
parent 11265ad69b
commit ec0fb3ba8a
2 changed files with 113 additions and 62 deletions
Download Patch File Download Diff File Expand all files Collapse all files

117
XMonad/Hooks/DebugStack.hs
View File

@@ -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'.
-- @
-- 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"
-- | '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.
emit' :: (String,String,String,Maybe Window,String)
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'.
-- @
-- Workspace "foo::
-- mm
-- * ww
-- ^ww
-- @
-- * 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 :: 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)

58
XMonad/Util/DebugWindow.hs
View File

@@ -1,14 +1,14 @@
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Util.DebugWindow
-- 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
--
-- Module to dump window information for diagnostic/debugging purposes. See
-- Module to dump window information for diagnostic/debugging purposes. See
-- "XMonad.Hooks.DebugEvents" and "XMonad.Hooks.DebugStack" for practical uses.
--
-----------------------------------------------------------------------------
@@ -20,7 +20,7 @@ import Prelude
import XMonad
import Codec.Binary.UTF8.String (decodeString)
import Control.Exception.Extensible as E
import Control.Exception.Extensible as E
import Control.Monad (when)
import Data.List (unfoldr
,intercalate
@@ -34,7 +34,7 @@ import System.Exit
-- and its title if available. Also indicate override_redirect with an
-- exclamation mark, and wrap in brackets if it is unmapped or withdrawn.
debugWindow :: Window -> X String
debugWindow 0 = return "None"
debugWindow 0 = return "-no window-"
debugWindow w = do
let wx = pad 8 '0' $ showHex w ""
w' <- withDisplay $ \d -> io (safeGetWindowAttributes d w)
@@ -59,23 +59,36 @@ debugWindow w = do
catchX' (wrap `fmap` getEWMHTitle "" w) $
catchX' (wrap `fmap` getICCCMTitle w) $
return ""
h' <- getMachine w
let h = if null h' then "" else '@':h'
-- if it has WM_COMMAND use it, else use the appName
-- NB. modern stuff often does not set WM_COMMAND since it's only ICCCM required and not some
-- horrible gnome/freedesktop session manager thing like Wayland intended. How helpful of them.
p' <- withDisplay $ \d -> safeGetCommand d w
let p = if null p' then "" else wrap $ intercalate " " p'
nWP <- getAtom "_NET_WM_PID"
pid' <- withDisplay $ \d -> io $ getWindowProperty32 d nWP w
let pid = case pid' of
Just [pid''] -> '(':show pid'' ++ ")"
_ -> ""
let cmd = p ++ pid ++ h
let (lb,rb) = case () of
() | m == waIsViewable -> ("","")
| otherwise -> ("[","]")
o' = if o then "!" else ""
return $ concat [lb
,o'
,"window "
,wx
,t
," ("
," "
,show wid
,',':show ht
,')':if bw == 0 then "" else '+':show bw
,"@("
,'x':show ht
,if bw == 0 then "" else '+':show bw
,"@"
,show x
,',':show y
,')':if null c then "" else ' ':c
,if null c then "" else ' ':c
,if null cmd then "" else ' ':cmd
,rb
]
@@ -86,8 +99,11 @@ getEWMHTitle sub w = do
return $ map (toEnum . fromEnum) t
getICCCMTitle :: Window -> X String
getICCCMTitle w = do
t@(TextProperty t' _ 8 _) <- withDisplay $ \d -> io $ getTextProperty d w wM_NAME
getICCCMTitle w = getDecodedStringProp w wM_NAME
getDecodedStringProp :: Window -> Atom -> X String
getDecodedStringProp w a = do
t@(TextProperty t' _ 8 _) <- withDisplay $ \d -> io $ getTextProperty d w a
[s] <- catchX' (tryUTF8 t) $
catchX' (tryCompound t) $
io ((:[]) `fmap` peekCString t')
@@ -138,3 +154,21 @@ safeGetWindowAttributes d w = alloca $ \p -> do
case s of
0 -> return Nothing
_ -> Just `fmap` peek p
-- and so is getCommand
safeGetCommand :: Display -> Window -> X [String]
safeGetCommand d w = do
wC <- getAtom "WM_COMMAND"
p <- io $ getWindowProperty8 d wC w
case p of
Nothing -> return []
Just cs' -> do
let cs = map (toEnum . fromEnum) cs'
go (a,(s,"\NUL")) = (s:a,("",""))
go (a,(s,'\NUL':ss)) = go (s:a,go' ss)
go r = r -- ???
go' = break (== '\NUL')
in return $ reverse $ fst $ go ([],go' cs)
getMachine :: Window -> X String
getMachine w = catchX' (getAtom "WM_CLIENT_MACHINE" >>= getDecodedStringProp w) (return "")