From 5294b3dc35bfff087cab0b13d9a32fbf62f2a96b Mon Sep 17 00:00:00 2001 From: Don Stewart Date: Sun, 10 Jun 2007 08:19:32 +0200 Subject: Move state logging into Config.hs, via logHook :: X () darcs-hash:20070610061932-9c5c1-9a08992ef555f086007474e64d5ae9d835e9677e --- Config.hs | 10 ++++++---- Config.hs-boot | 3 ++- Main.hs | 2 +- Operations.hs | 4 ++-- XMonad.hs | 52 +++------------------------------------------------- 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) -- cgit v1.2.3