citadel

My dotfiles, scripts and nix configs
git clone git://jb55.com/citadel
Log | Files | Refs | README | LICENSE

xmonad.hs (7772B)


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