xmonad.hs (8776B)
1 {-# LANGUAGE TupleSections #-} 2 {-# LANGUAGE RankNTypes #-} 3 {-# LANGUAGE KindSignatures #-} 4 {-# LANGUAGE RecordWildCards #-} 5 {-# LANGUAGE StandaloneDeriving #-} 6 {-# LANGUAGE TypeSynonymInstances #-} 7 {-# LANGUAGE MultiParamTypeClasses #-} 8 9 import Data.Ratio 10 import Data.IORef 11 import Data.List 12 --import Data.Default (def) 13 import Control.Monad (when) 14 import System.IO.Unsafe (unsafePerformIO) 15 import XMonad.Actions.UpdatePointer 16 import System.Posix.Files (readSymbolicLink) 17 import System.Posix.Signals (installHandler, sigUSR1, Handler(CatchOnce)) 18 import System.FilePath.Posix (takeBaseName) 19 import XMonad 20 import XMonad.Actions.CycleWS 21 import XMonad.Actions.SpawnOn (shellPromptHere, manageSpawn) 22 import XMonad.Actions.UpdatePointer 23 import XMonad.Hooks.EwmhDesktops (ewmh) 24 --import XMonad.Hooks.EwmhDesktops (ewmhFullscreen) 25 import XMonad.Hooks.ManageDocks 26 import XMonad.Hooks.ManageHelpers 27 import XMonad.Hooks.SetWMName 28 import XMonad.Hooks.UrgencyHook 29 import XMonad.Layout.Gaps 30 import XMonad.Layout.Grid 31 --import XMonad.Util.Scratchpad 32 import XMonad.Layout.LayoutModifier 33 import XMonad.Layout.Maximize 34 import XMonad.Layout.MultiToggle 35 import XMonad.Layout.MultiToggle.Instances 36 import XMonad.Layout.NoBorders 37 import XMonad.Layout.ResizableTile 38 import XMonad.Layout.ResizeScreen 39 import XMonad.Layout.Spacing 40 --import XMonad.Layout.Spiral as S 41 import XMonad.Layout.Dwindle as D 42 import XMonad.Layout.Tabbed 43 import XMonad.Layout.ToggleLayouts (ToggleLayout(ToggleLayout)) 44 import XMonad.Prompt 45 import XMonad.Prompt.Shell 46 import XMonad.Util.EZConfig 47 import XMonad.Util.NamedWindows 48 import XMonad.Util.Paste 49 import XMonad.Util.Run 50 import XMonad.Util.Font 51 import XMonad.Util.Image 52 import qualified XMonad.Layout.HintedTile as HT 53 54 import qualified XMonad.StackSet as W 55 import qualified Data.IORef as IORef 56 57 trackMousePosition :: IORef.IORef (Int, Int) -> X () 58 trackMousePosition posRef = withDisplay $ \dpy -> do 59 rootw <- asks theRoot 60 (_, _, _, x, y, _, _, _) <- io $ queryPointer dpy rootw 61 io $ IORef.writeIORef posRef (fi x, fi y) 62 63 moveToLastPosition :: IORef.IORef (Int, Int) -> X () 64 moveToLastPosition posRef = do 65 (x, y) <- io $ IORef.readIORef posRef 66 withDisplay $ \dpy -> do 67 rootw <- asks theRoot 68 io $ warpPointer dpy none rootw 0 0 0 0 (fi x) (fi y) 69 70 data LibNotifyUrgencyHook = LibNotifyUrgencyHook deriving (Read, Show) 71 72 instance UrgencyHook LibNotifyUrgencyHook where 73 urgencyHook LibNotifyUrgencyHook w = do 74 name <- getName w 75 Just idx <- W.findTag w <$> gets windowset 76 77 safeSpawn "notify-send" [show name, "workspace " ++ idx] 78 79 data OurTheme = 80 BasicTheme ThemeType String String 81 | FullTheme { 82 themeType :: ThemeType 83 , themeActiveColor :: String 84 , themeInactiveColor :: String 85 , themeActiveText :: String 86 , themeInactiveText :: String 87 } 88 deriving (Show, Read, Eq, Typeable) 89 90 getThemeType (BasicTheme typ _ _) = typ 91 getThemeType FullTheme{..} = themeType 92 93 data Center = Center deriving (Show, Read, Eq, Typeable) 94 data Maximized = Maximized deriving (Show, Read, Eq, Typeable) 95 data Gapz = Gapz deriving (Show, Read, Eq, Typeable) 96 data TabbedFull = TabbedFull OurTheme deriving (Show, Read, Eq, Typeable) 97 data ThemeType = LightTheme | DarkTheme deriving (Show, Read, Eq, Typeable) 98 99 orig (ModifiedLayout _ o) = o 100 modi (ModifiedLayout mod _) = mod 101 102 instance Transformer Center Window where 103 transform Center x k = k (centered x) (orig . orig) 104 105 instance Transformer Gapz Window where 106 transform Gapz x k = k (smartSpacingWithEdge gapSize x) orig 107 108 instance Transformer TabbedFull Window where 109 transform (TabbedFull theme) x k = 110 k (tabs (mkTabTheme theme) ||| Full) (const x) 111 112 -- TODO: this should be a ratio based off current screen width 113 centeredGap = 270 114 centered = resizeHorizontal centeredGap . resizeHorizontalRight centeredGap 115 116 gapSize = 5 117 sideGaps = False 118 119 ourFont = "xft:terminus:size=12" 120 tabs = tabbed shrinkText 121 122 baseTabTheme :: Theme 123 baseTabTheme = def { fontName = ourFont } 124 125 mkTabTheme FullTheme{..} = 126 baseTabTheme { 127 inactiveBorderColor = themeInactiveColor 128 , inactiveColor = themeInactiveColor 129 , inactiveTextColor = themeInactiveText 130 , activeColor = themeActiveColor 131 , activeBorderColor = themeActiveColor 132 , activeTextColor = themeActiveText 133 } 134 mkTabTheme (BasicTheme _ active inactive) = 135 baseTabTheme { 136 inactiveBorderColor = inactive 137 , inactiveColor = inactive 138 , activeColor = active 139 , activeBorderColor = active 140 } 141 142 darkTheme :: OurTheme 143 darkTheme = BasicTheme DarkTheme "#282C34" "#323742" 144 145 146 --darkTheme :: OurTheme 147 --darkTheme = FullTheme { 148 -- themeActiveColor = "#282C34" 149 -- , themeInactiveColor = "#323742" 150 -- , themeActiveText = "#000000" 151 -- , themeInactiveText = "#777777" 152 --} 153 154 155 lightTheme :: OurTheme 156 lightTheme = FullTheme { 157 themeType = LightTheme 158 , themeActiveColor = "#FFFFFF" 159 , themeInactiveColor = "#EEEEEE" 160 , themeActiveText = "#000000" 161 , themeInactiveText = "#777777" 162 } 163 164 allGaps = (U, if sideGaps then gapSize else 0) : 165 if sideGaps then map (,gapSize) (enumFrom D) 166 else [] 167 168 baseLayout = 169 let 170 tall = ResizableTall 1 (3/100) (1/2) [] 171 in 172 --D.Dwindle D.R D.CW 1.5 1.1 ||| 173 D.Squeeze D.R 1.38 1.1 174 ||| D.Spiral D.R D.CW 0.8 1.1 175 --S.spiral (4/3) ||| 176 --Mirror tall --S.spiralWithDir S.South S.CW (4/3) 177 178 layout theme 179 = smartBorders 180 . mkToggle (Center ?? EOT) 181 . mkToggle ((TabbedFull theme) ?? EOT) 182 . mkToggle (Gapz ?? EOT) 183 . mkToggle (MIRROR ?? EOT) 184 $ baseLayout 185 186 187 getTheme :: IO OurTheme 188 getTheme = do 189 themePath <- readSymbolicLink "/home/jb55/.Xresources.d/themes/current" 190 case takeBaseName themePath of 191 "light" -> return lightTheme 192 _ -> return darkTheme 193 194 195 myStartupHook :: Layout Window -> X () 196 myStartupHook lout = do 197 setWMName "LG3D" 198 setLayout lout -- needed until we have themeSwitch implemented 199 200 readTheme :: IORef OurTheme -> OurTheme 201 readTheme = unsafePerformIO . readIORef 202 203 otherTheme :: OurTheme -> OurTheme 204 otherTheme t = 205 case getThemeType t of 206 LightTheme -> darkTheme 207 DarkTheme -> lightTheme 208 209 shouldntFloat :: String -> Bool 210 shouldntFloat = isPrefixOf "qutebrowser" 211 212 shouldFloat :: Query Bool 213 shouldFloat = do 214 fs <- isFullscreen 215 name <- appName 216 return (fs && not (shouldntFloat name)) 217 218 --scratchHook = scratchpadManageHook (W.RationalRect 0.1 0.1 0.6 0.6) 219 --myManageHook = scratchHook <+> (shouldFloat --> doFullFloat) 220 myManageHook = composeAll [ 221 shouldFloat --> doFullFloat 222 , className =? "Steam" --> doFloat 223 , className =? "steam" --> doFullFloat 224 ] 225 226 myConfig theme = 227 let lout = layout theme 228 cfg = def { 229 terminal = termName 230 , modMask = mod4Mask 231 , layoutHook = lout 232 , logHook = updatePointer (0.5, 0.5) (0, 0) 233 , startupHook = myStartupHook (Layout lout) 234 , manageHook = myManageHook 235 , normalBorderColor = "#222" 236 , focusedBorderColor = "#BE5046" 237 } 238 in 239 withUrgencyHook LibNotifyUrgencyHook 240 $ ewmh 241 $ cfg 242 `additionalKeysP` (myKeys theme) 243 244 main = do 245 installHandler sigUSR1 (CatchOnce doRestart) Nothing 246 theme <- getTheme 247 xmonad (myConfig theme) 248 249 myXPConfig = 250 def { 251 font = ourFont, 252 height = 20, 253 borderColor = "#000000" 254 } 255 256 nWindows :: X Int 257 nWindows = fmap go get 258 where 259 go = length . W.integrate' 260 . W.stack 261 . W.workspace 262 . W.current 263 . windowset 264 265 toggleGaps = sendMessage (Toggle Gapz) 266 toggleFull theme = sendMessage (Toggle (TabbedFull theme)) 267 toggleMirror = sendMessage (Toggle MIRROR) 268 toggleCenter = sendMessage (Toggle Center) 269 270 termName :: String 271 termName = "urxvtc" 272 273 myKeys theme = [ 274 ("M-p", spawn "dmenu_run -fn \"terminus-12\" -p \"run\"") 275 , ("M-a", focusUrgent) 276 , ("M-d", toggleWS) 277 , ("M-f", toggleFull theme) 278 , ("M-c", toggleCenter) 279 , ("M-b", toggleMirror) 280 , ("M-g", toggleGaps) 281 --, ("M-s", scratchpadSpawnActionTerminal termName) 282 -- , ("M-r", toggleFull) 283 , ("M-v", sendKey shiftMask xK_Insert) 284 ] 285 286 287 288 289 sendRestart :: IO () 290 sendRestart = do 291 dpy <- openDisplay "" 292 rw <- rootWindow dpy $ defaultScreen dpy 293 xmonad_restart <- internAtom dpy "XMONAD_RESTART" False 294 allocaXEvent $ \e -> do 295 setEventType e clientMessage 296 setClientMessageEvent e rw xmonad_restart 32 0 currentTime 297 sendEvent dpy rw False structureNotifyMask e 298 sync dpy False 299 300 301 doRestart = spawn "xmonad --restart"