mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 11:30:22 -07:00
ec0fb3ba8a
Various fixes and enhancements to DebugWindow and DebugStack. ManageDebug requires these fixes, but some of them are significant even if not using ManageDebug.
111 lines
4.3 KiB
Haskell
111 lines
4.3 KiB
Haskell
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonad.Hooks.DebugStack
|
|
-- 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
|
|
-- 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 XMonad.Util.DebugWindow
|
|
|
|
import Graphics.X11.Types (Window)
|
|
import Graphics.X11.Xlib.Extras (Event)
|
|
|
|
import Control.Monad (foldM)
|
|
import Data.Map (member)
|
|
import Data.Monoid (All(..))
|
|
import Data.List (intercalate)
|
|
|
|
-- | 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
|
|
|
|
-- | 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
|
|
|
|
-- | '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)
|
|
|
|
-- | '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'.
|
|
-- @
|
|
-- 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 (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)
|