1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.hs
-- Copyright : (c) Spencer Janssen 2007
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : sjanssen@cse.unl.edu
-- Stability : unstable
-- Portability : not portable, uses cunning newtype deriving
--
-----------------------------------------------------------------------------
--
-- The X monad, a state monad transformer over IO, for the window
-- manager state, and support routines.
--
module XMonad (
X, WindowSet, WorkspaceId(..), ScreenId(..), XState(..), XConf(..), Layout(..),
LayoutDesc(..), runX, io, withDisplay, isRoot, spawn, trace, whenJust, rotateLayout
) where
import StackSet (StackSet)
import Control.Monad.State
import Control.Monad.Reader
import System.IO
import System.Posix.Process (executeFile, forkProcess, getProcessStatus)
import System.Exit
import Graphics.X11.Xlib
import qualified Data.Map as M
-- | XState, the window manager state.
-- Just the display, width, height and a window list
data XState = XState
{ workspace :: !WindowSet -- ^ workspace list
, layoutDescs :: !(M.Map WorkspaceId LayoutDesc) -- ^ mapping of workspaces
-- to descriptions of their layouts
}
data XConf = XConf
{ display :: Display -- ^ the X11 display
, theRoot :: !Window -- ^ the root window
, wmdelete :: !Atom -- ^ window deletion atom
, wmprotocols :: !Atom -- ^ wm protocols atom
, dimensions :: !(Int,Int) -- ^ dimensions of the screen,
-- used for hiding windows
, xineScreens :: ![Rectangle] -- ^ dimensions of each screen
, normalBorder :: !Color -- ^ border color of unfocused windows
, focusedBorder :: !Color -- ^ border color of the focused window
}
type WindowSet = StackSet WorkspaceId ScreenId Window
-- | Virtual workspace indicies
newtype WorkspaceId = W Int deriving (Eq,Ord,Show,Enum,Num,Integral,Real)
-- | Physical screen indicies
newtype ScreenId = S Int deriving (Eq,Ord,Show,Enum,Num,Integral,Real)
------------------------------------------------------------------------
-- | The X monad, a StateT transformer over IO encapsulating the window
-- manager state
--
-- Dynamic components may be retrieved with 'get', static components
-- with 'ask'. With newtype deriving we get readers and state monads
-- instantiated on XConf and XState automatically.
--
newtype X a = X (ReaderT XConf (StateT XState IO) a)
deriving (Functor, Monad, MonadIO, MonadState XState, MonadReader XConf)
-- | Run the X monad, given a chunk of X monad code, and an initial state
-- Return the result, and final state
runX :: XConf -> XState -> X a -> IO ()
runX c st (X a) = runStateT (runReaderT a c) st >> return ()
-- ---------------------------------------------------------------------
-- Convenient wrappers to state
-- | Run a monad action with the current display settings
withDisplay :: (Display -> X ()) -> X ()
withDisplay f = asks display >>= f
-- | True if the given window is the root window
isRoot :: Window -> X Bool
isRoot w = liftM (w==) (asks theRoot)
------------------------------------------------------------------------
-- Layout handling
-- | The different layout modes
data Layout = Full | Tall | Wide deriving (Enum, Bounded, Eq)
-- | 'rot' for Layout.
rotateLayout :: Layout -> Layout
rotateLayout x = if x == maxBound then minBound else succ x
-- | A full description of a particular workspace's layout parameters.
data LayoutDesc = LayoutDesc { layoutType :: !Layout
, tileFraction :: !Rational }
-- ---------------------------------------------------------------------
-- Utilities
-- | Lift an IO action into the X monad
io :: IO a -> X a
io = liftIO
{-# INLINE io #-}
-- | spawn. Launch an external application
spawn :: String -> X ()
spawn x = io $ do
pid <- forkProcess $ do
forkProcess (executeFile "/bin/sh" False ["-c", x] Nothing)
exitWith ExitSuccess
return ()
getProcessStatus True False pid
return ()
-- | Run a side effecting action with the current workspace. Like 'when' but
whenJust :: Maybe a -> (a -> X ()) -> X ()
whenJust mg f = maybe (return ()) f mg
-- | A 'trace' for the X monad. Logs a string to stderr. The result may
-- be found in your .xsession-errors file
trace :: String -> X ()
trace msg = io $! do hPutStrLn stderr msg; hFlush stderr
|
