debug-hooks

Ignore-this: 7f41c93fdd6643c687598d2fe07aad5d
Hooks to print diagnostic information to stderr (usually .xsession-errors)
to help debug complex issues involving the StackSet and received events.

darcs-hash:20120813223821-181ff-63a79101b02b74c351344ae3d2768153a688ec7c.gz

4 files changed, 1489 insertions, 0 deletions

diff --git a/XMonad/Hooks/DebugEvents.hs b/XMonad/Hooks/DebugEvents.hs
new file mode 100644
index 0000000..d58595e
--- /dev/null
+++ b/XMonad/Hooks/DebugEvents.hs
@@ -0,0 +1,1253 @@
+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.DebugEvents
+-- Copyright   :  (c) Brandon S Allbery KF8NH, 2012
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  allbery.b@gmail.com
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Module to dump diagnostic information about X11 events received by
+-- @xmonad@.  This is incomplete due to 'Event' being incomplete and not
+-- providing information about a number of events, and enforcing artificial
+-- constraints on others (for example 'ClientMessage'); the @X11@ package
+-- will require a number of changes to fix these problems.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.DebugEvents (debugEventsHook) where
+
+import           Prelude                              hiding (catch)
+
+import           XMonad                               hiding (windowEvent
+                                                             ,(-->)
+                                                             )
+
+import           XMonad.Hooks.DebugKeyEvents                 (debugKeyEvents)
+import           XMonad.Util.DebugWindow                     (debugWindow)
+
+-- import           Graphics.X11.Xlib.Extras.GetAtomName        (getAtomName)
+
+import           Control.Exception.Extensible
+import           Control.Monad.State
+import           Control.Monad.Reader
+import           Data.Char                                   (isDigit)
+import           Data.List                                   (genericIndex
+                                                             ,genericLength
+                                                             ,unfoldr
+                                                             )
+import           Codec.Binary.UTF8.String
+import           Data.Maybe                                  (fromMaybe)
+import           Data.Monoid
+import           Foreign
+import           Foreign.C.String
+import           Foreign.C.Types
+import           Numeric                                     (showHex)
+import           System.Exit
+import           System.IO
+import           System.Process
+
+-- this should move into X11
+foreign import ccall unsafe "XGetAtomName"
+  xGetAtomName :: Display -> Atom -> IO CString
+
+getAtomName     :: Display -> Atom -> IO (Maybe String)
+getAtomName d a =  do
+  n <- xGetAtomName d a
+  if n == nullPtr
+    then return Nothing
+    else do
+      n' <- peekCString n
+      xFree n
+      return $ Just n'
+
+-- | Event hook to dump all received events.  You should probably not use this
+--   unconditionally; it will produce massive amounts of output.
+debugEventsHook   :: Event -> X All
+debugEventsHook e =  debugEventsHook' e >> return (All True)
+
+-- | Dump an X11 event.  Can't be used directly as a 'handleEventHook'.
+debugEventsHook' :: Event -> X ()
+
+debugEventsHook' (ConfigureRequestEvent {ev_window       = w
+                                        ,ev_parent       = p
+                                        ,ev_x            = x
+                                        ,ev_y            = y
+                                        ,ev_width        = wid
+                                        ,ev_height       = ht
+                                        ,ev_border_width = bw
+                                        ,ev_above        = above
+                                        ,ev_detail       = place
+                                        ,ev_value_mask   = msk
+                                        }) = do
+  windowEvent "ConfigureRequest" w
+  windowEvent "  parent"         p
+--  mask <- quickFormat msk $ dumpBits wmCRMask
+--  say "  requested parameters" $ concat ['(':show wid
+--                                        ,'x':show ht
+--                                        ,')':if bw == 0 then "" else '+':show bw
+--                                        ,'@':'(':show x
+--                                        ,',':show y
+--                                        ,") mask "
+--                                        ,mask
+--                                        ]
+  s <- quickFormat [x,y,wid,ht,bw,fromIntegral above,place] $
+       dumpListByMask' msk [("x"           ,dump32              ,cARDINAL)
+                           ,("y"           ,dump32              ,cARDINAL)
+                           ,("width"       ,dump32              ,cARDINAL)
+                           ,("height"      ,dump32              ,cARDINAL)
+                           ,("border_width",dump32              ,cARDINAL)
+                           ,("sibling"     ,dumpWindow          ,wINDOW  )
+                           ,("detail"      ,dumpEnum wmPlacement,cARDINAL)
+                           ]
+  say "  requested" s
+
+debugEventsHook' (ConfigureEvent        {ev_window = w
+                                        ,ev_above  = above
+                                        }) = do
+  windowEvent "Configure" w
+  -- most of the content is covered by debugWindow
+  when (above /= none) $ debugWindow above >>= say "  above"
+
+debugEventsHook' (MapRequestEvent       {ev_window     = w
+                                        ,ev_parent     = p
+                                        }) =
+  windowEvent "MapRequest" w >>
+  windowEvent "  parent"   p
+
+debugEventsHook' e@(KeyEvent {ev_event_type = t})
+    | t == keyPress =
+  io (hPutStr stderr "KeyPress ") >>
+  debugKeyEvents e >>
+  return ()
+
+debugEventsHook' (ButtonEvent           {ev_window = w
+                                        ,ev_state  = s
+                                        ,ev_button = b
+                                        }) = do
+  windowEvent "Button" w
+  nl <- gets numberlockMask
+  let msk | s == 0    = ""
+          | otherwise = "modifiers " ++ vmask nl s
+  say "  button" $ show b ++ msk
+
+debugEventsHook' (DestroyWindowEvent    {ev_window = w
+                                        }) =
+  windowEvent "DestroyWindow" w
+
+debugEventsHook' (UnmapEvent            {ev_window = w
+                                        }) =
+  windowEvent "Unmap" w
+
+debugEventsHook' (MapNotifyEvent        {ev_window = w
+                                        }) =
+  windowEvent "MapNotify" w
+
+{- way too much output; suppressed.
+
+debugEventsHook' (CrossingEvent         {ev_window    = w
+                                        ,ev_subwindow = s
+                                        }) =
+  windowEvent "Crossing"    w >>
+  windowEvent "  subwindow" s
+-}
+debugEventsHook' (CrossingEvent         {}) =
+  return ()
+
+debugEventsHook' (SelectionRequest      {ev_requestor = rw
+                                        ,ev_owner     = ow
+                                        ,ev_selection = a
+                                        }) =
+  windowEvent "SelectionRequest" rw >>
+  windowEvent "  owner"          ow >>
+  atomEvent   "  atom"           a
+
+debugEventsHook' (PropertyEvent         {ev_window    = w
+                                        ,ev_atom      = a
+                                        ,ev_propstate = s
+                                        }) = do
+  a' <- atomName a
+  -- too many of these, and they're not real useful
+  if a' `elem` ["_NET_WM_USER_TIME"
+--               ,"_NET_WM_WINDOW_OPACITY"
+               ] then return () else do
+  windowEvent "Property on" w
+  s' <- case s of
+          1 -> return "deleted"
+          0 -> dumpProperty a a' w (7 + length a')
+          _ -> error "Illegal propState; Xlib corrupted?"
+  say "  atom" $ a' ++ s'
+
+debugEventsHook' (ExposeEvent           {ev_window = w
+                                        }) =
+  windowEvent "Expose" w
+
+debugEventsHook' (ClientMessageEvent    {ev_window       = w
+                                        ,ev_message_type = a
+                                        -- @@@ they did it again!  no ev_format,
+                                        --     and ev_data is [CInt]
+                                        -- @@@ and get a load of the trainwreck
+                                        --     that is setClientMessageEvent!
+--                                        ,ev_format       = b
+                                        ,ev_data         = vs'
+                                        }) = do
+  windowEvent "ClientMessage on" w
+  n <- atomName a
+  -- this is a sort of custom property
+  -- @@@ this likely won't work as is; type information varies, I think
+  (ta,b,l) <- case lookup n clientMessages of
+                Nothing        -> return (a,32,length vs')
+                Just (ta',b,l) -> do
+                  ta <- getAtom ta'
+                  return (ta,b,l)
+  let wl = bytes b
+  vs <- io $ take (l * wl) `fmap` splitCInt vs'
+  s <- dumpProperty' w a n ta b vs 0 (10 + length n)
+  say "  message" $ n ++ s
+
+debugEventsHook' _                      = return ()
+
+-- | Emit information about an atom.
+atomName   :: Atom -> X String
+atomName a =  withDisplay $ \d ->
+  io $ fromMaybe ("(unknown atom " ++ show a ++ ")") `fmap` getAtomName d a
+
+-- | Emit an atom with respect to the current event.
+atomEvent     :: String -> Atom -> X ()
+atomEvent l a =  atomName a >>= say l
+
+-- | Emit a window with respect to the current event.
+windowEvent     :: String -> Window -> X ()
+windowEvent l w =  debugWindow w >>= say l
+
+-- | Helper to emit tagged event information.
+say     :: String -> String -> X ()
+say l s =  trace $ l ++ ' ':s
+
+-- | Deconstuct a list of 'CInt's into raw bytes
+splitCInt    :: [CInt] -> IO Raw
+splitCInt vs =  io $ withArray vs $ \p ->
+                peekArray (4 * length vs) (castPtr p :: Ptr CUChar)
+
+-- | Specify how to decode some common client messages.
+clientMessages :: [(String,(String,Int,Int))]
+clientMessages =  [("_NET_ACTIVE_WINDOW",("_NET_ACTIVE_WINDOW",32,1))
+                  ,("WM_CHANGE_STATE"   ,("WM_STATE"          ,32,2))
+                  ,("WM_COMMAND"        ,("STRING"            , 8,0))
+                  ,("WM_SAVE_YOURSELF"  ,("STRING"            , 8,0))
+                  ]
+
+-- | Convert a modifier mask into a useful string
+vmask                 :: KeyMask -> KeyMask -> String
+vmask numLockMask msk =  unwords $
+                         reverse $
+                         fst     $
+                         foldr vmask' ([],msk) masks
+    where
+      masks = map (\m -> (m,show m)) [0..toEnum (bitSize msk - 1)] ++
+              [(numLockMask,"num"  )
+              ,(   lockMask,"lock" )
+              ,(controlMask,"ctrl" )
+              ,(  shiftMask,"shift")
+              ,(   mod5Mask,"mod5" )
+              ,(   mod4Mask,"mod4" )
+              ,(   mod3Mask,"mod3" )
+              ,(   mod2Mask,"mod2" )
+              ,(   mod1Mask,"mod1" )
+              ]
+      vmask'   _   a@( _,0)                = a
+      vmask' (m,s)   (ss,v) | v .&. m == m = (s : ss,v .&. complement m)
+      vmask'   _        r                  = r
+
+-- formatting properties.  ick. --
+
+-- @@@ Document the parser.  Someday.
+
+type Raw     = [CUChar]
+
+data Decode = Decode {property :: Atom          -- original property atom
+                     ,pName    :: String        -- its name
+                     ,pType    :: Atom          -- base property type atom
+                     ,width    :: Int           -- declared data width
+                     ,window   :: Window        -- source window
+                     ,indent   :: Int           -- current indent (via local)
+                     ,limit    :: Int           -- line length
+                     }
+
+-- the result accumulates here mainly for the benefit of the indenter
+data DecodeState = DecS {value :: Raw           -- unconsumed raw property value
+                        ,accum :: String        -- output accumulator
+                        ,joint :: String        -- separator when adding to accumulator
+                        }
+
+newtype Decoder a = Decoder (ReaderT Decode (StateT DecodeState X) a)
+#ifndef __HADDOCK__
+    deriving (Functor
+             ,Monad
+             ,MonadIO
+             ,MonadState  DecodeState
+             ,MonadReader Decode
+             )
+#endif
+
+-- | Retrive, parse, and dump a window property.  As all the high-level property
+--   interfaces lose information necessary to decode properties correctly, we 
+--   work at the lowest level available.
+dumpProperty          :: Atom -> String -> Window -> Int -> X String
+dumpProperty a n w i  =  do
+  prop <- withDisplay $ \d ->
+    io     $
+    alloca $ \fmtp ->
+    alloca $ \szp  ->
+    alloca $ \lenp ->
+    alloca $ \ackp ->
+    alloca $ \vsp  -> do
+    rc   <- xGetWindowProperty
+              d
+              w
+              a
+              0
+              maxBound
+              False
+              anyPropertyType
+              fmtp
+              szp
+              lenp
+              ackp
+              vsp
+    case rc of
+      0 -> do
+        fmt <- fromIntegral `fmap` peek fmtp
+        vs' <-                     peek vsp
+        sz  <- fromIntegral `fmap` peek szp
+        case () of
+          () | fmt == none     -> xFree vs' >> return (Left   "(property deleted)"   )
+             | sz < 0          -> xFree vs' >> return (Left $ "(illegal bit size " ++
+                                                              show sz              ++
+                                                              ")"                    )
+             | sz `mod` 8 /= 0 -> xFree vs' >> return (Left $ "(illegal bit size " ++
+                                                              show sz              ++
+                                                              ")"                    )
+             | otherwise       -> do
+                 len <- fromIntegral `fmap` peek lenp
+                 -- that's as in "ack! it's fugged!"
+                 ack <- fromIntegral `fmap` peek ackp
+                 vs <- peekArray (len * bytes sz) vs'
+                 _ <- xFree vs'
+                 return $ Right (fmt,sz,ack,vs)
+      e -> return $ Left $ "getWindowProperty failed: " ++ show e
+  case prop of
+    Left  _               -> return ""
+    Right (fmt,sz,ack,vs) -> dumpProperty' w a n fmt sz vs ack i
+
+-- @@@ am I better off passing in the Decode and DecodeState?
+-- | Parse and dump a property (or a 'ClientMessage').
+dumpProperty'                             :: Window -- source window
+                                          -> Atom   -- property id
+                                          -> String -- property name
+                                          -> Atom   -- property type
+                                          -> Int    -- bit width
+                                          -> Raw    -- raw value
+                                          -> CULong -- size of un-dumped content
+                                          -> Int    -- indent for output formatting
+                                          -> X String
+dumpProperty' w a n fmt sz vs ack i =  do
+  ptn <- atomName fmt
+  let dec  = Decode {property = a
+                    ,pName    = n
+                    ,pType    = fmt
+                    ,width    = sz
+                    ,indent   = i + length ptn + 6
+                    ,window   = w
+                    ,limit    = 96
+                    }
+      dec' = dec    {pType    = cARDINAL
+                    ,width    = 8
+                    }
+      ds   = DecS   {value    = vs
+                    -- @@@ probably should push this outside, since it doesn't
+                    --     make sense for ClientMessage
+                    ,accum    = " (" ++ ptn ++ ") "
+                    ,joint    = "= "
+                    }
+  (_,ds') <- runDecode dec ds $ dumpProp a n
+  let fin = length (value ds')
+      len = length vs
+      lost = if ack == 0 then "" else "and " ++ show ack ++ " lost bytes"
+      unk = case () of
+              () | fin == len -> "undecodeable "
+                 | fin == 0   -> "."
+                 | otherwise  -> "and remainder (" ++ show (len - fin) ++ '/':show len ++ ")"
+  (_,ds'') <- if fin == 0
+              then return (True,ds')
+              else runDecode dec' (withJoint' unk ds' ) $ dumpArray dump8
+  (_,ds''') <- if ack == 0
+               then return (True,ds'')
+               else runDecode dec' (withJoint' " " ds'') $ propSimple lost -- @@@
+  return $ accum ds'''
+
+-- | A simplified version of 'dumpProperty\'', to format random values from
+--   events.
+quickFormat     :: (Storable i, Integral i) => [i] -> Decoder Bool -> X String
+quickFormat v f =  do
+  let vl = length v
+  vs <- io $
+        allocaArray vl $
+        \p -> pokeArray p (map fromIntegral v :: [CULong]) >>
+              peekArray (4 * vl) (castPtr p :: Ptr CUChar)
+  let dec = Decode {property = none
+                   ,pName    = ""
+                   ,pType    = cARDINAL
+                   ,width    = 32
+                   ,indent   = 0
+                   ,window   = none
+                   ,limit    = maxBound
+                   }
+      ds  = DecS   {value    = vs
+                   ,accum    = ""
+                   ,joint    = ""
+                   }
+  (r,ds') <- runDecode dec ds f
+  return $ accum ds' ++ if r then "" else "?"
+
+-- | Launch a decoding parser, returning success and final state.
+runDecode                 :: Decode -> DecodeState -> Decoder Bool -> X (Bool,DecodeState)
+runDecode c s (Decoder p) =  runStateT (runReaderT p c) s
+
+-- Coerce bit size to bytes.
+bytes   :: Int -> Int
+bytes w =  w `div` 8
+
+-- | The top level property decoder, for a wide variety of standard ICCCM and 
+--   EWMH window properties.  We pass part of the 'ReaderT' as arguments for 
+--   pattern matching.
+dumpProp                                              :: Atom -> String -> Decoder Bool
+
+dumpProp _ "CLIPBOARD"                                =  dumpSelection
+dumpProp _ "_NET_SUPPORTED"                           =  dumpArray dumpAtom
+dumpProp _ "_NET_CLIENT_LIST"                         =  dumpArray dumpWindow
+dumpProp _ "_NET_CLIENT_LIST_STACKING"                =  dumpArray dumpWindow
+dumpProp _ "_NET_NUMBER_OF_DESKTOPS"                  =  dump32
+dumpProp _ "_NET_VIRTUAL_ROOTS"                       =  dumpArray dumpWindow
+dumpProp _ "_NET_DESKTOP_GEOMETRY"                    =  dumpArray dump32
+dumpProp _ "_NET_DESKTOP_VIEWPORT"                    =  dumpList [("w",dump32)
+                                                                  ,("h",dump32)
+                                                                  ]
+dumpProp _ "_NET_CURRENT_DESKTOP"                     =  dump32
+dumpProp _ "_NET_DESKTOP_NAMES"                       =  dumpArray dumpUTF
+dumpProp _ "_NET_ACTIVE_WINDOW"                       =  dumpActiveWindow
+dumpProp _ "_NET_WORKAREA"                            =  dumpList [("start"
+                                                                   ,dumpList [("x",dump32)
+                                                                             ,("y",dump32)
+                                                                             ]
+                                                                   )
+                                                                  ,("size"
+                                                                   ,dumpList [("w",dump32)
+                                                                             ,("h",dump32)
+                                                                             ]
+                                                                   )
+                                                                  ]
+dumpProp _ "_NET_SUPPORTING_WM_CHECK"                 =  dumpWindow
+dumpProp _ "_NET_DESKTOP_LAYOUT"                      =  dumpList [("orientation"
+                                                                   ,dumpEnum nwmOrientation
+                                                                   )
+                                                                  ,("size"
+                                                                   ,dumpList [("cols",dump32)
+                                                                             ,("rows",dump32)
+                                                                             ]
+                                                                   )
+                                                                  ,("origin"
+                                                                   ,dumpEnum nwmOrigin
+                                                                   )
+                                                                  ]
+dumpProp _ "_NET_SHOWING_DESKTOP"                     =  dump32
+dumpProp _ "_NET_WM_NAME"                             =  dumpUTF
+dumpProp _ "_NET_WM_VISIBLE_NAME"                     =  dumpUTF
+dumpProp _ "_NET_WM_ICON_NAME"                        =  dumpUTF
+dumpProp _ "_NET_WM_VISIBLE_ICON_NAME"                =  dumpUTF
+dumpProp _ "_NET_WM_DESKTOP"                          =  dumpExcept [(0xFFFFFFFF,"all")]
+                                                                    dump32
+dumpProp _ "_NET_WM_WINDOW_TYPE"                      =  dumpArray dumpAtom
+dumpProp _ "_NET_WM_STATE"                            =  dumpArray dumpAtom
+dumpProp _ "_NET_WM_ALLOWED_ACTIONS"                  =  dumpArray dumpAtom
+dumpProp _ "_NET_WM_STRUT"                            =  dumpList [("left gap"  ,dump32)
+                                                                  ,("right gap" ,dump32)
+                                                                  ,("top gap"   ,dump32)
+                                                                  ,("bottom gap",dump32)
+                                                                  ]
+dumpProp _ "_NET_WM_STRUT_PARTIAL"                    =  dumpList [("left gap"    ,dump32)
+                                                                  ,("right gap"   ,dump32)
+                                                                  ,("top gap"     ,dump32)
+                                                                  ,("bottom gap"  ,dump32)
+                                                                  ,("left start"  ,dump32)
+                                                                  ,("left end"    ,dump32)
+                                                                  ,("right start" ,dump32)
+                                                                  ,("right end"   ,dump32)
+                                                                  ,("top start"   ,dump32)
+                                                                  ,("top end"     ,dump32)
+                                                                  ,("bottom start",dump32)
+                                                                  ,("bottom end"  ,dump32)
+                                                                  ]
+dumpProp _ "_NET_WM_ICON_GEOMETRY"                    =  dumpList [("x",dump32)
+                                                                  ,("y",dump32)
+                                                                  ,("w",dump32)
+                                                                  ,("h",dump32)
+                                                                  ]
+-- no, I'm not going to duplicate xprop *completely*!
+dumpProp _ "_NET_WM_ICON"                             =  propSimple "(icon)"
+dumpProp _ "_NET_WM_PID"                              =  dumpPid
+dumpProp _ "_NET_WM_HANDLED_ICONS"                    =  propSimple "(defined)"
+dumpProp _ "_NET_WM_USER_TIME"                        =  dumpExcept [(0,"do not map initially")]
+                                                                    dumpTime
+dumpProp _ "_NET_FRAME_EXTENTS"                       =  dumpList [("left"  ,dump32)
+                                                                  ,("right" ,dump32)
+                                                                  ,("top"   ,dump32)
+                                                                  ,("bottom",dump32)
+                                                                  ]
+dumpProp _ "_NET_WM_SYNC_REQUEST_COUNTER"             =  dumpExcept [(0,"illegal value 0")]
+                                                                    dump64
+dumpProp _ "_NET_STARTUP_ID"                          =  dumpUTF
+dumpProp _ "WM_PROTOCOLS"                             =  dumpArray dumpAtom
+dumpProp _ "WM_COLORMAP_WINDOWS"                      =  dumpArray dumpWindow
+dumpProp _ "WM_STATE"                                 =  dumpState
+dumpProp _ "WM_LOCALE_NAME"                           =  dumpString
+dumpProp _ "WM_CLIENT_LEADER"                         =  dumpWindow
+dumpProp _ "_NET_WM_WINDOW_OPACITY"                   =  dumpPercent
+dumpProp _ "XdndAware"                                =  dumpArray dumpAtom
+dumpProp _ "_XKLAVIER_TRANSPARENT"                    =  dumpInteger 32
+dumpProp _ "_XKLAVIER_STATE"                          =  dumpList [("state"     ,dumpInteger 32)
+                                                                  ,("indicators",dumpXKlInds)
+                                                                  ]
+dumpProp _ "_MOTIF_DRAG_RECEIVER_INFO"                =  dumpMotifDragReceiver
+dumpProp _ "_OL_WIN_ATTR"                             =  dumpOLAttrs
+dumpProp _ "_OL_DECOR_ADD"                            =  dumpArray dumpAtom
+dumpProp _ "_OL_DECOR_DEL"                            =  dumpArray dumpAtom
+dumpProp _ "_MOTIF_WM_HINTS"                          =  dumpMwmHints
+dumpProp _ "_MOTIF_WM_INFO"                           =  dumpMwmInfo
+dumpProp _ "_XMONAD_DECORATED_BY"                     =  dumpWindow
+dumpProp _ "_XMONAD_DECORATION_FOR"                   =  dumpWindow
+dumpProp a _ | a == wM_NAME                           =  dumpString
+             | a == pRIMARY                           =  dumpSelection
+             | a == sECONDARY                         =  dumpSelection
+               -- this is gross
+             | a == wM_TRANSIENT_FOR                  =  do
+                 root <- fromIntegral `fmap` inX (asks theRoot)
+                 w <- asks window
+                 WMHints {wmh_window_group = group} <-
+                   inX $ asks display >>= io . flip getWMHints w
+                 dumpExcept [(0   ,"window group " ++ show group)
+                            ,(root,"window group " ++ show group)
+                            ]
+                            dumpWindow
+             | a == rESOURCE_MANAGER                  =  dumpString
+             | a == wM_COMMAND                        =  dumpString
+             | a == wM_HINTS                          =  dumpWmHints
+             | a == wM_CLIENT_MACHINE                 =  dumpString
+             | a == wM_ICON_NAME                      =  dumpString
+             | a == wM_ICON_SIZE                      =  dumpList [("min size"
+                                                                   ,dumpList [("w",dump32)
+                                                                             ,("h",dump32)
+                                                                             ]
+                                                                   )
+                                                                  ,("max size"
+                                                                   ,dumpList [("w",dump32)
+                                                                             ,("h",dump32)
+                                                                             ]
+                                                                   )
+                                                                  ,("increment"
+                                                                   ,dumpList [("w",dump32)
+                                                                             ,("h",dump32)
+                                                                             ]
+                                                                   )
+                                                                  ]
+             | a == wM_NORMAL_HINTS                   =  (...)
+             | a == wM_ZOOM_HINTS                     =  (...) -- same as previous
+             | a == rGB_DEFAULT_MAP                   =  (...) -- XStandardColormap
+             | a == rGB_BEST_MAP                      =  (...) -- "
+             | a == rGB_RED_MAP                       =  (...) -- "
+             | a == rGB_GREEN_MAP                     =  (...) -- "
+             | a == rGB_BLUE_MAP                      =  (...) -- "
+             | a == rGB_GRAY_MAP                      =  (...) -- "
+             | a == wM_CLASS                          =  dumpList [("name" ,dumpString)
+                                                                  ,("class",dumpString)
+                                                                  ]
+dumpProp _ s | s `isCountOf` "WM_S"                   =  dumpSelection
+             | s `isCountOf` "_NET_WM_CM_S"           =  dumpSelection
+             | s `isCountOf` "_NET_DESKTOP_LAYOUT_S"  =  dumpSelection
+             | s `isCountOf` "CUT_BUFFER"             =  dumpString
+             -- and dumpProperties does the rest
+             | otherwise                              =  return False
+
+-- lower level decoders --
+
+-- alter the current joint
+withJoint   :: String -> Decoder a -> Decoder a
+withJoint j =  ((modify $ withJoint' j) >>)
+
+withJoint'     :: String -> DecodeState -> DecodeState
+withJoint' j s =  s {joint = j}
+
+-- lift an X into a Decoder
+inX :: X a -> Decoder a
+inX =  Decoder . lift . lift
+
+-- flip isPrefixOf, but the remainder must be all digits
+isCountOf         :: String -> String -> Bool
+-- note that \NUL is safe because atom names have to be C strings
+s `isCountOf` pfx =  null                     $
+                     dropWhile isDigit        $
+                     map fst                  $
+                     dropWhile (uncurry (==)) $
+                     zip s                    $
+                     pfx ++ repeat '\NUL'
+
+-- localize an increased indent
+withIndent   :: Int -> Decoder a -> Decoder a
+withIndent w =  local (\r -> r {indent = indent r + w})
+
+-- dump an array of items.  this dumps the entire property
+dumpArray      :: Decoder Bool -> Decoder Bool
+dumpArray item =  do
+  withIndent 1 $ append "[" >> withJoint "" (dumpArray' item "")
+
+-- step through values as an array, ending on parse error or end of list
+dumpArray'          :: Decoder Bool -> String -> Decoder Bool
+dumpArray' item pfx =  do
+  vs <- gets value
+  if vs == []
+    then append "]"
+    else append pfx >> whenD item (dumpArray' item ",")
+
+-- keep parsing until a parse step fails
+-- @@@ which points out that all my uses of @whenX (return ...)@ are actually 'when',
+--     which suggests that 'whenX' is *also* the same function... yep.  ISAGN
+whenD     :: Monad m => m Bool -> m Bool -> m Bool
+whenD p f =  p >>= \b -> if b then f else return False
+
+-- verify a decoder parameter, else call error reporter
+-- once again, it's more general than I originally wrote
+guardR                  :: (MonadReader r m, Eq v)
+                        => (r -> v)                -- value selector
+                        -> v                       -- expected value
+                        -> (v -> v -> m a)         -- error reporter
+                        -> m a                     -- continuation (hush)
+                        -> m a
+guardR sel val err good =  do
+  v <- asks sel
+  if v == val then good else err v val
+
+-- this is kinda dumb
+fi       :: Bool -> a -> a -> a
+fi p n y =  if p then y else n -- flip (if' p), if that existed
+
+-- verify we have the expected word size
+guardSize      :: Int -> Decoder Bool -> Decoder Bool
+-- see XSync documentation for this insanity
+guardSize 64 =  guardR width 32 propSizeErr . guardSize' 8         propShortErr
+guardSize  w =  guardR width  w propSizeErr . guardSize' (bytes w) propShortErr
+
+guardSize'       :: Int -> Decoder a -> Decoder a -> Decoder a
+guardSize' l n y =  gets value >>= \vs -> fi (length vs >= l) n y
+
+-- verify we have the expected property type
+guardType    :: Atom -> Decoder Bool -> Decoder Bool
+guardType  t =  guardR pType t propTypeErr
+
+-- dump a structure as a named tuple
+dumpList       :: [(String,Decoder Bool)] -> Decoder Bool
+dumpList proto =  do
+  a <- asks pType
+  dumpList'' (maxBound :: CULong) (map (\(s,d) -> (s,d,a)) proto) "("
+
+-- same but elements have their own distinct types
+dumpList'       :: [(String,Decoder Bool,Atom)] -> Decoder Bool
+dumpList' proto =  dumpList'' (maxBound :: CULong) proto "("
+
+-- same but only dump elements identified by provided mask
+dumpListByMask     :: CULong -> [(String,Decoder Bool)] -> Decoder Bool
+dumpListByMask m p =  do
+  a <- asks pType
+  dumpList'' m (map (\(s,d) -> (s,d,a)) p) "("
+
+-- and the previous two combined
+dumpListByMask'     :: CULong -> [(String,Decoder Bool,Atom)] -> Decoder Bool
+dumpListByMask' m p =  dumpList'' m p "("
+
+dumpList''                    :: CULong -> [(String,Decoder Bool,Atom)] -> String -> Decoder Bool
+dumpList'' _ []           _   =  append ")" >> return True
+dumpList'' 0 _            _   =  append ")" >> return True
+dumpList'' m ((l,p,t):ps) sep = do
+  (e,sep') <- if m .&. 1 == 0
+              then do
+                -- @@@ ew
+                st <- get
+                e <- local (\r -> r {pType = t}) p
+                v' <- gets value
+                put $ st {value = v'}
+                return (e,sep)
+              else do
+                let label = sep ++ l ++ " = "
+                append label
+                e <- withJoint "" $ do
+                       local (\r -> r {pType  = t
+                                      ,indent = indent r + length label
+                                      })
+                             p
+                return (e,",")
+  if e then dumpList'' (m `shiftR` 1) ps sep' else return e
+
+-- do the getTextProperty dance, the hard way.
+-- @@@ @COMPOUND_TEXT@ not supported yet.
+dumpString :: Decoder Bool
+dumpString =  do
+  fmt <- asks pType
+  [cOMPOUND_TEXT,uTF8_STRING] <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]
+  case () of
+    () | fmt == cOMPOUND_TEXT -> guardSize 16 (...)
+       | fmt == sTRING        -> guardSize  8 $ do
+                                   vs <- gets value
+                                   modify (\r -> r {value = []})
+                                   let ss = flip unfoldr (map twiddle vs) $
+                                            \s -> if null s
+                                                  then Nothing
+                                                  else let (w,s'') = break (== '\NUL') s
+                                                           s'      = if null s''
+                                                                     then s''
+                                                                     else tail s''
+                                                        in Just (w,s')
+                                   case ss of
+                                     [s] -> append $ show s
+                                     ss' -> let go (s:ss'') c = append c        >>
+                                                                append (show s) >>
+                                                                go ss'' ","
+                                                go []       _ = append "]"
+                                             in append "[" >> go ss' ""
+       | fmt == uTF8_STRING   -> dumpUTF -- duplicate type test instead of code :)
+       | otherwise            -> (inX $ atomName fmt) >>=
+                                 failure . ("unrecognized string type " ++)
+
+-- show who owns a selection
+dumpSelection :: Decoder Bool
+dumpSelection =  do
+  -- system selections contain a window ID; others are random
+  -- note that the window ID will be the same as the owner, so
+  -- we don't really care anyway.  we *do* want the selection owner
+  a <- asks property
+  owner <- inX $ withDisplay $ \d -> io $ xGetSelectionOwner d a
+  if owner == none
+    then append "unowned"
+    else do
+      w <- inX $ debugWindow owner
+      append $ "owned by " ++ w
+
+-- for now, not querying Xkb
+dumpXKlInds :: Decoder Bool
+dumpXKlInds =  guardType iNTEGER $ do
+                 n <- fmap fromIntegral `fmap` getInt' 32
+                 case n of
+                   Nothing -> propShortErr
+                   Just is -> append $ "indicators " ++ unwords (dumpInds is 1 1 [])
+  where
+    dumpInds                               :: Word32 -> Word32 -> Int -> [String] -> [String]
+    dumpInds n bt c bs | n == 0 && c == 1 =  ["none"]
+                       | n == 0           =  bs
+                       | n .&. bt /= 0    =  dumpInds (n .&. complement bt)
+                                                      (bt `shiftL` 1)
+                                                      (c + 1)
+                                                      ((show c):bs)
+                       | otherwise        =  dumpInds n
+                                                      (bt `shiftL` 1)
+                                                      (c + 1)
+                                                      bs
+
+-- decode an Atom
+dumpAtom :: Decoder Bool
+dumpAtom =
+  guardType aTOM $ do
+  a <- getInt' 32
+  case a of
+    Nothing -> return False
+    Just a' -> do
+           an <- inX $ atomName $ fromIntegral a'
+           append an
+
+dumpWindow :: Decoder Bool
+dumpWindow =  guardSize 32 $ guardType wINDOW $ do
+                w <- getInt' 32
+                case w of
+                  Nothing -> return False
+                  Just w' -> inX (debugWindow (fromIntegral w')) >>= append
+
+-- a bit of a hack; as a Property it's a wINDOW, as a ClientMessage it's a list
+dumpActiveWindow :: Decoder Bool
+dumpActiveWindow =  guardSize 32 $ do
+                      t <- asks pType
+                      nAW <- inX $ getAtom "_NET_ACTIVE_WINDOW"
+                      case () of
+                        () | t == wINDOW -> dumpWindow
+                           | t == nAW    -> dumpList' [("source"       ,dumpEnum awSource,cARDINAL)
+                                                      ,("timestamp"    ,dumpTime         ,cARDINAL)
+                                                      ,("active window",dumpWindow       ,wINDOW  )
+                                                      ]
+                        _                -> do
+                                     t' <- inX $ atomName t
+                                     failure $ concat ["(bad type "
+                                                      ,t'
+                                                      ,"; expected WINDOW or _NET_ACTIVE_WINDOW"
+                                                      ]
+-- dump a generic CARDINAL value
+dumpInt   :: Int -> Decoder Bool
+dumpInt w =  guardSize w $ guardType cARDINAL $ getInt w show
+
+-- INTEGER is the signed version of CARDINAL
+dumpInteger   :: Int -> Decoder Bool
+dumpInteger w =  guardSize w $ guardType iNTEGER $ getInt w (show . signed w)
+
+-- reinterpret an unsigned as a signed
+signed     :: Int -> Integer -> Integer
+signed w i =  bit (w + 1) - i
+
+-- and wrappers to keep the parse list in bounds
+dump64 :: Decoder Bool
+dump64 =  dumpInt 64
+
+dump32 :: Decoder Bool
+dump32 =  dumpInt 32
+
+{- not used in standard properties
+dump16 :: Decoder Bool
+dump16 =  dumpInt 16
+-}
+
+dump8 :: Decoder Bool
+dump8 =  dumpInt 8
+
+-- I am assuming for the moment that this is a single string.
+-- This might be false; consider the way the STRING properties
+-- handle lists.
+dumpUTF :: Decoder Bool
+dumpUTF =  do
+  uTF8_STRING <- inX $ getAtom "UTF8_STRING"
+  guardType uTF8_STRING $ guardSize 8 $ do
+  s <- gets value
+  modify (\r -> r {value = []})
+  append . show . decode . map fromIntegral $ s
+  return True
+
+-- dump an enumerated value using a translation table
+dumpEnum'        :: [String] -> Atom -> Decoder Bool
+dumpEnum' ss fmt =  guardType fmt $
+                    getInt 32     $
+                    \r -> case () of
+                            () | r < 0                 -> "undefined value " ++ show r
+                               | r >= genericLength ss -> "undefined value " ++ show r
+                               | otherwise             -> genericIndex ss r
+
+-- we do not, unlike @xev@, try to ascii-art pixmaps.
+dumpPixmap :: Decoder Bool
+dumpPixmap =  guardType pIXMAP $ do
+                p' <- getInt' 32
+                case p' of
+                  Nothing -> return False
+                  Just p  -> do
+                    append $ "pixmap " ++ showHex p ""
+                    g' <- inX $ withDisplay $ \d -> io $
+                            Just `fmap` getGeometry d (fromIntegral p)
+                            `catch`
+                            \e -> case fromException e of
+                                    Just x -> throw e `const` (x `asTypeOf` ExitSuccess)
+                                    _      -> return Nothing
+                    case g' of
+                      Nothing                   -> append " (deleted)"
+                      Just (_,x,y,wid,ht,bw,dp) ->
+                          append $ concat
+                                     [" ("
+                                     ,show wid
+                                     ,'x':show ht
+                                     ,'x':show dp
+                                     ,')':if bw == 0 then "" else '+':show bw
+                                     ,"@("
+                                     ,show x
+                                     ,',':show y
+                                     ,")"
+                                     ]
+
+dumpOLAttrs :: Decoder Bool
+dumpOLAttrs = do
+  pt <- inX $ getAtom "_OL_WIN_ATTR"
+  guardType pt $ do
+    msk <- getInt' 32
+    case msk of
+      Nothing   -> propShortErr
+      Just msk' -> dumpListByMask (fromIntegral msk') [("window type" ,dumpAtom     )
+                                                      ,("menu"        ,dump32       ) -- @@@ unk
+                                                      ,("pushpin"     ,dumpEnum bool)
+                                                      ,("limited menu",dump32       ) -- @@@ unk
+                                                      ]
+
+dumpMwmHints :: Decoder Bool
+dumpMwmHints =  do
+  ta <- asks property
+  guardType ta $ do
+    msk <- getInt' 32
+    case msk of
+      Nothing   -> propShortErr
+      Just msk' -> dumpListByMask (fromIntegral msk') [("functions"  ,dumpBits mwmFuncs    )
+                                                      ,("decorations",dumpBits mwmDecos    )
+                                                      ,("input mode" ,dumpEnum mwmInputMode)
+                                                      ,("status"     ,dumpBits mwmState    )
+                                                      ]
+
+dumpMwmInfo :: Decoder Bool
+dumpMwmInfo =  do
+  ta <- asks property
+  guardType ta $ dumpList' [("flags" ,dumpBits mwmHints,cARDINAL)
+                           ,("window",dumpWindow       ,wINDOW  )
+                           ]
+             
+-- the most common case
+dumpEnum    :: [String] -> Decoder Bool
+dumpEnum ss =  dumpEnum' ss cARDINAL
+
+-- implement exceptional cases atop a normal dumper
+-- @@@ there's gotta be a better way
+dumpExcept           :: [(Integer,String)] -> Decoder Bool -> Decoder Bool
+dumpExcept xs item = do
+  -- this horror brought to you by reparsing to get the right value for our use
+  sp <- get
+  rc <- item
+  if not rc then return False else do
+    that <- get -- if none match then we just restore the value parse
+    vs <- gets value
+    let w = (length (value sp) - length vs) * 8
+    -- now we get to reparse again so we get our copy of it
+    put sp
+    Just v <- getInt' w
+    -- and after all that, we can process the exception list
+    dumpExcept' xs that v
+
+dumpExcept'                                      :: [(Integer,String)]
+                                                 -> DecodeState
+                                                 -> Integer
+                                                 -> Decoder Bool
+dumpExcept' []             that _                =  put that >> return True
+dumpExcept' ((exc,str):xs) that val | exc == val =  append str
+                                    | otherwise  =  dumpExcept' xs that val
+
+-- use @ps@ to get process information.
+-- @@@@ assumes a POSIX @ps@, not a BSDish one.
+dumpPid :: Decoder Bool
+dumpPid =  guardType cARDINAL $ do
+             n <- getInt' 32
+             case n of
+               Nothing   -> return False
+               Just pid' -> do
+                      let pid = show pid'
+                          ps  = (proc "/bin/ps" ["-fp" ++ pid]) {std_out = CreatePipe}
+                      (_,o,_,_) <- io $ createProcess ps
+                      case o of
+                        Nothing -> append $ "pid " ++ pid
+                        Just p' -> do
+                                  prc <- io $ lines `fmap` hGetContents p'
+                                  -- deliberately forcing it
+                                  append $ if length prc < 2
+                                           then "pid " ++ pid
+                                           else prc !! 1
+
+dumpTime :: Decoder Bool
+dumpTime =  append "server event # " >> dump32
+
+dumpState :: Decoder Bool
+dumpState =  do
+  wM_STATE <- inX $ getAtom "WM_STATE"
+  guardType wM_STATE $ dumpList' [("state"      ,dumpEnum wmState,cARDINAL)
+                                 ,("icon window",dumpWindow      ,wINDOW  )
+                                 ]
+
+dumpMotifDragReceiver :: Decoder Bool
+dumpMotifDragReceiver =  do
+  ta <- inX $ getAtom "_MOTIF_DRAG_RECEIVER_INFO"
+  guardType ta $ dumpList' [("endian"    ,dumpMotifEndian,cARDINAL)
+                           ,("version"   ,dump8          ,cARDINAL)
+                           ,("style"     ,dumpMDropStyle ,cARDINAL) -- @@@ dummy
+                           ]
+
+dumpMDropStyle :: Decoder Bool
+dumpMDropStyle =  do
+  d <- getInt' 8
+  pad 1 $ case d of
+            Nothing             -> propShortErr
+            Just ps | ps == 0   -> pad 12 $ append "none"
+                    | ps == 1   -> pad 12 $ append "drop only"
+                    | ps == 2   ->          append "prefer preregister " >> dumpMDPrereg
+                    | ps == 3   ->          append "preregister "        >> dumpMDPrereg
+                    | ps == 4   -> pad 12 $ append "prefer dynamic"
+                    | ps == 5   -> pad 12 $ append "dynamic"
+                    | ps == 6   -> pad 12 $ append "prefer receiver"
+                    | otherwise -> failure $ "unknown drop style " ++ show ps
+
+dumpMDPrereg :: Decoder Bool
+dumpMDPrereg =  do
+  -- this is a bit ugly; we pretend to be extending the above dumpList'
+  append ","
+  append "proxy window = "
+  withIndent 15 dumpWindow
+  append ","
+  append "drop sites = "
+  dsc' <- getInt' 16
+  case dsc' of
+    Nothing  -> propShortErr
+    Just dsc -> do
+      withIndent 13 $ append (show dsc)
+      pad 2 $ do
+        append ","
+        append "total size = "
+        withIndent 13 dump32
+        dumpMDBlocks $ fromIntegral dsc
+    
+dumpMDBlocks   :: Int -> Decoder Bool
+dumpMDBlocks _ =  propSimple "(drop site info)" -- @@@ maybe later if needed
+
+dumpMotifEndian :: Decoder Bool
+dumpMotifEndian =  guardType cARDINAL $ guardSize 8 $ do
+  c <- map twiddle `fmap` eat 1
+  case c of
+    ['l'] -> append "little"
+    ['B'] -> append "big"
+    _     -> failure "bad endian flag"
+
+pad     :: Int -> Decoder Bool -> Decoder Bool
+pad n p =  do
+  vs <- gets value
+  if length vs < n
+    then propShortErr
+    else modify (\r -> r {value = drop n vs}) >> p
+
+dumpPercent :: Decoder Bool
+dumpPercent =  guardType cARDINAL $ do
+                 n <- getInt' 32
+                 case n of
+                   Nothing -> return False
+                   Just n' -> 
+                       let pct = 100 * fromIntegral n' / fromIntegral (maxBound :: Word32)
+                        in append $ show (round pct) ++ "%"
+
+dumpWmHints :: Decoder Bool
+dumpWmHints =
+  guardType wM_HINTS $ do
+  msk <- getInt' 32
+  case msk of
+    Nothing   -> return False
+    Just msk' -> dumpListByMask' (fromIntegral msk')
+                                 [("input"        ,dumpEnum bool   ,cARDINAL)
+                                 ,("initial_state",dumpEnum wmState,cARDINAL)
+                                 ,("icon_pixmap"  ,dumpPixmap      ,pIXMAP  )
+                                 ,("icon_window"  ,dumpWindow      ,wINDOW  )
+                                 ,("icon_x"       ,dump32          ,cARDINAL)
+                                 ,("icon_y"       ,dump32          ,cARDINAL)
+                                 ,("icon_mask"    ,dumpPixmap      ,pIXMAP  )
+                                 ,("window_group" ,dumpWindow      ,wINDOW  )
+                                 ]
+
+dumpBits    :: [String] -> Decoder Bool
+dumpBits bs =  guardType cARDINAL $ do
+                 n <- getInt' 32
+                 case n of
+                   Nothing -> return False
+                   Just n' -> dumpBits' bs 1 (fromIntegral n') ""
+
+dumpBits' :: [String] -> Int -> Int -> String -> Decoder Bool
+dumpBits' []     _ n p = if n == 0 then return True else append (p ++ show n)
+dumpBits' (s:ss) b n p = do
+  p' <- if n .&. b /= 0
+        then append (p ++ s) >> return "|"
+        else return p
+  dumpBits' ss (b `shiftL` 1) (n .&. complement b) p'
+
+-- enum definitions --
+
+mwmFuncs :: [String]
+mwmFuncs =  ["all except"
+            ,"resize"
+            ,"move"
+            ,"minimize"
+            ,"maximize"
+            ,"close"
+            ]
+
+mwmDecos :: [String]
+mwmDecos =  ["all except"
+            ,"border"
+            ,"resize handle"
+            ,"title"
+            ,"menu button"
+            ,"maximize button"
+            ,"minimize button"
+            ]
+
+mwmInputMode :: [String]
+mwmInputMode =  ["modeless"
+                ,"application modal"
+                ,"system model"
+                ,"full application modal"
+                ]
+
+mwmState :: [String]
+mwmState =  ["tearoff window"
+            ]
+
+mwmHints :: [String]
+mwmHints =  ["standard startup"
+            ,"custom startup"
+            ]
+
+awSource :: [String]
+awSource =  ["unspecified"
+            ,"application"
+            ,"pager/task list"
+            ]
+
+{- eventually...
+wmHintsFlags :: [String]
+wmHintsFlags =  ["Input"
+                ,"State"
+                ,"IconPixmap"
+                ,"IconWindow"
+                ,"IconX"
+                ,"IconY"
+                ,"IconMask"
+                ,"WindowGroup"
+                ]
+
+wmCRMask :: [String]
+wmCRMask =  ["X"
+            ,"Y"
+            ,"Width"
+            ,"Height"
+            ,"BorderWidth"
+            ,"Sibling"
+            ,"StackMode"
+            ]
+-}
+
+wmPlacement :: [String]
+wmPlacement =  ["Above"
+               ,"Below"
+               ,"TopIf"
+               ,"BottomIf"
+               ,"Opposite"
+               ]
+
+bool :: [String]
+bool =  ["False","True"]
+
+nwmOrientation :: [String]
+nwmOrientation =  nwmEnum (Just "ORIENTATION") ["HORZ","VERT"]
+
+nwmOrigin :: [String]
+nwmOrigin =  nwmEnum Nothing ["TOPLEFT","TOPRIGHT","BOTTOMRIGHT","BOTTOMLEFT"]
+
+wmState :: [String]
+wmState =  ["Withdrawn","Normal","Zoomed (obsolete)","Iconified","Inactive"]
+
+nwmEnum                  :: Maybe String
+                         -> [String]
+                         -> [String]
+nwmEnum Nothing       vs =  map ( "_NET_WM_"                   ++) vs
+nwmEnum (Just prefix) vs =  map (("_NET_WM_" ++ prefix ++ "_") ++) vs
+
+-- and the lowest level coercions --
+
+-- parse and return an integral value
+getInt'    :: Int -> Decoder (Maybe Integer)
+-- see XSync documentation for this insanity
+getInt' 64 =  guardR width 32 (\a e -> propSizeErr a e >> return Nothing) $
+              guardSize' 8 (propShortErr >> return Nothing) $ do
+                lo <- inhale 32
+                hi <- inhale 32
+                return $ Just $ lo + hi * (fromIntegral (maxBound :: Word32) + 1)
+getInt' w  =  guardR width w  (\a e -> propSizeErr a e >> return Nothing) $
+              guardSize' (bytes w) (propShortErr >> return Nothing)       $
+              Just `fmap` inhale w
+
+-- parse an integral value and feed it to a show-er of some kind
+getInt     :: Int -> (Integer -> String) -> Decoder Bool
+getInt w f =  getInt' w >>= maybe (return False) (append . f)
+
+-- bottommost level:  parse an integral value out of the stream.
+-- Not much in the way of error checking; it is assumed you used
+-- the appropriate guards.
+-- @@@@@@@@@ evil beyond evil.  there *has* to be a better way
+inhale    :: Int -> Decoder Integer
+inhale  8 =  do
+               [b] <- eat 1
+               return $ fromIntegral b
+inhale 16 =  do
+               [b0,b1] <- eat 2
+               io $ allocaArray 2 $ \p -> do
+                 pokeArray p [b0,b1]
+                 [v] <- peekArray 1 (castPtr p :: Ptr Word16)
+                 return $ fromIntegral v
+inhale 32 =  do
+               [b0,b1,b2,b3] <- eat 4
+               io $ allocaArray 4 $ \p -> do
+                 pokeArray p [b0,b1,b2,b3]
+                 [v] <- peekArray 1 (castPtr p :: Ptr Word32)
+                 return $ fromIntegral v
+inhale  b =  error $ "inhale " ++ show b
+
+eat   :: Int -> Decoder Raw
+eat n =  do
+  (bs,rest) <- splitAt n `fmap` gets value
+  modify (\r -> r {value = rest})
+  return bs
+
+-- actually do formatting type stuffs
+-- sorta stubbed for the moment
+-- eventually we should do indentation foo here
+append :: String -> Decoder Bool
+append =  append' True
+
+-- and the same but for errors
+failure :: String -> Decoder Bool
+failure =  append' False
+
+-- common appender
+append'     :: Bool -> String -> Decoder Bool
+append' b s =  do
+  j <- gets joint
+  modify (\r -> r {accum = accum r ++ j ++ s})
+  return b
+
+-- consume all and output a constant string
+propSimple   :: String -> Decoder Bool
+propSimple s =  modify (\r -> r {value = []}) >> append s
+
+-- report various errors
+propShortErr :: Decoder Bool
+propShortErr =  failure "(property ended prematurely)"
+
+propSizeErr     :: Int -> Int -> Decoder Bool
+propSizeErr e a =  failure $ "(bad bit width " ++
+                             show a            ++
+                             "; expected "     ++
+                             show e            ++
+                             ")"
+
+propTypeErr     :: Atom -> Atom -> Decoder Bool
+propTypeErr a e =  do
+  e' <- inX $ atomName e
+  a' <- inX $ atomName a
+  failure $ "(bad type " ++ a' ++"; expected " ++ e' ++ ")"
+
+-- for stubs
+(...) :: Decoder Bool
+(...) =  do
+  fmt <- asks pType >>= inX . atomName
+  propSimple $ "(unimplemented type " ++ fmt ++ ")"
+
+-- you like fi, I like this
+twiddle :: (Enum a, Enum b) => a -> b
+twiddle =  toEnum . fromEnum
diff --git a/XMonad/Hooks/DebugStack.hs b/XMonad/Hooks/DebugStack.hs
new file mode 100644
index 0000000..a07495d
--- /dev/null
+++ b/XMonad/Hooks/DebugStack.hs
@@ -0,0 +1,93 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.DebugStack
+-- Copyright   :  (c) Brandon S Allbery KF8NH, 2012
+-- 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
+-- also provided.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.DebugStack (debugStack
+                               ,debugStackString
+                               ,debugStackLogHook
+                               ,debugStackEventHook
+                               ) where
+
+import           XMonad.Core
+import qualified XMonad.StackSet         as W
+
+import           XMonad.Util.DebugWindow
+
+import           Graphics.X11.Types                  (Window)
+import           Graphics.X11.Xlib.Extras            (Event)
+
+import           Control.Monad                       (foldM)
+import           Data.Map                            (toList)
+import           Data.Monoid                         (All(..))
+
+-- | 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.
+debugStack :: X ()
+debugStack =  debugStackString >>= trace
+
+-- | The above packaged as a 'logHook'.  (Currently this is identical.)
+debugStackLogHook :: X ()
+debugStackLogHook =  debugStack
+
+-- | The above 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"
+
+    emit' :: (String,String,String,Maybe Window,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
diff --git a/XMonad/Util/DebugWindow.hs b/XMonad/Util/DebugWindow.hs
new file mode 100644
index 0000000..413f700
--- /dev/null
+++ b/XMonad/Util/DebugWindow.hs
@@ -0,0 +1,140 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.DebugWindow
+-- Copyright   :  (c) Brandon S Allbery KF8NH, 2012
+-- 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 
+-- "XMonad.Hooks.DebugEvents" and "XMonad.Hooks.DebugStack" for practical uses.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Util.DebugWindow (debugWindow) where
+
+import           Prelude                  hiding (catch)
+
+import           XMonad
+
+import           Codec.Binary.UTF8.String        (decodeString)
+import           Control.Exception
+import           Control.Monad                   (when)
+import           Data.List                       (unfoldr
+                                                 ,intercalate
+                                                 )
+import           Foreign
+import           Foreign.C.String
+import           Numeric                         (showHex)
+import           System.Exit
+
+-- | Output a window by ID in hex, decimal, its ICCCM resource name and class,
+--   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 w =  do
+  let wx = pad 8 '0' $ showHex w ""
+  w' <- withDisplay $ \d -> io (safeGetWindowAttributes d w)
+  case w' of
+    Nothing                                   ->
+      return $ "(deleted window " ++ wx ++ ")"
+    Just (WindowAttributes x y wid ht bw m o) -> do
+      c' <- withDisplay $ \d ->
+            io (getWindowProperty8 d wM_CLASS w)
+      let c = case c' of
+                Nothing -> ""
+                Just c''  -> intercalate "/" $
+                             flip unfoldr (map (toEnum . fromEnum) c'') $
+                             \s -> if null s
+                                     then Nothing
+                                     else let (w'',s'') = break (== '\NUL') s
+                                              s'      = if null s''
+                                                          then s''
+                                                          else tail s''
+                                          in Just (w'',s')
+      t <- catchX' (wrap `fmap` getEWMHTitle  "VISIBLE" w) $
+           catchX' (wrap `fmap` getEWMHTitle  ""        w) $
+           catchX' (wrap `fmap` getICCCMTitle           w) $
+           return ""
+      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
+                      ,"@("
+                      ,show x
+                      ,',':show y
+                      ,')':if null c then "" else ' ':c
+                      ,rb
+                      ]
+
+getEWMHTitle       :: String -> Window -> X String
+getEWMHTitle sub w =  do
+  a <- getAtom $ "_NET_WM_" ++ (if null sub then "" else '_':sub) ++ "_NAME"
+  (Just t) <- withDisplay $ \d -> io $ getWindowProperty32 d a w
+  return $ map (toEnum . fromEnum) t
+
+getICCCMTitle   :: Window -> X String
+getICCCMTitle w =  do
+  t@(TextProperty t' _ 8 _) <- withDisplay $ \d -> io $ getTextProperty d w wM_NAME
+  [s] <- catchX' (tryUTF8     t) $
+         catchX' (tryCompound t) $
+         io ((:[]) `fmap` peekCString t')
+  return s
+
+tryUTF8                          :: TextProperty -> X [String]
+tryUTF8 (TextProperty s enc _ _) =  do
+  uTF8_STRING <- getAtom "UTF8_STRING"
+  when (enc == uTF8_STRING) $ error "String is not UTF8_STRING"
+  (map decodeString . splitNul) `fmap` io (peekCString s)
+
+tryCompound                            :: TextProperty -> X [String]
+tryCompound t@(TextProperty _ enc _ _) =  do
+  cOMPOUND_TEXT <- getAtom "COMPOUND_TEXT"
+  when (enc == cOMPOUND_TEXT) $ error "String is not COMPOUND_TEXT"
+  withDisplay $ \d -> io $ wcTextPropertyToTextList d t
+
+splitNul    :: String -> [String]
+splitNul "" =  []
+splitNul s  =  let (s',ss') = break (== '\NUL') s in s' : splitNul ss'
+
+pad       :: Int -> Char -> String -> String
+pad w c s =  replicate (w - length s) c ++ s
+
+-- modified 'catchX' without the print to 'stderr'
+catchX' :: X a -> X a -> X a
+catchX' job errcase = do
+  st <- get
+  c <- ask
+  (a, s') <- io $ runX c st job `catch` \e -> case fromException e of
+    Just x -> throw e `const` (x `asTypeOf` ExitSuccess)
+    _ -> runX c st errcase
+  put s'
+  return a
+
+wrap   :: String -> String
+wrap s =  ' ' : '"' : wrap' s ++ "\""
+  where
+    wrap' (s':ss) | s' == '"'  = '\\' : s' : wrap' ss
+                  | s' == '\\' = '\\' : s' : wrap' ss
+                  | otherwise  =        s' : wrap' ss
+    wrap' ""                   =             ""
+
+-- Graphics.X11.Extras.getWindowAttributes is bugggggggy
+safeGetWindowAttributes     :: Display -> Window -> IO (Maybe WindowAttributes)
+safeGetWindowAttributes d w =  alloca $ \p -> do
+  s <- xGetWindowAttributes d w p
+  case s of
+    0 -> return Nothing
+    _ -> Just `fmap` peek p
diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal
index 4a63491..e79cb62 100644
--- a/xmonad-contrib.cabal
+++ b/xmonad-contrib.cabal
@@ -145,10 +145,12 @@ library
                         XMonad.Config.Sjanssen
                         XMonad.Config.Xfce
                         XMonad.Hooks.CurrentWorkspaceOnTop
+                        XMonad.Hooks.DebugEvents
                         XMonad.Hooks.DebugKeyEvents
                         XMonad.Hooks.DynamicBars
                         XMonad.Hooks.DynamicHooks
                         XMonad.Hooks.DynamicLog
+                        XMonad.Hooks.DebugStack
                         XMonad.Hooks.EwmhDesktops
                         XMonad.Hooks.FadeInactive
                         XMonad.Hooks.FadeWindows
@@ -273,6 +275,7 @@ library
                         XMonad.Prompt.XMonad
                         XMonad.Util.Cursor
                         XMonad.Util.CustomKeys
+                        XMonad.Util.DebugWindow
                         XMonad.Util.Dmenu
                         XMonad.Util.Dzen
                         XMonad.Util.ExtensibleState