From 68bbcaeb82c4dccd7b13f99eceb85bb414a77f7e Mon Sep 17 00:00:00 2001 From: Daniele Fucini Date: Mon, 26 Oct 2026 17:49:04 +0100 Subject: [PATCH] Add a keybinding list on M-F1; match games by class pattern; update workspace icons All keys get descriptions (NamedActions) and M-F1 lists them in dmenu. Proton and Wine games go to ws 3 by class prefix/suffix instead of one rule per game; GIMP and Audacity go to ws 5; small tools float; new icons for ws 2-7. --- .config/xmonad/xmonad.hs | 164 ++++++++++++++++++++++++++------------- 1 file changed, 112 insertions(+), 52 deletions(-) diff --git a/.config/xmonad/xmonad.hs b/.config/xmonad/xmonad.hs index ea81435..1e4b083 100644 --- a/.config/xmonad/xmonad.hs +++ b/.config/xmonad/xmonad.hs @@ -1,7 +1,7 @@ -- Import import Data.Monoid -import Graphics.X11.ExtraTypes.XF86 +import Data.Char (toLower) import Control.Monad (forM_, liftM2, when) import Data.Maybe (isJust) import XMonad @@ -27,9 +27,11 @@ import XMonad.Util.ClickableWorkspaces import XMonad.Util.EZConfig import qualified XMonad.Util.Hacks as Hacks import XMonad.Util.Loggers +import XMonad.Util.NamedActions import XMonad.Util.NamedScratchpad -import XMonad.Util.Run (runProcessWithInput) +import XMonad.Util.Run (runProcessWithInput, spawnPipe) import XMonad.Util.SpawnOnce +import System.IO (hClose, hPutStr) -- Main main :: IO () @@ -105,7 +107,7 @@ myScratchpads = -- Config myConfig = - def + addDescrKeys' ((myModMask, xK_F1), showKeys) myKeys $ def { modMask = myModMask, terminal = myTerminal, workspaces = myWorkspaces, @@ -117,44 +119,96 @@ myConfig = handleEventHook = myHandleEventHook, logHook = myLogHook } - `additionalKeysP` [ ("M-b", sendMessage ToggleStruts), - ("M-S-l", spawn "loginctl lock-session"), - ("M-S-n", spawn "dunstctl history-pop"), - ("M-C-n", spawn "dunstctl close-all"), - ("", unGrab *> spawn ("scrot " ++ myScreenshotDir ++ myScreenshotName)), - ("S-", unGrab *> spawn ("scrot -s " ++ myScreenshotDir ++ myScreenshotName)), - ("M-S-", unGrab *> spawn ("scrot -u " ++ myScreenshotDir ++ myScreenshotName)), - ("M-d", spawn "dmenu_run"), - ("M-p", spawn "passmenu -i"), - ("M-f", sendMessage $ JumpToLayout "Tabbed"), - ("M-i", spawn $ "setxkbmap" ++ myKeyboardLayoutIT), - ("M-u", spawn $ "setxkbmap" ++ myKeyboardLayoutUS), - ("M-s", spawn $ "setxkbmap" ++ myKeyboardLayoutSK), - ("M-S-v", namedScratchpadAction myScratchpads "Riseup-vpn"), - ("M-S-s", namedScratchpadAction myScratchpads "Terminal"), - ("M-S-a", namedScratchpadAction myScratchpads "Cal"), - ("M-o", namedScratchpadAction myScratchpads "Btop"), - ("M-x", spawn "bluetoothctl connect F4:9D:8A:B9:8C:EE"), - ("M-S-x", spawn "bluetoothctl disconnect F4:9D:8A:B9:8C:EE") - ] - `additionalKeys` [ ((0, xF86XK_AudioMute), spawn "pactl set-sink-mute $(pactl get-default-sink) toggle"), - ((0, xF86XK_AudioLowerVolume), spawn "pactl set-sink-volume $(pactl get-default-sink) -10%"), - ((0, xF86XK_AudioRaiseVolume), spawn "wpctl set-volume -l 1.0 @DEFAULT_AUDIO_SINK@ 10%+"), - ((0, xF86XK_AudioPlay), spawn "playerctl play-pause"), - ((0, xF86XK_AudioPause), spawn "playerctl pause"), - ((0, xF86XK_AudioStop), spawn "playerctl stop"), - ((0, xF86XK_AudioNext), spawn "playerctl next"), - ((0, xF86XK_AudioPrev), spawn "playerctl previous"), - ((0, xF86XK_Calculator), spawn "qalculate-gtk"), - ((0, xF86XK_HomePage), spawn myBrowser), - ((0, xF86XK_Mail), namedScratchpadAction myScratchpads "Mail"), - ((0, xF86XK_Tools), namedScratchpadAction myScratchpads "Music") - ] - ++ [ ((myModMask .|. mask, key), f sc) - | (key, sc) <- zip [xK_w, xK_e] [0 ..], - (f, mask) <- [(viewScreen def, 0), (sendToScreen def, shiftMask)] - ] - ++ [((myModMask, key), windows $ safeView ws) | (ws, key) <- zip myWorkspaces [xK_1 .. xK_9]] + +-- Keys +-- xmonad's described defaults minus the ones overridden here, so M- lists each key once +myKeys :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)] +myKeys c = dropEmptyGroups (filter ((`notElem` overridden) . fst) (defaultKeysDescr c)) ++ custom + where + custom = myCustomKeys c + -- M-r/M-S-r: there's no third screen + overridden = (myModMask, xK_r) : (myModMask .|. shiftMask, xK_r) : filter (/= (0, 0)) (map fst custom) + -- (0, 0) is a subtitle or separator; drop it when nothing follows before the next one + dropEmptyGroups (((0, 0), _) : rest@(((0, 0), _) : _)) = dropEmptyGroups rest + dropEmptyGroups [((0, 0), _)] = [] + dropEmptyGroups (x : rest) = x : dropEmptyGroups rest + dropEmptyGroups [] = [] + +myCustomKeys :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)] +myCustomKeys c = + concatMap + (\(t, ks) -> subtitle t : mkNamedKeymap c ks) + [ ( "launchers", + [ ("M-d", addName "Run a program (dmenu)" $ spawn "dmenu_run"), + ("M-p", addName "Passwords (passmenu)" $ spawn "passmenu -i"), + ("", addName "Browser" $ spawn myBrowser), + ("", addName "Calculator" $ spawn "qalculate-gtk") + ] + ), + ( "scratchpads", + [ ("M-S-s", addName "Terminal" $ namedScratchpadAction myScratchpads "Terminal"), + ("M-S-a", addName "Calendar (calcurse)" $ namedScratchpadAction myScratchpads "Cal"), + ("M-o", addName "btop" $ namedScratchpadAction myScratchpads "Btop"), + ("M-S-v", addName "RiseupVPN" $ namedScratchpadAction myScratchpads "Riseup-vpn"), + ("", addName "Mail (mutt)" $ namedScratchpadAction myScratchpads "Mail"), + ("", addName "Music (ncmpcpp)" $ namedScratchpadAction myScratchpads "Music") + ] + ), + ( "session and layout", + [ ("M-S-l", addName "Lock the screen" $ spawn "loginctl lock-session"), + ("M-S-n", addName "Show older notification" $ spawn "dunstctl history-pop"), + ("M-C-n", addName "Close all notifications" $ spawn "dunstctl close-all"), + ("M-b", addName "Toggle the status bar gap" $ sendMessage ToggleStruts), + ("M-f", addName "Tabbed layout" $ sendMessage $ JumpToLayout "Tabbed"), + ("M-i", addName "Keyboard: Italian" $ spawn $ "setxkbmap" ++ myKeyboardLayoutIT), + ("M-u", addName "Keyboard: US" $ spawn $ "setxkbmap" ++ myKeyboardLayoutUS), + ("M-s", addName "Keyboard: Slovak" $ spawn $ "setxkbmap" ++ myKeyboardLayoutSK), + ("M-x", addName "Connect earbuds" $ spawn "bluetoothctl connect F4:9D:8A:B9:8C:EE"), + ("M-S-x", addName "Disconnect earbuds" $ spawn "bluetoothctl disconnect F4:9D:8A:B9:8C:EE") + ] + ), + ( "screenshots", + [ ("", addName "Whole screen" $ unGrab *> spawn ("scrot " ++ myScreenshotDir ++ myScreenshotName)), + ("S-", addName "Select an area" $ unGrab *> spawn ("scrot -s " ++ myScreenshotDir ++ myScreenshotName)), + ("M-S-", addName "Focused window" $ unGrab *> spawn ("scrot -u " ++ myScreenshotDir ++ myScreenshotName)) + ] + ), + ( "media keys", + [ ("", addName "Mute" $ spawn "pactl set-sink-mute $(pactl get-default-sink) toggle"), + ("", addName "Volume down" $ spawn "pactl set-sink-volume $(pactl get-default-sink) -10%"), + ("", addName "Volume up" $ spawn "wpctl set-volume -l 1.0 @DEFAULT_AUDIO_SINK@ 10%+"), + ("", addName "Play/pause" $ spawn "playerctl play-pause"), + ("", addName "Pause" $ spawn "playerctl pause"), + ("", addName "Stop" $ spawn "playerctl stop"), + ("", addName "Next track" $ spawn "playerctl next"), + ("", addName "Previous track" $ spawn "playerctl previous") + ] + ), + ( "workspaces and screens", + [ (m ++ show n, addName (d ++ show n ++ " (" ++ name ++ ")") $ windows $ f ws) + | (n, ws, name) <- zip3 [1 :: Int ..] myWorkspaces ["terminal", "web", "games", "chat", "media", "docs", "VM", "free", "free"], + (m, d, f) <- [("M-", "Workspace ", safeView), ("M-S-", "Send window to workspace ", W.shift)] + ] + ++ [ (m ++ k, addName (d ++ side) $ f def sc) + | (k, sc, side) <- [("w", 0, "left screen"), ("e", 1, "right screen")], + (m, d, f) <- [("M-", "Focus ", viewScreen), ("M-S-", "Send window to ", sendToScreen)] + ] + ) + ] + +-- Shows the key list in dmenu (type to filter; picking a line does nothing). +-- spawnPipe rather than runProcessWithInput, which would block xmonad while dmenu is open. +showKeys :: [((KeyMask, KeySym), NamedAction)] -> NamedAction +showKeys ks = addName "Show keybindings" $ do + h <- spawnPipe "dmenu -i -l 30 -p Keys" + io $ hPutStr h (unlines $ map tidy $ filter (not . null) $ lines $ unlines $ showKm ks) >> hClose h + where + -- showKm writes the mod key as M4- (it doesn't know modMask); re-pad after shortening it + tidy l@('>' : _) = l + tidy l = let (k, d) = break (== ' ') l in take 24 (fixMod k ++ repeat ' ') ++ dropWhile (== ' ') d + fixMod ('M' : '4' : '-' : r) = "M-" ++ fixMod r + fixMod (x : r) = x : fixMod r + fixMod [] = [] -- greedyView that keeps wsGames on screen 0 (HDMI): Wine games lose the mouse when moved between screens safeView :: WorkspaceId -> WindowSet -> WindowSet @@ -185,14 +239,15 @@ safeRescreen = do myWorkspaces :: [String] myWorkspaces = [wsTerm, wsWeb, wsGames, wsChat, wsMedia, wsDocs, wsVM] ++ map show [8, 9] +-- Icons spill past their advance in the non-Mono Nerd Font: keep them ~1000-1160 units wide or gaps look uneven wsTerm, wsWeb, wsGames, wsChat, wsMedia, wsDocs, wsVM :: String wsTerm = "1:\xf489 " -wsWeb = "2:\xe743 " -wsGames = "3:\xf1b6 " -wsChat = "4:\xf10b " -wsMedia = "5:\xead9 " -wsDocs = "6:\xeb69 " -wsVM = "7:\xea7a " +wsWeb = "2:\xf0ac " +wsGames = "3:\xf11b " +wsChat = "4:\xf086 " +wsMedia = "5:\xefab " +wsDocs = "6:\xede2 " +wsVM = "7:\xf108 " -- Layout myLayoutHook = onWorkspace wsWeb myWebLayout $ onWorkspace wsGames myGamesLayout $ onWorkspace wsMedia myVideoLayout myDefaultLayout @@ -290,10 +345,15 @@ myStartupHook = do myManageHook :: ManageHook myManageHook = composeAll - [ className =? "Gpodder" --> doShift wsMedia, + [ -- Proton games are steam_app_; Wine windows are named after their .exe + className ^? "steam_app_" --> doShift wsGames, + className $? ".exe" --> doShift wsGames, + className =? "Gpodder" --> doShift wsMedia, className =? "An Anime Game Launcher" --> doShift wsGames, className =? "Qalculate-gtk" --> doFloat, title =? "Genshin Impact" --> doShift wsGames, + classIn ["gimp", "audacity"] --> doShift wsMedia, + classIn ["pavucontrol", "org.pulseaudio.pavucontrol", "zenity", "org.gnome.zenity", "lxappearance", "qt5ct", "qt6ct"] --> doFloat, className =? "Signal" --> doShift wsChat, className =? "Spotify" --> doShift wsMedia, className =? "Transmission-gtk" --> doShift wsWeb, @@ -303,7 +363,6 @@ myManageHook = className =? "Xreader" --> doShift wsDocs, className =? "calibre" --> doShift wsDocs, className =? "discord" --> doShift wsChat, - className =? "explorer.exe" --> doShift wsGames, className =? "feh" --> doFloat, title =? "glxgears" --> doFloat, className =? "library_manager" --> doShift wsDocs, @@ -316,9 +375,7 @@ myManageHook = className =? "scrcpy" --> doShift wsMedia, className =? "steam" --> doShift wsGames, className =? "steam_app_109600" --> doFloat, - className =? "steam_app_109600" --> doShift wsGames, className =? "steam_app_289070" --> doFloat, - className =? "steam_app_289070" --> doShift wsGames, className =? "VirtualBox Machine" --> doShift wsVM, className =? "VirtualBox Machine" --> doFullFloat, className =? "VirtualBox Manager" --> doShift wsVM, @@ -328,7 +385,10 @@ myManageHook = isFullscreen --> doFullFloat ] <+> namedScratchpadManageHook myScratchpads - where viewShift = doF . liftM2 (.) safeView W.shift + where + viewShift = doF . liftM2 (.) safeView W.shift + -- Case-insensitive, as GTK4 and firejailed apps capitalise their class differently + classIn names = (`elem` names) . map toLower <$> className -- Handle event hook myHandleEventHook :: Event -> X All