From c2218350dfd21f60707e34eb1db112a0ae2ba548 Mon Sep 17 00:00:00 2001
From: "allbery.b" <allbery.b@gmail.com>
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/Util/DebugWindow.hs | 58 ++++++++++++++++++++++++++++++++++++----------
 1 file changed, 46 insertions(+), 12 deletions(-)

(limited to 'XMonad/Util')

diff --git a/XMonad/Util/DebugWindow.hs b/XMonad/Util/DebugWindow.hs
index 9fe5817..d4f5138 100644
--- a/XMonad/Util/DebugWindow.hs
+++ b/XMonad/Util/DebugWindow.hs
@@ -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 "")
-- 
cgit v1.2.3