forked from colonelpanic/dotfiles
[XMonad] Tweaks
This commit is contained in:
parent
b0b73d0705
commit
fc41bcef17
@ -6,6 +6,7 @@
|
|||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TypeSynonymInstances #-}
|
{-# LANGUAGE TypeSynonymInstances #-}
|
||||||
{-# LANGUAGE TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
|
{-# LANGUAGE PartialTypeSignatures #-}
|
||||||
|
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
@ -94,7 +95,7 @@ import XMonad.Util.WorkspaceCompare
|
|||||||
myConfig = def
|
myConfig = def
|
||||||
{ modMask = mod4Mask
|
{ modMask = mod4Mask
|
||||||
, terminal = "alacritty"
|
, terminal = "alacritty"
|
||||||
, manageHook = myManageHook <+> manageHook def
|
, manageHook = composeOne [ isFullscreen -?> doFullFloat ] <+> manageHook def
|
||||||
, layoutHook = myLayoutHook
|
, layoutHook = myLayoutHook
|
||||||
, borderWidth = 0
|
, borderWidth = 0
|
||||||
, normalBorderColor = "#0096ff"
|
, normalBorderColor = "#0096ff"
|
||||||
@ -237,11 +238,8 @@ volumeCommand = "pavucontrol"
|
|||||||
|
|
||||||
-- Startup hook
|
-- Startup hook
|
||||||
|
|
||||||
tvScreenId :: ScreenId
|
|
||||||
tvScreenId = 1
|
|
||||||
|
|
||||||
hostNameToAction =
|
hostNameToAction =
|
||||||
M.fromList [ ("imalison-uber-loaner", return ())
|
M.fromList [ ("ryzen-shine", return ())
|
||||||
]
|
]
|
||||||
|
|
||||||
myStartup = do
|
myStartup = do
|
||||||
@ -250,12 +248,19 @@ myStartup = do
|
|||||||
hostName <- io getHostName
|
hostName <- io getHostName
|
||||||
M.findWithDefault (return ()) hostName hostNameToAction
|
M.findWithDefault (return ()) hostName hostNameToAction
|
||||||
|
|
||||||
-- Manage hook
|
-- Magnify
|
||||||
|
|
||||||
myManageHook = composeOne [ isFullscreen -?> doFullFloat ]
|
data DisableOnTabbedCondition = DisableOnTabbedCondition deriving (Read, Show)
|
||||||
|
|
||||||
|
instance ModifierCondition DisableOnTabbedCondition where
|
||||||
|
shouldApply _ = do
|
||||||
|
not . isInfixOf "Tabbed" . description . W.layout <$> currentWorkspace
|
||||||
|
|
||||||
|
disableOnTabbed = ConditionalLayoutModifier DisableOnTabbedCondition
|
||||||
|
|
||||||
|
myMagnify = ModifiedLayout $ disableOnTabbed (Mag 1 (1.3, 1.3) On (AllWins 1))
|
||||||
|
|
||||||
-- Toggles
|
-- Toggles
|
||||||
|
|
||||||
unmodifyLayout (ModifiedLayout _ x') = x'
|
unmodifyLayout (ModifiedLayout _ x') = x'
|
||||||
|
|
||||||
selectLimit =
|
selectLimit =
|
||||||
@ -268,16 +273,6 @@ data MyToggles
|
|||||||
| MAGNIFY
|
| MAGNIFY
|
||||||
deriving (Read, Show, Eq, Typeable)
|
deriving (Read, Show, Eq, Typeable)
|
||||||
|
|
||||||
data DisableOnTabbedCondition = DisableOnTabbedCondition deriving (Read, Show)
|
|
||||||
|
|
||||||
instance ModifierCondition DisableOnTabbedCondition where
|
|
||||||
shouldApply _ = do
|
|
||||||
not . isInfixOf "Tabbed" . description . W.layout <$> currentWorkspace
|
|
||||||
|
|
||||||
disableOnTabbed = ConditionalLayoutModifier DisableOnTabbedCondition
|
|
||||||
|
|
||||||
myMagnify = ModifiedLayout $ disableOnTabbed (Mag 1 (1.3, 1.3) On (AllWins 1))
|
|
||||||
|
|
||||||
instance Transformer MyToggles Window where
|
instance Transformer MyToggles Window where
|
||||||
transform LIMIT x k = k (limitSlice 2 x) unmodifyLayout
|
transform LIMIT x k = k (limitSlice 2 x) unmodifyLayout
|
||||||
transform GAPS x k = k (smartSpacing 5 x) unmodifyLayout
|
transform GAPS x k = k (smartSpacing 5 x) unmodifyLayout
|
||||||
@ -556,7 +551,6 @@ setFading w f = setFading' $ M.insert w f
|
|||||||
setFading' f =
|
setFading' f =
|
||||||
XS.get >>= XS.put . (ToggleFade . f . fadesMap)
|
XS.get >>= XS.put . (ToggleFade . f . fadesMap)
|
||||||
|
|
||||||
|
|
||||||
-- Minimize not in class
|
-- Minimize not in class
|
||||||
|
|
||||||
restoreFocus action =
|
restoreFocus action =
|
||||||
@ -678,9 +672,6 @@ focusNextClass' =
|
|||||||
focusNextClass = sameClassOnly focusNextClass'
|
focusNextClass = sameClassOnly focusNextClass'
|
||||||
|
|
||||||
selectClass = myDmenu =<< allClasses
|
selectClass = myDmenu =<< allClasses
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- Gather windows of same class
|
-- Gather windows of same class
|
||||||
|
|
||||||
@ -944,8 +935,7 @@ addKeys conf@XConfig { modMask = modm } =
|
|||||||
, ((hyper .|. shiftMask, xK_l), spawn "dm-tool lock")
|
, ((hyper .|. shiftMask, xK_l), spawn "dm-tool lock")
|
||||||
, ((hyper, xK_l), selectLayout)
|
, ((hyper, xK_l), selectLayout)
|
||||||
, ((hyper, xK_k), spawn "rofi_kill_process.sh")
|
, ((hyper, xK_k), spawn "rofi_kill_process.sh")
|
||||||
, ((hyper .|. shiftMask, xK_k),
|
, ((hyper .|. shiftMask, xK_k), spawn "rofi_kill_all.sh")
|
||||||
spawn "rofi_kill_all.sh")
|
|
||||||
, ((hyper, xK_r), spawn "rofi-systemd")
|
, ((hyper, xK_r), spawn "rofi-systemd")
|
||||||
, ((hyper, xK_9), spawn "start_synergy.sh")
|
, ((hyper, xK_9), spawn "start_synergy.sh")
|
||||||
, ((hyper, xK_slash), spawn "toggle_taffybar")
|
, ((hyper, xK_slash), spawn "toggle_taffybar")
|
||||||
|
Loading…
Reference in New Issue
Block a user