mirror of
https://github.com/xmonad/xmonad.git
synced 2025-05-19 08:30:21 -07:00
HEADS UP: (logging format change). use a custom pretty printer, for an easier format to parse, than 'show' produces
This commit is contained in:
parent
a21c4d02f1
commit
0ada17c34a
2
Main.hs
2
Main.hs
@ -94,7 +94,7 @@ main = do
|
|||||||
, w <- W.integrate (W.stack wk) ]
|
, w <- W.integrate (W.stack wk) ]
|
||||||
|
|
||||||
mapM_ manage ws -- find new windows
|
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.
|
-- main loop, for all you HOF/recursion fans out there.
|
||||||
forever $ handle =<< io (nextEvent dpy e >> getEvent e)
|
forever $ handle =<< io (nextEvent dpy e >> getEvent e)
|
||||||
|
@ -179,7 +179,7 @@ windows f = do
|
|||||||
-- urgh : not our delete policy, but close.
|
-- urgh : not our delete policy, but close.
|
||||||
|
|
||||||
setTopFocus
|
setTopFocus
|
||||||
when logging $ withWindowSet (io . hPrint stdout)
|
when logging $ withWindowSet (io . putStrLn . serial)
|
||||||
-- io performGC -- really helps, but seems to trigger GC bugs?
|
-- 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.
|
-- We now go to some effort to compute the minimal set of windows to hide.
|
||||||
|
@ -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
|
then maybe s go (peek s) else s
|
||||||
where go w = foldr ($) s [view (tag (workspace (current s))),insertUp w,view n,delete w]
|
where go w = foldr ($) s [view (tag (workspace (current s))),insertUp w,view n,delete w]
|
||||||
-- ^^ poor man's state monad :-)
|
-- ^^ poor man's state monad :-)
|
||||||
|
|
||||||
|
44
XMonad.hs
44
XMonad.hs
@ -18,11 +18,11 @@
|
|||||||
module XMonad (
|
module XMonad (
|
||||||
X, WindowSet, WorkspaceId(..), ScreenId(..), XState(..), XConf(..), Layout(..),
|
X, WindowSet, WorkspaceId(..), ScreenId(..), XState(..), XConf(..), Layout(..),
|
||||||
Typeable, Message, SomeMessage(..), fromMessage, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW,
|
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
|
atom_WM_STATE
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import StackSet (StackSet)
|
import StackSet
|
||||||
|
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
@ -32,6 +32,8 @@ import System.Exit
|
|||||||
import System.Environment
|
import System.Environment
|
||||||
import Graphics.X11.Xlib
|
import Graphics.X11.Xlib
|
||||||
import Data.Typeable
|
import Data.Typeable
|
||||||
|
import Data.List (intersperse,sortBy)
|
||||||
|
import Text.PrettyPrint
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.Set as S
|
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
|
-- be found in your .xsession-errors file
|
||||||
trace :: String -> X ()
|
trace :: String -> X ()
|
||||||
trace msg = io $! do hPutStrLn stderr msg; hFlush stderr
|
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))
|
||||||
|
|
||||||
|
Loading…
x
Reference in New Issue
Block a user