diff options
-rw-r--r-- | Config.hs | 10 | ||||
-rw-r--r-- | Config.hs-boot | 3 | ||||
-rw-r--r-- | Main.hs | 2 | ||||
-rw-r--r-- | Operations.hs | 4 | ||||
-rw-r--r-- | XMonad.hs | 52 |
5 files changed, 14 insertions, 57 deletions
@@ -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 @@ -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. @@ -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) |