diff options
| -rw-r--r-- | Main.hs | 2 | ||||
| -rw-r--r-- | Operations.hs | 2 | ||||
| -rw-r--r-- | StackSet.hs | 1 | ||||
| -rw-r--r-- | XMonad.hs | 44 |
4 files changed, 44 insertions, 5 deletions
@@ -94,7 +94,7 @@ main = do , w <- W.integrate (W.stack wk) ] mapM_ manage ws -- find new windows - when logging $ withWindowSet (io . hPrint stdout) + when logging $ withWindowSet (io . putStrLn . serial) -- main loop, for all you HOF/recursion fans out there. forever $ handle =<< io (nextEvent dpy e >> getEvent e) diff --git a/Operations.hs b/Operations.hs index bd85637..0716533 100644 --- a/Operations.hs +++ b/Operations.hs @@ -179,7 +179,7 @@ windows f = do -- urgh : not our delete policy, but close. setTopFocus - when logging $ withWindowSet (io . hPrint stdout) + when logging $ withWindowSet (io . putStrLn . serial) -- io performGC -- really helps, but seems to trigger GC bugs? -- We now go to some effort to compute the minimal set of windows to hide. diff --git a/StackSet.hs b/StackSet.hs index 34e6b10..4b74646 100644 --- a/StackSet.hs +++ b/StackSet.hs @@ -412,4 +412,3 @@ shift n s = if and [n >= 0,n < size s,n /= tag (workspace (current s))] then maybe s go (peek s) else s where go w = foldr ($) s [view (tag (workspace (current s))),insertUp w,view n,delete w] -- ^^ poor man's state monad :-) - @@ -18,11 +18,11 @@ module XMonad ( X, WindowSet, WorkspaceId(..), ScreenId(..), XState(..), XConf(..), Layout(..), Typeable, Message, SomeMessage(..), fromMessage, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, - runX, io, withDisplay, withWindowSet, isRoot, spawn, restart, trace, whenJust, whenX, + runX, io, serial, withDisplay, withWindowSet, isRoot, spawn, restart, trace, whenJust, whenX, atom_WM_STATE ) where -import StackSet (StackSet) +import StackSet import Control.Monad.State import Control.Monad.Reader @@ -32,6 +32,8 @@ import System.Exit import System.Environment import Graphics.X11.Xlib import Data.Typeable +import Data.List (intersperse,sortBy) +import Text.PrettyPrint import qualified Data.Map as M import qualified Data.Set as S @@ -181,3 +183,41 @@ whenX a f = a >>= \b -> when b f -- be found in your .xsession-errors file trace :: String -> X () trace msg = io $! do hPutStrLn stderr msg; hFlush stderr + +-- --------------------------------------------------------------------- +-- Serialise a StackSet in a simple format +-- +-- 4|1:16777220:16777220,2:18874372:18874372,3::,4::,5::,6::,7::,8::,9:: +-- + +infixl 6 <:>, <|> +(<:>), (<|>) :: Doc -> Doc -> Doc +p <:> q = p <> char ':' <> q +p <|> q = p <> char '|' <> q + +serial :: WindowSet -> String +serial = render . ppr + +newtype Windows = Windows [Window] + +class Pretty a where ppr :: a -> Doc + +instance Pretty Window where ppr = text . show + +instance Pretty a => Pretty [a] where + ppr = hcat . intersperse (char ',') . map ppr + +instance Pretty Windows where + ppr (Windows s) = hcat . intersperse (char ';') . map ppr $ s + +instance Pretty WindowSet where + ppr s = int (1 + fromIntegral (tag . workspace . current $ s)) <|> + ppr (sortBy (\a b -> tag a `compare` tag b) + (map workspace (current s : visible s) ++ hidden s)) + +instance Pretty (Workspace WorkspaceId Window) where + ppr (Workspace i s) = + int (1 + fromIntegral i) + <:> (case s of Empty -> empty ; _ -> ppr (focus s)) + <:> ppr (Windows (integrate s)) + |