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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
-----------------------------------------------------------------------------
-- |
-- 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, WorkSpace, XState(..), Layout(..), LayoutDesc(..), Disposition(..),
basicLayoutDesc, currentDesc, disposition,
runX, io, withDisplay, isRoot,
spawn, trace, whenJust, rot
) where
import StackSet (StackSet)
import qualified StackSet as W
import Data.Ratio
import Control.Monad.State
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
{ display :: Display
, screen :: {-# UNPACK #-} !ScreenNumber
, xineScreens :: {-# UNPACK #-} ![Rectangle]
-- a mapping of workspaces to xinerama screen numbers
, wsOnScreen :: {-# UNPACK #-} !(M.Map Int Int)
, theRoot :: {-# UNPACK #-} !Window
, wmdelete :: {-# UNPACK #-} !Atom
, wmprotocols :: {-# UNPACK #-} !Atom
, dimensions :: {-# UNPACK #-} !(Int,Int)
, workspace :: {-# UNPACK #-} !WorkSpace -- ^ workspace list
, layoutDescs :: {-# UNPACK #-} !(M.Map Int LayoutDesc)
, dispositions :: {-# UNPACK #-} !(M.Map Window Disposition)
-- ^ mapping of workspaces to descriptions of their layouts
}
type WorkSpace = StackSet Window
-- ---------------------------------------------------------------------
-- Display Positions and Layout
-- | Disposition. Short for 'Display Position,' it describes how much
-- of the screen a window would like to occupy, when tiled with others.
data Disposition
= Disposition { vertFrac, horzFrac :: {-# UNPACK #-} !Rational }
basicDisposition :: Disposition
basicDisposition = Disposition (1%3) (1%3)
-- | The different layout modes
data Layout = Full | Horz | Vert
-- | 'rot' for Layout.
rot :: Layout -> Layout
rot Full = Horz
rot Horz = Vert
rot Vert = Full
-- | A full description of a particular workspace's layout parameters.
data LayoutDesc = LayoutDesc { layoutType :: !Layout,
horzTileFrac :: !Rational,
vertTileFrac :: !Rational }
basicLayoutDesc :: LayoutDesc
basicLayoutDesc = LayoutDesc { layoutType = Full,
horzTileFrac = 1%2,
vertTileFrac = 1%2 }
-- | disposition. Gets the disposition of a particular window.
disposition :: Window -> XState -> Disposition
disposition w s = M.findWithDefault basicDisposition w (dispositions s)
-- | Gets the current layoutDesc.
currentDesc :: XState -> LayoutDesc
currentDesc s = M.findWithDefault basicLayoutDesc n (layoutDescs s)
where n = (W.current . workspace $ s)
-- | The X monad, a StateT transformer over IO encapuslating the window
-- manager state
newtype X a = X (StateT XState IO a)
deriving (Functor, Monad, MonadIO, MonadState XState)
-- | Run the X monad, given a chunk of X monad code, and an initial state
-- Return the result, and final state
runX :: XState -> X a -> IO ()
runX st (X a) = runStateT a st >> return ()
-- ---------------------------------------------------------------------
-- Convenient wrappers to state
-- | Run a monad action with the current display settings
withDisplay :: (Display -> X ()) -> X ()
withDisplay f = gets display >>= f
-- | True if the given window is the root window
isRoot :: Window -> X Bool
isRoot w = liftM (w==) (gets theRoot)
-- ---------------------------------------------------------------------
-- 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
|
