summaryrefslogtreecommitdiffstats
path: root/Operations.hs
blob: f30460a78821f094bdd0572249170057b22a3bbf (plain)
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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
module Operations where

import Data.List
import Data.Maybe
import Data.Bits
import qualified Data.Map as M

import Control.Monad.State

import System.Posix.Process
import System.Environment

import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras

import XMonad

import qualified StackSet as W


-- ---------------------------------------------------------------------
-- Managing windows

-- | refresh. Refresh the currently focused window. Resizes to full
-- screen and raises the window.
refresh :: X ()
refresh = do
    ws     <- gets workspace
    ws2sc  <- gets wsOnScreen
    xinesc <- gets xineScreens
    d      <- gets display
    fls    <- gets layoutDescs
    dfltfl <- gets defaultLayoutDesc
    let move w a b c e = io $ moveResizeWindow d w a b c e
    flip mapM_ (M.assocs ws2sc) $ \(n, scn) -> do
        let sc = xinesc !! scn
            sx = rect_x sc
            sy = rect_y sc
            sw = rect_width sc
            sh = rect_height sc
            fl = M.findWithDefault dfltfl n fls
            l  = layoutType fl
            ratio = tileFraction fl
        mapM_ (setButtonGrab True) (W.index n ws)
        when (n == W.current ws) $
            maybe (return ()) (setButtonGrab False) (W.peekStack n ws)
        case l of
            Full -> whenJust (W.peekStack n ws) $ \w -> do
                                                            move w sx sy sw sh
                                                            io $ raiseWindow d w
            Tile -> case W.index n ws of
                []    -> return ()
                [w]   -> do move w sx sy sw sh; io $ raiseWindow d w
                (w:s) -> do
                    let lw = floor $ fromIntegral sw * ratio
                        rw = sw - fromIntegral lw
                        rh = fromIntegral sh `div` fromIntegral (length s)
                    move w sx sy (fromIntegral lw) sh
                    zipWithM_ (\i a -> move a (sx + lw) (sy + i * rh) rw (fromIntegral rh)) [0..] s
                    whenJust (W.peek ws) (io . raiseWindow d) -- this is always Just
    whenJust (W.peek ws) setFocus

-- | switchLayout.  Switch to another layout scheme.  Switches the current workspace.
switchLayout :: X ()
switchLayout = layout $ \fl -> fl { layoutType = case layoutType fl of
                                                   Full -> Tile
                                                   Tile -> Full }

-- | changeWidth.  Change the width of the main window in tiling mode.
changeWidth :: Rational -> X ()
changeWidth delta = do
    layout $ \fl -> fl { tileFraction = min 1 $ max 0 $ tileFraction fl + delta }

-- | layout. Modify the current workspace's layout with a pure function and refresh.
layout :: (LayoutDesc -> LayoutDesc) -> X ()
layout f = do modify $ \s -> let fls = layoutDescs s
                                 n   = W.current . workspace $ s
                                 fl  = M.findWithDefault (defaultLayoutDesc s) n fls
                             in s { layoutDescs = M.insert n (f fl) fls }
              refresh
              

-- | windows. Modify the current window list with a pure function, and refresh
windows :: (WorkSpace -> WorkSpace) -> X ()
windows f = do
    modify $ \s -> s { workspace = f (workspace s) }
    refresh
    ws <- gets workspace
    trace (show ws) -- log state changes to stderr

-- | hide. Hide a window by moving it offscreen.
hide :: Window -> X ()
hide w = withDisplay $ \d -> do
    (sw,sh) <- gets dimensions
    io $ moveWindow d w (2*fromIntegral sw) (2*fromIntegral sh)

-- ---------------------------------------------------------------------
-- Window operations

-- | setButtonGrab. Tell whether or not to intercept clicks on a given window
buttonsToGrab :: [ButtonMask]
buttonsToGrab = [button1, button2, button3]

setButtonGrab :: Bool -> Window -> X ()
setButtonGrab True  w = withDisplay $ \d -> io $ flip mapM_ buttonsToGrab (\b ->
                            grabButton d b anyModifier w False
                                       (buttonPressMask .|. buttonReleaseMask)
                                       grabModeAsync grabModeSync none none)
setButtonGrab False w = withDisplay $ \d -> io $ flip mapM_ buttonsToGrab (\b ->
                            ungrabButton d b anyModifier w)

-- | manage. Add a new window to be managed in the current workspace. Bring it into focus.
-- If the window is already under management, it is just raised.
--
-- When we start to manage a window, it gains focus.
--
manage :: Window -> X ()
manage w = do
    withDisplay $ \d -> io $ do
        selectInput d w $ structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
        mapWindow d w
    setFocus w
    windows $ W.push w

-- | unmanage. A window no longer exists, remove it from the window
-- list, on whatever workspace it is.
unmanage :: Window -> X ()
unmanage w = do
    windows $ W.delete w
    withServerX $ do
      setTopFocus
      withDisplay $ \d -> io (sync d False)
      -- TODO, everything operates on the current display, so wrap it up.

-- | Grab the X server (lock it) from the X monad
withServerX :: X () -> X ()
withServerX f = withDisplay $ \dpy -> do
    io $ grabServer dpy
    f
    io $ ungrabServer dpy

-- | Explicitly set the keyboard focus to the given window
setFocus :: Window -> X ()
setFocus w = do
    withDisplay $ \d -> io $ setInputFocus d w revertToPointerRoot 0
    -- This does not use 'windows' intentionally.  'windows' calls refresh,
    -- which means infinite loops.
    modify (\s -> s { workspace = W.raiseFocus w (workspace s) })

-- | Set the focus to the window on top of the stack, or root
setTopFocus :: X ()
setTopFocus = do
    ws <- gets workspace
    case W.peek ws of
        Just new -> setFocus new
        Nothing  -> gets theRoot >>= setFocus

-- | raise. focus to window at offset 'n' in list.
-- The currently focused window is always the head of the list
raise :: Ordering -> X ()
raise = windows . W.rotate

-- | promote.  Make the focused window the master window in its workspace
promote :: X ()
promote = windows (\w -> maybe w (\k -> W.promote k w) (W.peek w))

-- | Kill the currently focused client
kill :: X ()
kill = withDisplay $ \d -> do
    ws <- gets workspace
    whenJust (W.peek ws) $ \w -> do
        protocols <- io $ getWMProtocols d w
        wmdelt    <- gets wmdelete
        wmprot    <- gets wmprotocols
        if wmdelt `elem` protocols
            then io $ allocaXEvent $ \ev -> do
                    setEventType ev clientMessage
                    setClientMessageEvent ev w wmprot 32 wmdelt 0
                    sendEvent d w False noEventMask ev
            else io (killClient d w) >> return ()

-- | tag. Move a window to a new workspace
tag :: Int -> X ()
tag o = do
    ws <- gets workspace
    let m = W.current ws
    when (n /= m) $
        whenJust (W.peek ws) $ \w -> do
            hide w
            windows $ W.shift n
    where n = o-1

-- | view. Change the current workspace to workspce at offset 'n-1'.
view :: Int -> X ()
view o = do
    ws    <- gets workspace
    ws2sc <- gets wsOnScreen
    let m = W.current ws
    -- is the workspace we want to switch to currently visible?
    if M.member n ws2sc
        then windows $ W.view n
        else do 
            sc <- case M.lookup m ws2sc of
                Nothing -> do 
                    trace "Current workspace isn't visible! This should never happen!"
                    -- we don't know what screen to use, just use the first one.
                    return 0
                Just sc -> return sc
            modify $ \s -> s { wsOnScreen = M.insert n sc (M.filter (/=sc) ws2sc) }
            gets wsOnScreen >>= trace . show
            windows $ W.view n
            mapM_ hide (W.index m ws)
    setTopFocus
    where n = o-1

-- | True if window is under management by us
isClient :: Window -> X Bool
isClient w = liftM (W.member w) (gets workspace)

-- | screenWS. Returns the workspace currently visible on screen n
screenWS :: Int -> X Int
screenWS n = do
    ws2sc <- gets wsOnScreen
    -- FIXME: It's ugly to have to query this way. We need a different way to
    -- keep track of screen <-> workspace mappings.
    let ws = fmap fst $ find (\(_, scn) -> scn == (n-1)) (M.assocs ws2sc)
    return $ (fromMaybe 0 ws) + 1

-- | Restart xmonad by exec()'ing self. This doesn't save state and xmonad has
-- to be in PATH for this to work.
restart :: IO ()
restart = do prog <- getProgName
             args <- getArgs
             executeFile prog True args Nothing