aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Hooks/ManageDocks.hs
blob: 0cce565ebfef2c71ae007e93b7299a99dc47b48d (plain) (blame)
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
{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
{-# OPTIONS -fglasgow-exts #-}
-- deriving Typeable
-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Hooks.ManageDocks
-- Copyright    : (c) Joachim Breitner <mail@joachim-breitner.de>
-- License      : BSD
--
-- Maintainer   : Joachim Breitner <mail@joachim-breitner.de>
-- Stability    : unstable
-- Portability  : unportable
--
-- Makes xmonad detect windows with type DOCK and does not put them in
-- layouts. It also detects window with STRUT set and modifies the
-- gap accordingly.
--
-- It also allows you to reset the gap to reflect the state of current STRUT
-- windows (for example, after you resized or closed a panel), and to toggle the Gap
-- in a STRUT-aware fashion.
--
-- The avoidStruts layout modifier allows you to make xmonad dynamically
-- avoid overlapping windows with panels.  You can (optionally) enable this
-- on a selective basis, so that some layouts will effectively hide the
-- panel, by placing windows on top of it.  An example use of avoidStruts
-- would be:
--
-- > layoutHook = Layout $ toggleLayouts (noBorders Full) $ avoidStruts $
-- >                       your actual layouts here ||| ...
--
-- You may also wish to bind a key to sendMessage ToggleStruts, which will
-- toggle the avoidStruts behavior, so you can hide your panel at will.
--
-- This would enable a full-screen mode that overlaps the panel, while all
-- other layouts avoid the panel.
--
-----------------------------------------------------------------------------

module XMonad.Hooks.ManageDocks (
    -- * Usage
    -- $usage
    manageDocksHook
    ,resetGap
    ,toggleGap
    ,avoidStruts, ToggleStruts(ToggleStruts)
    ) where

import XMonad
import XMonad.Operations
import qualified XMonad.StackSet as W
import Foreign.C.Types (CLong)
import Data.Maybe (catMaybes)

-- $usage
-- Add the imports to your configuration file and add the manageHook:
--
-- > import XMonad.Hooks.ManageDocks
--
-- > manageHook w _ _ _  = manageDocksHook w
--
-- and comment out the default `manageHook _ _ _ _ = return id` line.
--
-- Then you can bind resetGap or toggleGap as you wish:
--
-- > , ((modMask,               xK_b), toggleGap)

-- %import XMonad.Hooks.ManageDocks
-- %def -- comment out default manageHook definition above if you uncomment this:
-- %def manageHook w _ _ _ = manageDocksHook w
-- %keybind , ((modMask,               xK_b), toggleGap)


-- |
-- Detects if the given window is of type DOCK and if so, reveals it, but does
-- not manage it. If the window has the STRUT property set, adjust the gap accordingly.
manageDocksHook :: Window -> X (WindowSet -> WindowSet)
manageDocksHook w = do
    hasStrut <- getStrut w
    maybe (return ()) setGap hasStrut

    isDock <- checkDock w
    if isDock then do
        reveal w
        return (W.delete w)
     else do
        return id

-- |
-- Checks if a window is a DOCK window
checkDock :: Window -> X (Bool)
checkDock w = do
    a <- getAtom "_NET_WM_WINDOW_TYPE"
    d <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"
    mbr <- getProp a w
    case mbr of
        Just [r] -> return (fromIntegral r == d)
        _        -> return False

-- |
-- Gets the STRUT config, if present, in xmonad gap order
getStrut :: Window -> X (Maybe (Int, Int, Int, Int))
getStrut w = do
    a <- getAtom "_NET_WM_STRUT"
    mbr <- getProp a w
    case mbr of
        Just [l,r,t,b] -> return (Just (
                    fromIntegral t,
                    fromIntegral b,
                    fromIntegral l,
                    fromIntegral r))
        _              -> return Nothing

-- |
-- Helper to read a property
getProp :: Atom -> Window -> X (Maybe [CLong])
getProp a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w

-- |
-- Modifies the gap, setting new max
setGap :: (Int, Int, Int, Int) -> X ()
setGap gap = modifyGap (\_ -> max4 gap)


-- |
-- Goes through the list of windows and find the gap so that all STRUT
-- settings are satisfied.
calcGap :: X (Int, Int, Int, Int)
calcGap = withDisplay $ \dpy -> do
	rootw <- asks theRoot
	-- We don’t keep track of dock like windows, so we find all of them here
	(_,_,wins) <- io $ queryTree dpy rootw
	struts <- catMaybes `fmap` mapM getStrut wins
	return $ foldl max4 (0,0,0,0) struts

-- |
-- Adjusts the gap to the STRUTs of all current Windows 
resetGap :: X ()
resetGap = do
	newGap <- calcGap
	modifyGap (\_ _ -> newGap)

-- |
-- Removes the gap or, if already removed, sets the gap according to the windows’ STRUT
toggleGap :: X ()
toggleGap = do
	newGap <- calcGap
	modifyGap (\_ old -> if old == (0,0,0,0) then newGap else (0,0,0,0))

-- |
-- Piecewise maximum of a 4-tuple of Ints
max4 :: (Int, Int, Int, Int) -> (Int, Int, Int, Int) -> (Int, Int, Int, Int)
max4 (a1,a2,a3,a4) (b1,b2,b3,b4) = (max a1 b1, max a2 b2, max a3 b3, max a4 b4)

-- | Adjust layout automagically.
avoidStruts :: LayoutClass l a => l a -> AvoidStruts l a
avoidStruts = AvoidStruts True

data AvoidStruts l a = AvoidStruts Bool (l a) deriving ( Read, Show )

data ToggleStruts = ToggleStruts deriving (Read,Show,Typeable)
instance Message ToggleStruts

instance LayoutClass l a => LayoutClass (AvoidStruts l) a where
    doLayout (AvoidStruts True lo) (Rectangle x y w h) s =
        do (t,b,l,r) <- calcGap
           let rect = Rectangle (x+fromIntegral l) (y+fromIntegral t)
                      (w-fromIntegral l-fromIntegral r) (h-fromIntegral t-fromIntegral b)
           (wrs,mlo') <- doLayout lo rect s
           return (wrs, AvoidStruts True `fmap` mlo')
    doLayout (AvoidStruts False lo) r s = do (wrs,mlo') <- doLayout lo r s
                                             return (wrs, AvoidStruts False `fmap` mlo')
    handleMessage (AvoidStruts b l) m
        | Just ToggleStruts <- fromMessage m = return $ Just $ AvoidStruts (not b) l
        | otherwise = do ml' <- handleMessage l m
                         return (AvoidStruts b `fmap` ml')
    description (AvoidStruts _ l) = description l