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 : XMonadContrib.Tabbed
-- Copyright : (c) David Roundy
-- License : BSD-style (see xmonad/LICENSE)
--
-- Maintainer : email@address.com
-- Stability : unstable
-- Portability : unportable
--
-- A tabbed layout for the Xmonad Window Manager
--
-----------------------------------------------------------------------------
module XMonadContrib.Tabbed (
-- * Usage:
-- $usage
tabbed
, Shrinker, shrinkText
, TConf (..), defaultTConf
) where
import Control.Monad.State ( gets )
import Graphics.X11.Xlib
import XMonad
import XMonadContrib.Decoration
import Operations ( focus, initColor )
import qualified StackSet as W
import XMonadContrib.NamedWindows
import XMonadContrib.SimpleStacking ( simpleStacking )
import XMonadContrib.LayoutHelpers ( idModify )
-- $usage
-- You can use this module with the following in your configuration file:
--
-- > import XMonadContrib.Tabbed
--
-- > defaultLayouts :: [Layout Window]
-- > defaultLayouts = [ tabbed shrinkText defaultTConf
-- > , ... ]
--
-- You can also edit the default configuration options.
--
-- > myconfig = defaultTConf { inactiveBolderColor = "#FF0000"
-- > , activeTextColor = "#00FF00"}
--
-- and
--
-- > defaultLayouts = [ tabbed shrinkText myconfig
-- > , ... ]
-- %import XMonadContrib.Tabbed
-- %layout , tabbed shrinkText defaultTConf
data TConf =
TConf { activeColor :: String
, inactiveColor :: String
, activeBorderColor :: String
, inactiveTextColor :: String
, inactiveBorderColor :: String
, activeTextColor :: String
, fontName :: String
, tabSize :: Int
} deriving (Show, Read)
defaultTConf :: TConf
defaultTConf =
TConf { activeColor ="#999999"
, inactiveColor = "#666666"
, activeBorderColor = "#FFFFFF"
, inactiveBorderColor = "#BBBBBB"
, activeTextColor = "#FFFFFF"
, inactiveTextColor = "#BFBFBF"
, fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
, tabSize = 20
}
tabbed :: Shrinker -> TConf -> Layout Window
tabbed s t = simpleStacking $ tabbed' s t
tabbed' :: Shrinker -> TConf -> Layout Window
tabbed' shrinkT config = Layout { doLayout = dolay shrinkT config, modifyLayout = idModify }
dolay :: Shrinker -> TConf
-> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Layout Window))
dolay _ _ sc (W.Stack w [] []) = return ([(w,sc)], Nothing)
dolay shr conf sc@(Rectangle x y wid _) s = withDisplay $ \dpy ->
do ac <- io $ initColor dpy $ activeColor conf
ic <- io $ initColor dpy $ inactiveColor conf
abc <- io $ initColor dpy $ activeBorderColor conf
ibc <- io $ initColor dpy $ inactiveBorderColor conf
atc <- io $ initColor dpy $ activeTextColor conf
itc <- io $ initColor dpy $ inactiveTextColor conf
let ws = W.integrate s
ts = gentabs conf x y wid (length ws)
tws = zip ts ws
focusColor w incol actcol = (maybe incol (\focusw -> if focusw == w
then actcol else incol) . W.peek)
`fmap` gets windowset
make_tabs [] l = return l
make_tabs (tw':tws') l = do bc <- focusColor (snd tw') ibc abc
l' <- maketab tw' bc l
make_tabs tws' l'
maketab (t,ow) bg = newDecoration ow t 1 bg ac
(fontName conf) (drawtab t ow) (focus ow)
drawtab r@(Rectangle _ _ wt ht) ow d w' gc fn =
do nw <- getName ow
(fc,tc) <- focusColor ow (ic,itc) (ac,atc)
io $ setForeground d gc fc
io $ fillRectangles d w' gc [Rectangle 0 0 wt ht]
io $ setForeground d gc tc
centerText d w' gc fn r (show nw)
centerText d w' gc fontst (Rectangle _ _ wt ht) name =
do let (_,asc,_,_) = textExtents fontst name
name' = shrinkWhile shr (\n -> textWidth fontst n >
fromIntegral wt - fromIntegral (ht `div` 2)) name
width = textWidth fontst name'
io $ drawString d w' gc
(fromIntegral (wt `div` 2) - fromIntegral (width `div` 2))
((fromIntegral ht + fromIntegral asc) `div` 2) name'
l' <- make_tabs tws $ tabbed shr conf
return (map (\w -> (w,shrink conf sc)) ws, Just l')
type Shrinker = String -> [String]
shrinkWhile :: Shrinker -> (String -> Bool) -> String -> String
shrinkWhile sh p x = sw $ sh x
where sw [n] = n
sw [] = ""
sw (n:ns) | p n = sw ns
| otherwise = n
shrinkText :: Shrinker
shrinkText "" = [""]
shrinkText cs = cs : shrinkText (init cs)
shrink :: TConf -> Rectangle -> Rectangle
shrink c (Rectangle x y w h) = Rectangle x (y + fromIntegral (tabSize c)) w (h - fromIntegral (tabSize c))
gentabs :: TConf -> Position -> Position -> Dimension -> Int -> [Rectangle]
gentabs _ _ _ _ 0 = []
gentabs c x y w num = Rectangle x y (wid - 2) (fromIntegral (tabSize c) - 2)
: gentabs c (x + fromIntegral wid) y (w - wid) (num - 1)
where wid = w `div` (fromIntegral num)
|
