From c29c5cde24675e152e0cff754b32db7b2b59bfa0 Mon Sep 17 00:00:00 2001
From: Don Stewart <dons@cse.unsw.edu.au>
Date: Sat, 9 Jun 2007 15:17:16 +0200
Subject: HEADS UP: (logging format change). use a custom pretty printer, for
an easier format to parse, than 'show' produces
darcs-hash:20070609131716-9c5c1-ac6b3d7e8193b16ca9ae65f32d5373090107eca1.gz
---
Main.hs | 2 +-
Operations.hs | 2 +-
StackSet.hs | 1 -
XMonad.hs | 44 ++++++++++++++++++++++++++++++++++++++++++--
4 files changed, 44 insertions(+), 5 deletions(-)
diff --git a/Main.hs b/Main.hs
index de1b979..aaa4970 100644
--- a/Main.hs
+++ b/Main.hs
@@ -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 :-)
-
diff --git a/XMonad.hs b/XMonad.hs
index 01d4199..058da37 100644
--- a/XMonad.hs
+++ b/XMonad.hs
@@ -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))
+
--
cgit v1.2.3