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
|
{-# 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(..),
Typeable, Message, SomeMessage(..), fromMessage,
runX, io, withDisplay, isRoot, spawn, trace, whenJust
) 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 Data.Typeable
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
, layouts :: !(M.Map WorkspaceId (Layout, [Layout])) }
-- ^ 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
-- 'doLayout', a pure function to layout a Window set 'modifyLayout',
-- 'modifyLayout' can be considered a branch of an exception handler.
--
data Layout = Layout { doLayout :: Rectangle -> [Window] -> [(Window, Rectangle)]
, modifyLayout :: SomeMessage -> Maybe Layout }
-- Based on ideas in /An Extensible Dynamically-Typed Hierarchy of Exceptions/,
-- Simon Marlow, 2006. Use extensible messages to the modifyLayout handler.
--
-- User-extensible messages must be a member of this class:
--
class Typeable a => Message a
--
-- A wrapped value of some type in the Message class.
--
data SomeMessage = forall a. Message a => SomeMessage a
--
-- And now, unwrap a given, unknown Message type, performing a (dynamic)
-- type check on the result.
--
fromMessage :: Message m => SomeMessage -> Maybe m
fromMessage (SomeMessage m) = cast m
-- ---------------------------------------------------------------------
-- 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
|
