Move state logging into Config.hs, via logHook :: X ()

darcs-hash:20070610061932-9c5c1-9a08992ef555f086007474e64d5ae9d835e9677e

5 files changed, 14 insertions, 57 deletions

diff --git a/Config.hs b/Config.hs
index b420418..f81eac3 100644
--- a/Config.hs
+++ b/Config.hs
@@ -100,11 +100,13 @@ defaultLayouts = [ tiled , mirror tiled , full ]
      delta   = 3%100
 
 --
--- Enable logging of state changes to stdout.
--- The internal state of the window manager is 'shown' in Haskell data format
+-- Perform an arbitrary action on each state change.
+-- Examples include:
+--      * do nothing
+--      * log the state to stdout
 --
-logging :: Bool
-logging = False
+logHook :: X ()
+logHook = return ()
 
 --
 -- The key bindings list.
diff --git a/Config.hs-boot b/Config.hs-boot
index 85b4339..8a04d59 100644
--- a/Config.hs-boot
+++ b/Config.hs-boot
@@ -1,6 +1,7 @@
 module Config where
 import Graphics.X11.Xlib.Types (Dimension)
 import Graphics.X11.Xlib (KeyMask)
+import XMonad
 borderWidth :: Dimension
-logging     :: Bool
+logHook     :: X ()
 numlockMask :: KeyMask
diff --git a/Main.hs b/Main.hs
index aaa4970..d06671d 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 . putStrLn . serial)
+            logHook
 
             -- 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 47e3595..55cc0d4 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -16,7 +16,7 @@ module Operations where
 
 import XMonad
 import qualified StackSet as W
-import {-# SOURCE #-} Config (borderWidth,logging,numlockMask)
+import {-# SOURCE #-} Config (borderWidth,logHook,numlockMask)
 
 import Data.Maybe
 import Data.List            (genericIndex, intersectBy, partition)
@@ -179,7 +179,7 @@ windows f = do
         -- urgh : not our delete policy, but close.
 
     setTopFocus
-    when logging $ withWindowSet (io . putStrLn . serial)
+    logHook
     -- 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/XMonad.hs b/XMonad.hs
index ca8d0f1..f08c810 100644
--- a/XMonad.hs
+++ b/XMonad.hs
@@ -17,9 +17,9 @@
 
 module XMonad (
     X, WindowSet, WorkspaceId(..), ScreenId(..), XState(..), XConf(..), Layout(..),
-    Typeable, Message, SomeMessage(..), fromMessage, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW,
-    runX, io, serial, withDisplay, withWindowSet, isRoot, spawn, restart, trace, whenJust, whenX,
-    atom_WM_STATE
+    Typeable, Message, SomeMessage(..), fromMessage,
+    runX, io, withDisplay, withWindowSet, isRoot, spawn, restart, trace, whenJust, whenX,
+    atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW
   ) where
 
 import StackSet
@@ -32,8 +32,6 @@ 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
@@ -183,47 +181,3 @@ 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
---
---   432|1:16777220:16777220,2:18874372:18874372,3::,4::,5::,6::,7::,8::,9::
---
--- format, roughly,:
---
---  fmt         := current visible '|' workspaces
---
---  current     := int
---  visible     := int* | epsilon
---
---  workspaces  := workspace ',' workspaces0
---  workspaces0 := workspace ',' workspaces0 | epsilon
---
---  workspace   := tag ':' focus* ':' clients
---  clients     := epsilon | client ';' clients
---
---  tag         := int
---  focus       := client
---
---  client       = int+
---  int         := 0 .. 9
---
-
-serial :: WindowSet -> String
-serial = render . ppr
-  where
-    ppr s = pprtag (current s) <>  hcat (map pprtag (visible s))
-        <|> (hcat . intersperse (char ',') . map pprWorkspace $
-                (sortBy (\a b -> tag a `compare` tag b)
-                    (map workspace (current s : visible s) ++ hidden s)))
-       where infixl 6 <|>
-             p <|> q = p <> char '|' <> q
-
-             pprtag = int . (+1) . fromIntegral . tag . workspace
-
-    pprWorkspace (Workspace i s) = int (1 + fromIntegral i)
-             <:> (if s == Empty then empty else text (show (focus s)))
-             <:> pprWindows (integrate s)
-       where p <:> q = p <> char ':' <> q
-
-    pprWindows = hcat . intersperse (char ';') . map (text.show)