{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Config.Sjanssen
-- Description :  Spencer Janssen's xmonad config.
--
------------------------------------------------------------------------
module XMonad.Config.Sjanssen {-# DEPRECATED "This module contains a personal configuration, to be removed from xmonad-contrib.  If you use this module, please copy the relevant parts to your configuration or obtain a copy of it on https://xmonad.org/configurations.html and include it as a local module." #-} (sjanssenConfig) where

import XMonad hiding (Tall(..))
import qualified XMonad.StackSet as W
import XMonad.Actions.CopyWindow
import XMonad.Layout.Tabbed
import XMonad.Layout.HintedTile
import XMonad.Layout.NoBorders
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers (isFullscreen, doFullFloat)
import XMonad.Hooks.EwmhDesktops
import XMonad.Prompt
import XMonad.Actions.SpawnOn
import XMonad.Util.SpawnOnce

import XMonad.Layout.LayoutScreens
import XMonad.Layout.TwoPane

import qualified Data.Map as M

sjanssenConfig :: XConfig
  (ModifiedLayout
     AvoidStruts
     (ModifiedLayout
        SmartBorder
        (Choose
           (Choose HintedTile (Choose HintedTile Full))
           (ModifiedLayout
              (Decoration TabbedDecoration DefaultShrinker) Simplest))))
sjanssenConfig =
    forall (a :: * -> *). XConfig a -> XConfig a
docks forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *). XConfig a -> XConfig a
ewmh forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def
        { terminal :: String
terminal = String
"exec urxvt"
        , workspaces :: [String]
workspaces = [String
"irc", String
"web"] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Int
3 .. Int
9 :: Int]
        , mouseBindings :: XConfig Layout -> Map (ButtonMask, Button) (KeySym -> X ())
mouseBindings = \XConfig {modMask :: forall (l :: * -> *). XConfig l -> ButtonMask
modMask = ButtonMask
modm} -> forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                [ ((ButtonMask
modm, Button
button1), \KeySym
w -> KeySym -> X ()
focus KeySym
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KeySym -> X ()
mouseMoveWindow KeySym
w)
                , ((ButtonMask
modm, Button
button2), \KeySym
w -> KeySym -> X ()
focus KeySym
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (WindowSet -> WindowSet) -> X ()
windows forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.swapMaster)
                , ((ButtonMask
modmforall a. Bits a => a -> a -> a
.|. ButtonMask
shiftMask, Button
button1), \KeySym
w -> KeySym -> X ()
focus KeySym
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KeySym -> X ()
mouseResizeWindow KeySym
w) ]
        , keys :: XConfig Layout -> Map (ButtonMask, KeySym) (X ())
keys = \XConfig Layout
c -> forall {l :: * -> *}. XConfig l -> Map (ButtonMask, KeySym) (X ())
mykeys XConfig Layout
c forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (ButtonMask, KeySym) (X ())
keys forall a. Default a => a
def XConfig Layout
c
        , logHook :: X ()
logHook = PP -> X String
dynamicLogString PP
sjanssenPP forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> X ()
xmonadPropLog
        , layoutHook :: ModifiedLayout
  AvoidStruts
  (ModifiedLayout
     SmartBorder
     (Choose
        (Choose HintedTile (Choose HintedTile Full))
        (ModifiedLayout
           (Decoration TabbedDecoration DefaultShrinker) Simplest)))
  KeySym
layoutHook  = Choose
  (Choose HintedTile (Choose HintedTile Full))
  (ModifiedLayout
     (Decoration TabbedDecoration DefaultShrinker) Simplest)
  KeySym
-> ModifiedLayout
     AvoidStruts
     (ModifiedLayout
        SmartBorder
        (Choose
           (Choose HintedTile (Choose HintedTile Full))
           (ModifiedLayout
              (Decoration TabbedDecoration DefaultShrinker) Simplest)))
     KeySym
modifiers Choose
  (Choose HintedTile (Choose HintedTile Full))
  (ModifiedLayout
     (Decoration TabbedDecoration DefaultShrinker) Simplest)
  KeySym
layouts
        , manageHook :: ManageHook
manageHook  = forall m. Monoid m => [m] -> m
composeAll [Query String
className forall a. Eq a => Query a -> a -> Query Bool
=? String
x forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> String -> ManageHook
doShift String
w
                                    | (String
x, String
w) <- [ (String
"Firefox", String
"web")
                                                , (String
"Ktorrent", String
"7")
                                                , (String
"Amarokapp", String
"7")]]
                        forall a. Semigroup a => a -> a -> a
<> forall (l :: * -> *). XConfig l -> ManageHook
manageHook forall a. Default a => a
def forall a. Semigroup a => a -> a -> a
<> ManageHook
manageSpawn
                        forall a. Semigroup a => a -> a -> a
<> (Query Bool
isFullscreen forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> ManageHook
doFullFloat)
        , startupHook :: X ()
startupHook = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> X ()
spawnOnce [String]
spawns
        }
 where
    tiled :: Orientation -> HintedTile a
tiled     = forall a.
Int
-> Rational -> Rational -> Alignment -> Orientation -> HintedTile a
HintedTile Int
1 Rational
0.03 Rational
0.5 Alignment
TopLeft
    layouts :: Choose
  (Choose HintedTile (Choose HintedTile Full))
  (ModifiedLayout
     (Decoration TabbedDecoration DefaultShrinker) Simplest)
  KeySym
layouts   = (forall {a}. Orientation -> HintedTile a
tiled Orientation
Tall forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
||| (forall {a}. Orientation -> HintedTile a
tiled Orientation
Wide forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
||| forall a. Full a
Full)) forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
||| forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbed DefaultShrinker
shrinkText Theme
myTheme
    modifiers :: Choose
  (Choose HintedTile (Choose HintedTile Full))
  (ModifiedLayout
     (Decoration TabbedDecoration DefaultShrinker) Simplest)
  KeySym
-> ModifiedLayout
     AvoidStruts
     (ModifiedLayout
        SmartBorder
        (Choose
           (Choose HintedTile (Choose HintedTile Full))
           (ModifiedLayout
              (Decoration TabbedDecoration DefaultShrinker) Simplest)))
     KeySym
modifiers = forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout AvoidStruts l a
avoidStruts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout SmartBorder l a
smartBorders

    spawns :: [String]
spawns = [ String
"xmobar"
             , String
"xset -b", String
"xset s off", String
"xset dpms 0 600 1200"
             , String
"nitrogen --set-tiled wallpaper/wallpaper.jpg"
             , String
"trayer --transparent true --expand true --align right "
               forall a. [a] -> [a] -> [a]
++ String
"--edge bottom --widthtype request" ]

    mykeys :: XConfig l -> Map (ButtonMask, KeySym) (X ())
mykeys XConfig{modMask :: forall (l :: * -> *). XConfig l -> ButtonMask
modMask = ButtonMask
modm} = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
        [((ButtonMask
modm,               KeySym
xK_p     ), XPConfig -> X ()
shellPromptHere XPConfig
myPromptConfig)
        ,((ButtonMask
modm forall a. Bits a => a -> a -> a
.|. ButtonMask
shiftMask, KeySym
xK_Return), String -> X ()
spawnHere forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (l :: * -> *). XConfig l -> String
terminal forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config))
        ,((ButtonMask
modm forall a. Bits a => a -> a -> a
.|. ButtonMask
shiftMask, KeySym
xK_c     ), X ()
kill1)
        ,((ButtonMask
modm forall a. Bits a => a -> a -> a
.|. ButtonMask
shiftMask forall a. Bits a => a -> a -> a
.|. ButtonMask
controlMask, KeySym
xK_c     ), X ()
kill)
        ,((ButtonMask
modm forall a. Bits a => a -> a -> a
.|. ButtonMask
shiftMask, KeySym
xK_0     ), (WindowSet -> WindowSet) -> X ()
windows forall s i a l sd.
(Eq s, Eq i, Eq a) =>
StackSet i l a s sd -> StackSet i l a s sd
copyToAll)
        ,((ButtonMask
modm,               KeySym
xK_z     ), forall (l :: * -> *). LayoutClass l Int => Int -> l Int -> X ()
layoutScreens Int
2 forall a b. (a -> b) -> a -> b
$ forall a. Rational -> Rational -> TwoPane a
TwoPane Rational
0.5 Rational
0.5)
        ,((ButtonMask
modm forall a. Bits a => a -> a -> a
.|. ButtonMask
shiftMask, KeySym
xK_z     ), X ()
rescreen)
        , ((ButtonMask
modm             , KeySym
xK_b     ), forall a. Message a => a -> X ()
sendMessage ToggleStruts
ToggleStruts)
        ]

    myFont :: String
myFont = String
"xft:Bitstream Vera Sans Mono:pixelsize=10"
    myTheme :: Theme
myTheme = forall a. Default a => a
def { fontName :: String
fontName = String
myFont }
    myPromptConfig :: XPConfig
myPromptConfig = forall a. Default a => a
def
                        { position :: XPPosition
position = XPPosition
Top
                        , font :: String
font = String
myFont
                        , showCompletionOnTab :: Bool
showCompletionOnTab = Bool
True
                        , historyFilter :: [String] -> [String]
historyFilter = [String] -> [String]
deleteConsecutive
                        , promptBorderWidth :: Button
promptBorderWidth = Button
0 }