twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-16 04:33: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

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 "")