This commit is contained in:
Leon Kowarschick 2020-03-23 20:23:31 +01:00
parent 6643211753
commit 6132c83d5d
6 changed files with 328 additions and 51 deletions

View file

@ -0,0 +1,254 @@
{-# Language ScopedTypeVariables #-}
-- Imports -------------------------------------------------------- {{{
module Config (main) where
import qualified Data.Map as M
import Data.List (isSuffixOf, isPrefixOf)
import qualified Data.Maybe as Maybe
import Data.Char (isDigit)
import System.Exit (exitWith, ExitCode(ExitSuccess))
import qualified Data.Monoid
import qualified DBus as D
import qualified DBus.Client as D
import qualified Codec.Binary.UTF8.String as UTF8
import XMonad hiding ((|||))
import qualified XMonad.Util.Dmenu as Dmenu
import qualified XMonad.StackSet as W
import XMonad.Actions.CopyWindow
import XMonad.Actions.Submap
import XMonad.Config.Desktop
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.ManageHelpers
import XMonad.Hooks.FadeInactive
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.EwmhDesktops (fullscreenEventHook)
import XMonad.Hooks.SetWMName (setWMName)
import XMonad.Layout.Gaps
import XMonad.Layout.LayoutHints
import XMonad.Layout.LayoutCombinators ((|||))
import XMonad.Layout.NoBorders -- for fullscreen without borders
import XMonad.Layout.ResizableTile -- for resizeable tall layout
import XMonad.Layout.Spacing
import XMonad.Layout.Spiral
import XMonad.Layout.ThreeColumns -- for three column layout
import XMonad.Layout.ToggleLayouts
import XMonad.Util.EZConfig (additionalKeysP, removeKeysP)
import XMonad.Util.NamedScratchpad
import XMonad.Util.Run
import XMonad.Util.SpawnOnce (spawnOnce)
-- }}}
-- Values -------------------- {{{
myModMask = mod4Mask
myLauncher = "rofi -show run"
myTerminal = "kitty --single-instance"
myBrowser = "google-chrome-stable"
--yBar = "xmobar"
--myXmobarPP= xmobarPP { ppCurrent = xmobarColor "#429942" "" . wrap "<" ">" }
scratchpads :: [NamedScratchpad]
scratchpads =
[ NS "terminal" (myTerminal ++ " --class scratchpad_term") (className =? "scratchpad_term")
(customFloating $ W.RationalRect 0 0.7 1 0.3)
, NS "ghci" (myTerminal ++ " -e \"stack exec -- ghci\" --class scratchpad_ghci") (className =? "scratchpad_ghci")
(customFloating $ W.RationalRect 0 0.7 1 0.3)
, NS "whatsapp" ("gtk-launch chrome-hnpfjngllnobngcgfapefoaidbinmjnm-Default.desktop") (("WhatsApp" `isSuffixOf`) <$> title) defaultFloating
, NS "slack" ("slack") (("Slack | " `isPrefixOf`) <$> title) defaultFloating
]
{-| adds the scripts-directory path to the filename of a script |-}
scriptFile :: String -> String
scriptFile script = "/home/leon/scripts/" ++ script
-- Colors ------ {{{
fg = "#ebdbb2"
bg = "#282828"
gray = "#a89984"
bg1 = "#3c3836"
bg2 = "#504945"
bg3 = "#665c54"
bg4 = "#7c6f64"
green = "#b8bb26"
darkgreen = "#98971a"
red = "#fb4934"
darkred = "#cc241d"
yellow = "#fabd2f"
blue = "#83a598"
purple = "#d3869b"
aqua = "#8ec07c"
-- }}}
-- }}}
-- Layout ---------------------------------------- {{{
myLayout = smartBorders $ toggleLayouts Full $ withSpacing $ layoutHints
( ResizableTall 1 (3/100) (1/2) []
||| Mirror (ResizableTall 1 (3/100) (3/4) [])
||| spiral (6/7) -- Grid
||| ThreeColMid 1 (3/100) (1/2)
)
-- mouseResizableTile ||| Mirror mouseResizableTile
where
-- add spacing between windows
withSpacing = spacingRaw True (Border 10 10 10 10) True (Border 7 7 7 7) True
--withGaps = gaps' [((L, 10), True),((U, 10), True), ((D, 10), True), ((R, 10), True )]
-- }}}
-- Loghook -------------------------------------- {{{
myLogHook :: X ()
myLogHook = do
fadeInactiveLogHook 0.95 -- opacity of unfocused windows
-- }}}
-- Startuphook ----------------------------- {{{
myStartupHook :: X ()
myStartupHook = do
spawnOnce "picom --config ~/.config/picom.conf --no-fading-openclose"
spawnOnce "pasystray"
spawn "/home/leon/.config/polybar/launch.sh"
setWMName "LG3D" -- Java stuff hack
-- }}}
-- Keymap --------------------------------------- {{{
-- Default mappings that need to be removed removedKeys :: [String]
removedKeys = ["M-S-c", "M-S-q"]
myKeys :: [(String, X ())]
myKeys = [ ("M-C-k", sendMessage MirrorExpand)
, ("M-C-j", sendMessage MirrorShrink)
, ("M-f", toggleFullscreen)
, ("M-S-C-c", kill1)
, ("M-S-C-a", windows copyToAll) -- windows: Modify the current window list with a pure function, and refresh
, ("M-C-c", killAllOtherCopies)
, ("M-S-C-q", io $ exitWith ExitSuccess)
-- programs
, ("M-p", spawn myLauncher)
, ("M-S-p", spawn "rofi -combi-modi drun,window,ssh -show combi")
, ("M-S-e", spawn "rofi -show emoji -modi emoji")
, ("M-b", spawn myBrowser)
, ("M-s", spawn $ scriptFile "rofi-search.sh")
, ("M-S-s", spawn $ "cat " ++ scriptFile "bookmarks" ++ " | rofi -p open -dmenu | bash")
, ("M-n", spawn "echo 'n: terminal, h: ghci, w: WhatsApp, s: slack' | dzen2 -p 1" >> scratchpadSubmap)
, ("M-e", promptExecute specialCommands)
] ++ copyToWorkspaceMappings
where
copyToWorkspaceMappings :: [(String, X())]
copyToWorkspaceMappings = [("M-C-" ++ wsp, windows $ copy wsp) | wsp <- map show [1..9]]
toggleFullscreen :: X ()
toggleFullscreen = do
sendMessage ToggleLayout -- toggle fullscreen layout
sendMessage ToggleStruts -- bar is hidden -> no need to make place for it
--sendMessage ToggleGaps -- show a small gap around the window
safeSpawn "polybar-msg" ["cmd", "toggle"] -- toggle polybar visibility
scratchpadSubmap :: X ()
scratchpadSubmap = submap $ M.fromList
[ ((myModMask, xK_n), namedScratchpadAction scratchpads "terminal")
, ((myModMask, xK_h), namedScratchpadAction scratchpads "ghci")
, ((myModMask, xK_w), namedScratchpadAction scratchpads "whatsapp")
, ((myModMask, xK_s), namedScratchpadAction scratchpads "slack") ]
specialCommands :: [(String, X ())]
specialCommands =
[ ("toggleSpacing", toggleWindowSpacingEnabled)
, ("toggleGaps", sendMessage ToggleGaps)
, ("screenshot", spawn $ scriptFile "screenshot.sh")
]
promptExecute :: [(String, X ())] -> X ()
promptExecute commands = do
selection <- Dmenu.menuMapArgs "rofi" ["-dmenu", "-i"] $ M.fromList commands -- -i -> case-insensitive
Maybe.fromMaybe (return ()) selection
-- }}}
-- ManageHook -------------------------------{{{
myManageHook :: Query (Data.Monoid.Endo WindowSet)
myManageHook = composeAll
[ resource =? "Dialog" --> doFloat
-- , isFullscreen --> doF W.focusDown <+> doFullFloat
, manageDocks
, namedScratchpadManageHook scratchpads
]
-- }}}
-- Main ------------------------------------ {{{
main :: IO ()
main = do
dbus <- D.connectSession
-- Request access to the DBus name
_ <- D.requestName dbus (D.busName_ "org.xmonad.Log")
[D.nameAllowReplacement, D.nameReplaceExisting, D.nameDoNotQueue]
-- $ ewmh (kills IntelliJ)
xmonad $ desktopConfig
{ terminal = myTerminal
, modMask = myModMask
, borderWidth = 1
, layoutHook = avoidStruts myLayout
, logHook = myLogHook <+> dynamicLogWithPP (polybarPP dbus) <+> logHook def
, startupHook = myStartupHook <+> startupHook def
, manageHook = myManageHook <+> manageHook def
--, handleEventHook = fullscreenEventHook
, focusedBorderColor = aqua
, normalBorderColor = "#282828"
} `removeKeysP` removedKeys `additionalKeysP` myKeys
-- }}}
-- POLYBAR Kram -------------------------------------- {{{
polybarPP :: D.Client -> PP
polybarPP dbus = namedScratchpadFilterOutWorkspacePP $ def
{ ppOutput = dbusOutput dbus
, ppCurrent = withBG bg2
, ppVisible = withBG bg2
, ppUrgent = withFG red
, ppLayout = removeWord "Hinted" . removeWord "Spacing" . withFG purple
, ppHidden = wrap " " " " . unwords . map wrapOpenWorkspaceCmd . words
, ppWsSep = ""
, ppSep = " | "
, ppExtras = []
, ppTitle = withFG aqua . (shorten 40)
}
where
removeWord substr = unwords . filter (/= substr) . words
withBG col = wrap ("%{B" ++ col ++ "} ") " %{B-}"
withFG col = wrap ("%{F" ++ col ++ "} ") " %{F-}"
wrapOpenWorkspaceCmd wsp
| all isDigit wsp = wrapOnClickCmd ("xdotool key super+" ++ wsp) wsp
| otherwise = wsp
wrapOnClickCmd command = wrap ("%{A1:" ++ command ++ ":}") "%{A}"
-- Emit a DBus signal on log updates
dbusOutput :: D.Client -> String -> IO ()
dbusOutput dbus str = do
let signal = (D.signal objectPath interfaceName memberName) {
D.signalBody = [D.toVariant $ UTF8.decodeString str]
}
D.emit dbus signal
where
objectPath = D.objectPath_ "/org/xmonad/Log"
interfaceName = D.interfaceName_ "org.xmonad.Log"
memberName = D.memberName_ "Update"
-- }}}

View file

@ -1,8 +1,8 @@
{-# Language ScopedTypeVariables #-} {-# Language ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-binds #-}
-- Imports -------------------------------------------------------- {{{ -- Imports -------------------------------------------------------- {{{
module Config (main) where module Config (main) where
import qualified Data.Map as M import qualified Data.Map as M
import Data.List (isSuffixOf, isPrefixOf) import Data.List (isSuffixOf, isPrefixOf)
import qualified Data.Maybe as Maybe import qualified Data.Maybe as Maybe
@ -21,20 +21,20 @@ import XMonad.Actions.Submap
import XMonad.Config.Desktop import XMonad.Config.Desktop
import XMonad.Hooks.DynamicLog import XMonad.Hooks.DynamicLog
import XMonad.Hooks.ManageHelpers
import XMonad.Hooks.FadeInactive import XMonad.Hooks.FadeInactive
import XMonad.Hooks.ManageDocks import XMonad.Hooks.ManageDocks
import XMonad.Hooks.EwmhDesktops (fullscreenEventHook)
import XMonad.Hooks.SetWMName (setWMName) import XMonad.Hooks.SetWMName (setWMName)
import XMonad.Layout.Gaps import XMonad.Layout.Gaps
import XMonad.Layout.LayoutHints
import XMonad.Layout.LayoutCombinators ((|||)) import XMonad.Layout.LayoutCombinators ((|||))
import XMonad.Layout.NoBorders -- for fullscreen without borders import XMonad.Layout.NoBorders -- for fullscreen without borders
import XMonad.Layout.ResizableTile -- for resizeable tall layout import XMonad.Layout.ResizableTile -- for resizeable tall layout
import XMonad.Layout.MouseResizableTile
import XMonad.Layout.Spacing import XMonad.Layout.Spacing
import XMonad.Layout.Spiral import XMonad.Layout.Spiral
import XMonad.Layout.Renamed (renamed, Rename(Replace))
import XMonad.Layout.ThreeColumns -- for three column layout import XMonad.Layout.ThreeColumns -- for three column layout
import XMonad.Layout.ToggleLayouts import XMonad.Layout.ToggleLayouts
import XMonad.Layout.ZoomRow
import XMonad.Util.EZConfig (additionalKeysP, removeKeysP) import XMonad.Util.EZConfig (additionalKeysP, removeKeysP)
import XMonad.Util.NamedScratchpad import XMonad.Util.NamedScratchpad
import XMonad.Util.Run import XMonad.Util.Run
@ -53,13 +53,15 @@ myBrowser = "google-chrome-stable"
scratchpads :: [NamedScratchpad] scratchpads :: [NamedScratchpad]
scratchpads = scratchpads =
[ NS "terminal" (myTerminal ++ " --class scratchpad_term") (className =? "scratchpad_term") [ NS "terminal" launchTerminal (className =? "scratchpad_term") (customFloating $ W.RationalRect 0 0.7 1 0.3)
(customFloating $ W.RationalRect 0 0.7 1 0.3) , NS "ghci" launchGHCI (className =? "scratchpad_ghci") (customFloating $ W.RationalRect 0 0.7 1 0.3)
, NS "ghci" (myTerminal ++ " -e \"stack exec -- ghci\" --class scratchpad_ghci") (className =? "scratchpad_ghci") , NS "whatsapp" launchWhatsapp (("WhatsApp" `isSuffixOf`) <$> title) defaultFloating
(customFloating $ W.RationalRect 0 0.7 1 0.3) , NS "slack" "slack" (("Slack | " `isPrefixOf`) <$> title) defaultFloating
, NS "whatsapp" ("gtk-launch chrome-hnpfjngllnobngcgfapefoaidbinmjnm-Default.desktop") (("WhatsApp" `isSuffixOf`) <$> title) defaultFloating
, NS "slack" ("slack") (("Slack | " `isPrefixOf`) <$> title) defaultFloating
] ]
where
launchTerminal = myTerminal ++ " --class scratchpad_term"
launchGHCI = myTerminal ++ " -e \"stack exec -- ghci\" --class scratchpad_ghci"
launchWhatsapp = "gtk-launch chrome-hnpfjngllnobngcgfapefoaidbinmjnm-Default.desktop"
{-| adds the scripts-directory path to the filename of a script |-} {-| adds the scripts-directory path to the filename of a script |-}
scriptFile :: String -> String scriptFile :: String -> String
@ -87,17 +89,23 @@ aqua = "#8ec07c"
-- }}} -- }}}
-- Layout ---------------------------------------- {{{ -- Layout ---------------------------------------- {{{
myLayout = smartBorders $ toggleLayouts Full $ withSpacing $ layoutHints --layoutHints .
( ResizableTall 1 (3/100) (1/2) [] myLayout = avoidStruts . smartBorders . toggleLayouts Full $ layouts
||| Mirror (ResizableTall 1 (3/100) (3/4) [])
||| spiral (6/7) -- Grid
||| ThreeColMid 1 (3/100) (1/2)
)
-- mouseResizableTile ||| Mirror mouseResizableTile
where where
-- add spacing between windows layouts = ((rename "tall" $ withGaps (gap * 2) $ mouseResizableTile {draggerType = dragger}) -- ResizableTall 1 (3/100) (1/2) []
withSpacing = spacingRaw True (Border 10 10 10 10) True (Border 7 7 7 7) True ||| (rename "horizon" $ withGaps (gap * 2) $ mouseResizableTileMirrored {draggerType = dragger}) -- Mirror $ ResizableTall 1 (3/100) (3/4) []
--withGaps = gaps' [((L, 10), True),((U, 10), True), ((D, 10), True), ((R, 10), True )] ||| (rename "row" $ withGaps gap $ spacing gap zoomRow)
||| (rename "threeCol" $ withGaps gap $ spacing gap $ ThreeColMid 1 (3/100) (1/2))
||| (rename "spiral" $ withGaps gap $ spacing gap $ spiral (9/21)))
-- ||| (rename "spiral" $ spiral (6/7)))
-- Grid
withGaps width = gaps [ (dir, width) | dir <- [L, R, D, U] ]
rename name = renamed [Replace name]
gap = 7
dragger = FixedDragger (fromIntegral gap * 2) (fromIntegral gap * 2)
-- }}} -- }}}
-- Loghook -------------------------------------- {{{ -- Loghook -------------------------------------- {{{
@ -125,23 +133,27 @@ myStartupHook = do
removedKeys = ["M-S-c", "M-S-q"] removedKeys = ["M-S-c", "M-S-q"]
myKeys :: [(String, X ())] myKeys :: [(String, X ())]
myKeys = [ ("M-C-k", sendMessage MirrorExpand) myKeys = [ ("M-C-k", sendMessage MirrorExpand >> sendMessage ShrinkSlave )
, ("M-C-j", sendMessage MirrorShrink) , ("M-C-j", sendMessage MirrorShrink >> sendMessage ExpandSlave )
, ("M-f", toggleFullscreen) , ("M-+", sendMessage zoomIn)
, ("M-S-C-c", kill1) , ("M--", sendMessage zoomOut)
, ("M-S-C-a", windows copyToAll) -- windows: Modify the current window list with a pure function, and refresh , ("M-<Backspace>", sendMessage zoomReset)
, ("M-C-c", killAllOtherCopies)
, ("M-S-C-q", io $ exitWith ExitSuccess) , ("M-f", toggleFullscreen)
, ("M-S-C-c", kill1)
, ("M-S-C-a", windows copyToAll) -- windows: Modify the current window list with a pure function, and refresh
, ("M-C-c", killAllOtherCopies)
, ("M-S-C-q", io $ exitWith ExitSuccess)
-- programs -- programs
, ("M-p", spawn myLauncher) , ("M-p", spawn myLauncher)
, ("M-S-p", spawn "rofi -combi-modi drun,window,ssh -show combi") , ("M-S-p", spawn "rofi -combi-modi drun,window,ssh -show combi")
, ("M-S-e", spawn "rofi -show emoji -modi emoji") , ("M-S-e", spawn "rofi -show emoji -modi emoji")
, ("M-b", spawn myBrowser) , ("M-b", spawn myBrowser)
, ("M-s", spawn $ scriptFile "rofi-search.sh") , ("M-s", spawn $ scriptFile "rofi-search.sh")
, ("M-S-s", spawn $ "cat " ++ scriptFile "bookmarks" ++ " | rofi -p open -dmenu | bash") , ("M-S-s", spawn $ "cat " ++ scriptFile "bookmarks" ++ " | rofi -p open -dmenu | bash")
, ("M-n", spawn "echo 'n: terminal, h: ghci, w: WhatsApp, s: slack' | dzen2 -p 1" >> scratchpadSubmap) , ("M-n", spawn "echo 'n: terminal, h: ghci, w: WhatsApp, s: slack' | dzen2 -p 1" >> scratchpadSubmap)
, ("M-e", promptExecute specialCommands) , ("M-e", promptExecute specialCommands)
] ++ copyToWorkspaceMappings ] ++ copyToWorkspaceMappings
where where
@ -182,7 +194,7 @@ myKeys = [ ("M-C-k", sendMessage MirrorExpand)
myManageHook :: Query (Data.Monoid.Endo WindowSet) myManageHook :: Query (Data.Monoid.Endo WindowSet)
myManageHook = composeAll myManageHook = composeAll
[ resource =? "Dialog" --> doFloat [ resource =? "Dialog" --> doFloat
, isFullscreen --> doF W.focusDown <+> doFullFloat -- , isFullscreen --> doF W.focusDown <+> doFullFloat
, manageDocks , manageDocks
, namedScratchpadManageHook scratchpads , namedScratchpadManageHook scratchpads
] ]
@ -202,7 +214,7 @@ main = do
{ terminal = myTerminal { terminal = myTerminal
, modMask = myModMask , modMask = myModMask
, borderWidth = 1 , borderWidth = 1
, layoutHook = avoidStruts myLayout , layoutHook = myLayout
, logHook = myLogHook <+> dynamicLogWithPP (polybarPP dbus) <+> logHook def , logHook = myLogHook <+> dynamicLogWithPP (polybarPP dbus) <+> logHook def
, startupHook = myStartupHook <+> startupHook def , startupHook = myStartupHook <+> startupHook def
, manageHook = myManageHook <+> manageHook def , manageHook = myManageHook <+> manageHook def
@ -251,3 +263,4 @@ dbusOutput dbus str = do
memberName = D.memberName_ "Update" memberName = D.memberName_ "Update"
-- }}} -- }}}

Binary file not shown.

View file

@ -0,0 +1,4 @@
-- While building package my-xmonad-0.1.0.0 using:
/home/leon/.stack/setup-exe-cache/x86_64-linux-tinfo6/Cabal-simple_mPHDZzAJ_3.0.1.0_ghc-8.8.2 --builddir=.stack-work/dist/x86_64-linux-tinfo6/Cabal-3.0.1.0 build exe:my-xmonad --ghc-options ""
Process exited with code: ExitFailure 1

6
files/scripts/foo.hs Normal file
View file

@ -0,0 +1,6 @@
-- |
module foo where
main :: Int
main = "hi"