forked from colonelpanic/dotfiles
Merge branch 'master' of github.com:IvanMalison/dotfiles
This commit is contained in:
commit
c18d3ab9a7
1
dotfiles/config/.gitignore
vendored
1
dotfiles/config/.gitignore
vendored
@ -23,6 +23,7 @@
|
|||||||
/mopidy
|
/mopidy
|
||||||
/mopidy/spotify/
|
/mopidy/spotify/
|
||||||
/nemo/
|
/nemo/
|
||||||
|
/pavucontrol.ini
|
||||||
/pulse/
|
/pulse/
|
||||||
/sparkleshare/*.key
|
/sparkleshare/*.key
|
||||||
/sparkleshare/*.pub
|
/sparkleshare/*.pub
|
||||||
|
@ -4,7 +4,7 @@ packages:
|
|||||||
- '.'
|
- '.'
|
||||||
- location:
|
- location:
|
||||||
git: git@github.com:IvanMalison/xmonad-contrib.git
|
git: git@github.com:IvanMalison/xmonad-contrib.git
|
||||||
commit: fb992e96af0d2af4344e3592d179242e72b01fca
|
commit: 1bcb7a31f662cb06dd0e1c51da666694d9ad1836
|
||||||
- location:
|
- location:
|
||||||
git: git@github.com:IvanMalison/taffybar.git
|
git: git@github.com:IvanMalison/taffybar.git
|
||||||
commit: 39e3a95e9c2eae37ff8b67eaa31bbd18503859b1
|
commit: 39e3a95e9c2eae37ff8b67eaa31bbd18503859b1
|
||||||
|
@ -1,4 +1,6 @@
|
|||||||
{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}
|
{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances,
|
||||||
|
MultiParamTypeClasses, ExistentialQuantification,
|
||||||
|
FlexibleInstances, FlexibleContexts #-}
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
@ -61,15 +63,13 @@ main = xmonad $ def
|
|||||||
-- Selectors
|
-- Selectors
|
||||||
|
|
||||||
isHangoutsTitle = isPrefixOf "Google Hangouts"
|
isHangoutsTitle = isPrefixOf "Google Hangouts"
|
||||||
|
|
||||||
chromeSelectorBase = className =? "Google-chrome"
|
chromeSelectorBase = className =? "Google-chrome"
|
||||||
chromeSelector = chromeSelectorBase <&&>
|
|
||||||
fmap (not . isHangoutsTitle) title
|
chromeSelector = chromeSelectorBase <&&> fmap (not . isHangoutsTitle) title
|
||||||
spotifySelector = className =? "Spotify"
|
spotifySelector = className =? "Spotify"
|
||||||
emacsSelector = className =? "Emacs"
|
emacsSelector = className =? "Emacs"
|
||||||
transmissionSelector = fmap (isPrefixOf "Transmission") title
|
transmissionSelector = fmap (isPrefixOf "Transmission") title
|
||||||
hangoutsSelector = chromeSelectorBase <&&>
|
hangoutsSelector = chromeSelectorBase <&&> fmap isHangoutsTitle title
|
||||||
fmap isHangoutsTitle title
|
|
||||||
|
|
||||||
virtualClasses = [ (hangoutsSelector, "Hangouts")
|
virtualClasses = [ (hangoutsSelector, "Hangouts")
|
||||||
, (chromeSelector, "Chrome")
|
, (chromeSelector, "Chrome")
|
||||||
@ -105,14 +105,43 @@ instance Transformer MyToggles Window where
|
|||||||
transform MAGICFOCUS x k = k (magicFocus x) unmodifyLayout
|
transform MAGICFOCUS x k = k (magicFocus x) unmodifyLayout
|
||||||
|
|
||||||
myToggles = [LIMIT, GAPS, MAGICFOCUS]
|
myToggles = [LIMIT, GAPS, MAGICFOCUS]
|
||||||
otherToggles = [FULL, MIRROR]
|
otherToggles = [NBFULL, MIRROR]
|
||||||
|
|
||||||
togglesMap = M.fromList $ [ (show toggle, Toggle toggle) | toggle <- myToggles ] ++
|
togglesMap = fmap M.fromList $ sequence $ map toggleTuple myToggles ++ map toggleTuple otherToggles
|
||||||
[ (show toggle, Toggle toggle) | toggle <- otherToggles ]
|
where
|
||||||
|
toggleTuple toggle = fmap (\str -> (str, Toggle toggle)) (toggleToStringWithState toggle)
|
||||||
|
|
||||||
|
toggleStateToString s = case s of
|
||||||
|
Just True -> "ON"
|
||||||
|
Just False -> "OFF"
|
||||||
|
Nothing -> "N/A"
|
||||||
|
|
||||||
|
toggleToStringWithState :: (Transformer t Window, Show t) => t -> X String
|
||||||
|
toggleToStringWithState toggle = (printf "%s (%s)" (show toggle) . toggleStateToString) <$>
|
||||||
|
isToggleActive toggle
|
||||||
|
|
||||||
selectToggle = do
|
selectToggle = do
|
||||||
Just selectedToggle <- DM.menuMapArgs "rofi" ["-dmenu", "-i"] togglesMap
|
dmenuMap <- togglesMap
|
||||||
|
Just selectedToggle <- DM.menuMapArgs "rofi" ["-dmenu", "-i"] dmenuMap
|
||||||
sendMessage selectedToggle
|
sendMessage selectedToggle
|
||||||
|
|
||||||
|
toggleInState :: (Transformer t Window) => t -> Maybe Bool -> X Bool
|
||||||
|
toggleInState t s = fmap (/= s) (isToggleActive t)
|
||||||
|
|
||||||
|
whenB b a = do
|
||||||
|
when b a
|
||||||
|
return b
|
||||||
|
|
||||||
|
setToggleActive' toggle active = toggleInState toggle (Just active) >>=
|
||||||
|
flip whenB (sendMessage $ Toggle toggle)
|
||||||
|
|
||||||
|
-- Ambiguous type reference without signature
|
||||||
|
setToggleActive :: (Transformer t Window) => t -> Bool -> X ()
|
||||||
|
setToggleActive = (void .) . setToggleActive'
|
||||||
|
|
||||||
|
toggleOr toggle toState action = setToggleActive' toggle toState >>= ((`when` action) . not)
|
||||||
|
|
||||||
|
deactivateFullOr = toggleOr NBFULL False
|
||||||
|
|
||||||
-- Layout setup
|
-- Layout setup
|
||||||
|
|
||||||
@ -139,7 +168,7 @@ selectLayout = do
|
|||||||
|
|
||||||
myLayoutHook = avoidStruts . minimize . boringAuto . mkToggle1 MIRROR .
|
myLayoutHook = avoidStruts . minimize . boringAuto . mkToggle1 MIRROR .
|
||||||
mkToggle1 LIMIT . mkToggle1 GAPS . mkToggle1 MAGICFOCUS .
|
mkToggle1 LIMIT . mkToggle1 GAPS . mkToggle1 MAGICFOCUS .
|
||||||
mkToggle1 FULL . workspaceNamesHook . smartBorders . noBorders $
|
mkToggle1 NBFULL . workspaceNamesHook . smartBorders . noBorders $
|
||||||
fst layoutInfo
|
fst layoutInfo
|
||||||
|
|
||||||
-- WindowBringer
|
-- WindowBringer
|
||||||
@ -343,11 +372,12 @@ addKeys conf@XConfig {modMask = modm} =
|
|||||||
"systemctl --user restart taffybar.service")
|
"systemctl --user restart taffybar.service")
|
||||||
, ((modm, xK_v), spawn "copyq paste")
|
, ((modm, xK_v), spawn "copyq paste")
|
||||||
, ((modm, xK_s), swapNextScreen)
|
, ((modm, xK_s), swapNextScreen)
|
||||||
, ((modm .|. controlMask, xK_space), sendMessage $ Toggle FULL)
|
, ((modm .|. controlMask, xK_space), sendMessage $ Toggle NBFULL)
|
||||||
, ((modm, xK_slash), sendMessage $ Toggle MIRROR)
|
, ((modm, xK_slash), sendMessage $ Toggle MIRROR)
|
||||||
, ((modm, xK_m), withFocused minimizeWindow)
|
, ((modm, xK_m), withFocused minimizeWindow)
|
||||||
, ((modm .|. shiftMask, xK_m), withLastMinimized maximizeWindowAndFocus)
|
, ((modm .|. shiftMask, xK_m), withLastMinimized maximizeWindowAndFocus)
|
||||||
, ((modm, xK_backslash), toggleWS)
|
, ((modm, xK_backslash), toggleWS)
|
||||||
|
, ((modm, xK_space), deactivateFullOr $ sendMessage NextLayout)
|
||||||
|
|
||||||
-- These need to be rebound to support boringWindows
|
-- These need to be rebound to support boringWindows
|
||||||
, ((modm, xK_j), focusDown)
|
, ((modm, xK_j), focusDown)
|
||||||
|
Loading…
Reference in New Issue
Block a user