ENH noop programs that are missing
This commit is contained in:
parent
359312ff50
commit
dd4f45f61c
269
bin/xmonad.hs
269
bin/xmonad.hs
|
@ -14,7 +14,7 @@ import Data.List
|
||||||
, sortBy
|
, sortBy
|
||||||
, sortOn
|
, sortOn
|
||||||
)
|
)
|
||||||
import Data.Maybe (isJust)
|
import Data.Maybe (isJust, mapMaybe)
|
||||||
import Data.Monoid (All (..))
|
import Data.Monoid (All (..))
|
||||||
|
|
||||||
import Graphics.X11.Types
|
import Graphics.X11.Types
|
||||||
|
@ -74,9 +74,10 @@ main = do
|
||||||
, childPIDs = [p]
|
, childPIDs = [p]
|
||||||
, childHandles = [h]
|
, childHandles = [h]
|
||||||
}
|
}
|
||||||
|
ekbs <- evalExternal $ externalBindings ts
|
||||||
launch
|
launch
|
||||||
$ ewmh
|
$ ewmh
|
||||||
$ addKeymap ts
|
$ addKeymap (filterExternal ekbs)
|
||||||
$ def { terminal = myTerm
|
$ def { terminal = myTerm
|
||||||
, modMask = myModMask
|
, modMask = myModMask
|
||||||
, layoutHook = myLayouts
|
, layoutHook = myLayouts
|
||||||
|
@ -369,126 +370,162 @@ xMsgEventHook _ = return (All True)
|
||||||
myModMask :: KeyMask
|
myModMask :: KeyMask
|
||||||
myModMask = mod4Mask
|
myModMask = mod4Mask
|
||||||
|
|
||||||
addKeymap :: ThreadState -> XConfig l -> XConfig l
|
addKeymap :: [KeyGroup (X ())] -> XConfig l -> XConfig l
|
||||||
addKeymap ts = addDescrKeys' ((myModMask, xK_F1), runShowKeys) (mkKeys ts)
|
addKeymap external = addDescrKeys' ((myModMask, xK_F1), runShowKeys)
|
||||||
|
(\c -> concatMap (mkNamedSubmap c) $ internalBindings c ++ external)
|
||||||
|
|
||||||
mkKeys :: ThreadState -> XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
|
internalBindings :: XConfig Layout -> [KeyGroup (X ())]
|
||||||
mkKeys ts c =
|
internalBindings c =
|
||||||
mkNamedSubmap "Window Layouts"
|
[ KeyGroup "Window Layouts"
|
||||||
[ ("M-j", "focus down", windows W.focusDown)
|
[ KeyBinding "M-j" "focus down" $ windows W.focusDown
|
||||||
, ("M-k", "focus up", windows W.focusUp)
|
, KeyBinding "M-k" "focus up" $ windows W.focusUp
|
||||||
, ("M-m", "focus master", windows W.focusMaster)
|
, KeyBinding "M-m" "focus master" $ windows W.focusMaster
|
||||||
, ("M-d", "focus master", runHide)
|
, KeyBinding "M-d" "focus master" runHide
|
||||||
, ("M-S-j", "swap down", windows W.swapDown)
|
, KeyBinding "M-S-j" "swap down" $ windows W.swapDown
|
||||||
, ("M-S-k", "swap up", windows W.swapUp)
|
, KeyBinding "M-S-k" "swap up" $ windows W.swapUp
|
||||||
, ("M-S-m", "swap master", windows W.swapMaster)
|
, KeyBinding "M-S-m" "swap master" $ windows W.swapMaster
|
||||||
, ("M-<Return>", "next layout", sendMessage NextLayout)
|
, KeyBinding "M-<Return>" "next layout" $ sendMessage NextLayout
|
||||||
, ("M-S-<Return>", "reset layout", setLayout $ layoutHook c)
|
, KeyBinding "M-S-<Return>" "reset layout" $ setLayout $ layoutHook c
|
||||||
, ("M-t", "sink tiling", withFocused $ windows . W.sink)
|
, KeyBinding "M-t" "sink tiling" $ withFocused $ windows . W.sink
|
||||||
, ("M-S-t", "float tiling", withFocused O.float)
|
, KeyBinding "M-S-t" "float tiling" $ withFocused O.float
|
||||||
, ("M--", "shrink", sendMessage Shrink)
|
, KeyBinding "M--" "shrink" $ sendMessage Shrink
|
||||||
, ("M-=", "expand", sendMessage Expand)
|
, KeyBinding "M-=" "expand" $ sendMessage Expand
|
||||||
, ("M-S--", "remove master window", sendMessage $ IncMasterN (-1))
|
, KeyBinding "M-S--" "remove master window" $ sendMessage $ IncMasterN (-1)
|
||||||
, ("M-S-=", "add master window", sendMessage $ IncMasterN 1)
|
, KeyBinding "M-S-=" "add master window" $ sendMessage $ IncMasterN 1
|
||||||
] ++
|
]
|
||||||
|
|
||||||
mkNamedSubmap "Workspaces"
|
, KeyGroup "Workspaces"
|
||||||
-- ASSUME standard workspaces only use numbers 0-9 (otherwise we won't get
|
-- ASSUME standard workspaces only use numbers 0-9 (otherwise we won't get
|
||||||
-- valid keysyms)
|
-- valid keysyms)
|
||||||
([ (mods ++ n, msg ++ n, f n) | n <- myWorkspaces
|
([ KeyBinding (mods ++ n) (msg ++ n) (f n) | n <- myWorkspaces
|
||||||
, (mods, msg, f) <-
|
, (mods, msg, f) <-
|
||||||
[ ("M-", "switch to workspace ", windows . W.view)
|
[ ("M-", "switch to workspace ", windows . W.view)
|
||||||
, ("M-S-", "move client to workspace ", windows . W.shift)
|
, ("M-S-", "move client to workspace ", windows . W.shift)
|
||||||
, ("M-C-", "follow client to workspace ", \n' -> do
|
, ("M-C-", "follow client to workspace ", \n' -> do
|
||||||
windows $ W.shift n'
|
windows $ W.shift n'
|
||||||
windows $ W.view n')
|
windows $ W.view n')
|
||||||
]
|
]
|
||||||
] ++
|
] ++
|
||||||
[ ("M-M1-l", "move up workspace", moveTo Next HiddenNonEmptyWS)
|
[ KeyBinding "M-M1-l" "move up workspace" $ moveTo Next HiddenNonEmptyWS
|
||||||
, ("M-M1-h", "move down workspace", moveTo Prev HiddenNonEmptyWS)
|
, KeyBinding "M-M1-h" "move down workspace" $ moveTo Prev HiddenNonEmptyWS
|
||||||
]) ++
|
])
|
||||||
|
|
||||||
mkNamedSubmap "Dynamic Workspaces"
|
, KeyGroup "Dynamic Workspaces"
|
||||||
[ ("M-C-" ++ [k], "launch/switch to " ++ n, cmd)
|
[ KeyBinding ("M-C-" ++ [k]) ("launch/switch to " ++ n) cmd
|
||||||
| DynWorkspace { dwTag = t, dwKey = k, dwCmd = a, dwName = n } <- allDWs,
|
| DynWorkspace { dwTag = t, dwKey = k, dwCmd = a, dwName = n } <- allDWs,
|
||||||
let cmd = case a of
|
let cmd = case a of
|
||||||
Just a' -> spawnOrSwitch t a'
|
Just a' -> spawnOrSwitch t a'
|
||||||
Nothing -> windows $ W.view t
|
Nothing -> windows $ W.view t
|
||||||
] ++
|
]
|
||||||
|
|
||||||
mkNamedSubmap "Screens"
|
, KeyGroup "Screens"
|
||||||
[ ("M-l", "move up screen", nextScreen)
|
[ KeyBinding "M-l" "move up screen" nextScreen
|
||||||
, ("M-h", "move down screen", prevScreen)
|
, KeyBinding "M-h" "move down screen" prevScreen
|
||||||
, ("M-C-l", "follow client up screen", shiftNextScreen >> nextScreen)
|
, KeyBinding "M-C-l" "follow client up screen" $ shiftNextScreen >> nextScreen
|
||||||
, ("M-C-h", "follow client down screen", shiftPrevScreen >> prevScreen)
|
, KeyBinding "M-C-h" "follow client down screen" $ shiftPrevScreen >> prevScreen
|
||||||
, ("M-S-l", "shift workspace up screen", swapNextScreen >> nextScreen)
|
, KeyBinding "M-S-l" "shift workspace up screen" $ swapNextScreen >> nextScreen
|
||||||
, ("M-S-h", "shift workspace down screen", swapPrevScreen >> prevScreen)
|
, KeyBinding "M-S-h" "shift workspace down screen" $ swapPrevScreen >> prevScreen
|
||||||
] ++
|
]
|
||||||
|
|
||||||
mkNamedSubmap "Actions"
|
|
||||||
[ ("M-q", "close window", kill1)
|
|
||||||
, ("M-r", "run program", runCmdMenu)
|
|
||||||
, ("M-<Space>", "warp pointer", warpToWindow 0.5 0.5)
|
|
||||||
, ("M-C-s", "capture area", runAreaCapture)
|
|
||||||
, ("M-C-S-s", "capture screen", runScreenCapture)
|
|
||||||
, ("M-C-d", "capture desktop", runDesktopCapture)
|
|
||||||
, ("M-C-b", "browse captures", runCaptureBrowser)
|
|
||||||
-- , ("M-C-S-s", "capture focused window", spawn myWindowCap)
|
|
||||||
] ++
|
|
||||||
|
|
||||||
mkNamedSubmap "Launchers"
|
|
||||||
[ ("<XF86Search>", "select/launch app", runAppMenu)
|
|
||||||
, ("M-g", "launch clipboard manager", runClipMenu)
|
|
||||||
, ("M-a", "launch network selector", runNetMenu)
|
|
||||||
, ("M-w", "launch window selector", runWinMenu)
|
|
||||||
, ("M-u", "launch device selector", runDevMenu)
|
|
||||||
, ("M-b", "launch bitwarden selector", runBwMenu)
|
|
||||||
, ("M-C-e", "launch editor", runEditor)
|
|
||||||
, ("M-C-w", "launch browser", runBrowser)
|
|
||||||
, ("M-C-t", "launch terminal with tmux", runTMux)
|
|
||||||
, ("M-C-S-t", "launch terminal", runTerm)
|
|
||||||
, ("M-C-q", "launch calc", runCalc)
|
|
||||||
, ("M-C-f", "launch file manager", runFileManager)
|
|
||||||
] ++
|
|
||||||
|
|
||||||
mkNamedSubmap "Multimedia"
|
|
||||||
[ ("<XF86AudioPlay>", "toggle play/pause", runTogglePlay)
|
|
||||||
, ("<XF86AudioPrev>", "previous track", runPrevTrack)
|
|
||||||
, ("<XF86AudioNext>", "next track", runNextTrack)
|
|
||||||
, ("<XF86AudioStop>", "stop", runStopPlay)
|
|
||||||
, ("<XF86AudioLowerVolume>", "volume down", runVolumeDown)
|
|
||||||
, ("<XF86AudioRaiseVolume>", "volume up", runVolumeUp)
|
|
||||||
, ("<XF86AudioMute>", "volume mute", runVolumeMute)
|
|
||||||
] ++
|
|
||||||
|
|
||||||
-- dummy map for dunst commands (defined separately but this makes them show
|
-- dummy map for dunst commands (defined separately but this makes them show
|
||||||
-- up in the help menu)
|
-- up in the help menu)
|
||||||
mkNamedSubmap "Dunst"
|
, KeyGroup "Dunst"
|
||||||
[ ("M-`", "dunst history", return ())
|
[ KeyBinding "M-`" "dunst history" skip
|
||||||
, ("M-S-`", "dunst close", return ())
|
, KeyBinding "M-S-`" "dunst close" skip
|
||||||
, ("M-M1-`", "dunst context menu", return ())
|
, KeyBinding "M-M1-`" "dunst context menu" skip
|
||||||
, ("M-C-`", "dunst close all", return ())
|
, KeyBinding "M-C-`" "dunst close all" skip
|
||||||
] ++
|
]
|
||||||
|
|
||||||
mkNamedSubmap "System"
|
|
||||||
[ ("M-.", "backlight up", runIncBacklight)
|
|
||||||
, ("M-,", "backlight down", runDecBacklight)
|
|
||||||
, ("M-M1-,", "backlight min", runMinBacklight)
|
|
||||||
, ("M-M1-.", "backlight max", runMaxBacklight)
|
|
||||||
, ("M-<End>", "power menu", runPowerPrompt)
|
|
||||||
, ("M-<Home>", "quit xmonad", runQuitPrompt)
|
|
||||||
, ("M-<Delete>", "lock screen", runScreenLock)
|
|
||||||
-- M-<F1> reserved for showing the keymap
|
|
||||||
, ("M-<F2>", "restart xmonad", runCleanup ts >> runRestart)
|
|
||||||
, ("M-<F3>", "recompile xmonad", runRecompile)
|
|
||||||
, ("M-<F7>", "start Isync Service", runStartISyncService)
|
|
||||||
, ("M-C-<F7>", "start Isync Timer", runStartISyncTimer)
|
|
||||||
, ("M-<F8>", "select autorandr profile", runAutorandrMenu)
|
|
||||||
, ("M-<F9>", "toggle ethernet", runToggleEthernet)
|
|
||||||
, ("M-<F10>", "toggle bluetooth", runToggleBluetooth)
|
|
||||||
, ("M-<F11>", "toggle screensaver", runToggleDPMS)
|
|
||||||
, ("M-<F12>", "switch gpu", runOptimusPrompt)
|
|
||||||
]
|
]
|
||||||
|
|
||||||
|
mkNamedSubmap :: XConfig Layout -> KeyGroup (X ()) -> [((KeyMask, KeySym), NamedAction)]
|
||||||
|
mkNamedSubmap c KeyGroup { kgHeader = h, kgBindings = b } =
|
||||||
|
(subtitle h:) $ mkNamedKeymap c
|
||||||
|
$ (\KeyBinding{kbSyms = s, kbDesc = d, kbAction = a} -> (s, addName d a))
|
||||||
|
<$> b
|
||||||
|
|
||||||
|
data KeyBinding a = KeyBinding
|
||||||
|
{ kbSyms :: String
|
||||||
|
, kbDesc :: String
|
||||||
|
, kbAction :: a
|
||||||
|
}
|
||||||
|
|
||||||
|
data KeyGroup a = KeyGroup
|
||||||
|
{ kgHeader :: String
|
||||||
|
, kgBindings :: [KeyBinding a]
|
||||||
|
}
|
||||||
|
|
||||||
|
evalExternal :: [KeyGroup (IO MaybeX)] -> IO [KeyGroup MaybeX]
|
||||||
|
evalExternal = mapM go
|
||||||
where
|
where
|
||||||
mkNamedSubmap header bindings = (subtitle header:) $ mkNamedKeymap c
|
go k@KeyGroup { kgBindings = bs } =
|
||||||
$ map (\(key, name, cmd) -> (key, addName name cmd)) bindings
|
(\bs' -> k { kgBindings = bs' }) <$> mapM evalKeyBinding bs
|
||||||
|
|
||||||
|
evalKeyBinding :: Monad m => KeyBinding (m a) -> m (KeyBinding a)
|
||||||
|
evalKeyBinding k@KeyBinding { kbAction = a } = (\b -> k { kbAction = b }) <$> a
|
||||||
|
|
||||||
|
filterExternal :: [KeyGroup MaybeX] -> [KeyGroup (X ())]
|
||||||
|
filterExternal = fmap go
|
||||||
|
where
|
||||||
|
go k@KeyGroup { kgBindings = bs } =
|
||||||
|
k { kgBindings = mapMaybe go' bs }
|
||||||
|
go' k@KeyBinding { kbAction = Installed x } = Just $ k { kbAction = x }
|
||||||
|
go' _ = Nothing
|
||||||
|
|
||||||
|
externalBindings :: ThreadState -> [KeyGroup (IO MaybeX)]
|
||||||
|
externalBindings ts =
|
||||||
|
[ KeyGroup "Launchers"
|
||||||
|
[ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
|
||||||
|
, KeyBinding "M-g" "launch clipboard manager" runClipMenu
|
||||||
|
, KeyBinding "M-a" "launch network selector" runNetMenu
|
||||||
|
, KeyBinding "M-w" "launch window selector" runWinMenu
|
||||||
|
, KeyBinding "M-u" "launch device selector" runDevMenu
|
||||||
|
, KeyBinding "M-b" "launch bitwarden selector" runBwMenu
|
||||||
|
, KeyBinding "M-C-e" "launch editor" runEditor
|
||||||
|
, KeyBinding "M-C-w" "launch browser" runBrowser
|
||||||
|
, KeyBinding "M-C-t" "launch terminal with tmux" runTMux
|
||||||
|
, KeyBinding "M-C-S-t" "launch terminal" runTerm
|
||||||
|
, KeyBinding "M-C-q" "launch calc" runCalc
|
||||||
|
, KeyBinding "M-C-f" "launch file manager" runFileManager
|
||||||
|
]
|
||||||
|
|
||||||
|
, KeyGroup "Actions"
|
||||||
|
[ KeyBinding "M-q" "close window" $ noCheck kill1
|
||||||
|
, KeyBinding "M-r" "run program" runCmdMenu
|
||||||
|
, KeyBinding "M-<Space>" "warp pointer" $ noCheck $ warpToWindow 0.5 0.5
|
||||||
|
, KeyBinding "M-C-s" "capture area" runAreaCapture
|
||||||
|
, KeyBinding "M-C-S-s" "capture screen" runScreenCapture
|
||||||
|
, KeyBinding "M-C-d" "capture desktop" runDesktopCapture
|
||||||
|
, KeyBinding "M-C-b" "browse captures" runCaptureBrowser
|
||||||
|
-- , ("M-C-S-s", "capture focused window", spawn myWindowCap)
|
||||||
|
]
|
||||||
|
|
||||||
|
, KeyGroup "Multimedia"
|
||||||
|
[ KeyBinding "<XF86AudioPlay>" "toggle play/pause" runTogglePlay
|
||||||
|
, KeyBinding "<XF86AudioPrev>" "previous track" runPrevTrack
|
||||||
|
, KeyBinding "<XF86AudioNext>" "next track" runNextTrack
|
||||||
|
, KeyBinding "<XF86AudioStop>" "stop" runStopPlay
|
||||||
|
, KeyBinding "<XF86AudioLowerVolume>" "volume down" runVolumeDown
|
||||||
|
, KeyBinding "<XF86AudioRaiseVolume>" "volume up" runVolumeUp
|
||||||
|
, KeyBinding "<XF86AudioMute>" "volume mute" runVolumeMute
|
||||||
|
]
|
||||||
|
|
||||||
|
, KeyGroup "System"
|
||||||
|
[ KeyBinding "M-." "backlight up" $ noCheck runIncBacklight
|
||||||
|
, KeyBinding "M-," "backlight down" $ noCheck runDecBacklight
|
||||||
|
, KeyBinding "M-M1-," "backlight min" $ noCheck runMinBacklight
|
||||||
|
, KeyBinding "M-M1-." "backlight max" $ noCheck runMaxBacklight
|
||||||
|
, KeyBinding "M-<End>" "power menu" $ noCheck runPowerPrompt
|
||||||
|
, KeyBinding "M-<Home>" "quit xmonad" $ noCheck runQuitPrompt
|
||||||
|
, KeyBinding "M-<Delete>" "lock screen" runScreenLock
|
||||||
|
-- M-<F1> reserved for showing the keymap
|
||||||
|
, KeyBinding "M-<F2>" "restart xmonad" $ noCheck (runCleanup ts >> runRestart)
|
||||||
|
, KeyBinding "M-<F3>" "recompile xmonad" $ noCheck runRecompile
|
||||||
|
, KeyBinding "M-<F7>" "start Isync Service" $ noCheck runStartISyncService
|
||||||
|
, KeyBinding "M-C-<F7>" "start Isync Timer" $ noCheck runStartISyncTimer
|
||||||
|
, KeyBinding "M-<F8>" "select autorandr profile" runAutorandrMenu
|
||||||
|
, KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet
|
||||||
|
, KeyBinding "M-<F10>" "toggle bluetooth" runToggleBluetooth
|
||||||
|
, KeyBinding "M-<F11>" "toggle screensaver" $ noCheck runToggleDPMS
|
||||||
|
, KeyBinding "M-<F12>" "switch gpu" $ noCheck runOptimusPrompt
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
|
@ -18,6 +18,7 @@ import Control.Monad.Reader
|
||||||
import Graphics.X11.Types
|
import Graphics.X11.Types
|
||||||
|
|
||||||
import System.IO
|
import System.IO
|
||||||
|
import System.Directory (getXdgDirectory, XdgDirectory(..))
|
||||||
|
|
||||||
import XMonad.Core hiding (spawn)
|
import XMonad.Core hiding (spawn)
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
|
@ -25,13 +26,28 @@ import XMonad.Internal.Shell
|
||||||
import XMonad.Util.NamedActions
|
import XMonad.Util.NamedActions
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Other internal functions
|
-- | DMenu executables
|
||||||
|
|
||||||
myDmenuCmd :: String
|
myDmenuCmd :: String
|
||||||
myDmenuCmd = "rofi"
|
myDmenuCmd = "rofi"
|
||||||
|
|
||||||
spawnDmenuCmd :: [String] -> X ()
|
myDmenuDevices :: String
|
||||||
spawnDmenuCmd = spawnCmd myDmenuCmd
|
myDmenuDevices = "rofi-dev"
|
||||||
|
|
||||||
|
myDmenuPasswords :: String
|
||||||
|
myDmenuPasswords = "rofi-bw"
|
||||||
|
|
||||||
|
myDmenuMonitors :: String
|
||||||
|
myDmenuMonitors = "rofi-autorandr"
|
||||||
|
|
||||||
|
myDmenuNetworks :: String
|
||||||
|
myDmenuNetworks = "networkmanager_dmenu"
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Other internal functions
|
||||||
|
|
||||||
|
spawnDmenuCmd :: [String] -> IO MaybeX
|
||||||
|
spawnDmenuCmd = spawnCmdIfInstalled myDmenuCmd
|
||||||
|
|
||||||
themeArgs :: String -> [String]
|
themeArgs :: String -> [String]
|
||||||
themeArgs hexColor =
|
themeArgs hexColor =
|
||||||
|
@ -45,18 +61,19 @@ myDmenuMatchingArgs = ["-i"] -- case insensitivity
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Exported Commands
|
-- | Exported Commands
|
||||||
|
|
||||||
devSecrets :: [String]
|
runDevMenu :: IO MaybeX
|
||||||
devSecrets = ["-c", "/home/ndwar/.config/rofi/devices.yml"]
|
runDevMenu = runIfInstalled [myDmenuDevices] $ do
|
||||||
|
c <- io $ getXdgDirectory XdgConfig "rofi/devices.yml"
|
||||||
|
spawnCmd myDmenuDevices
|
||||||
|
$ ["-c", c]
|
||||||
|
++ "--" : themeArgs "#999933"
|
||||||
|
++ myDmenuMatchingArgs
|
||||||
|
|
||||||
runDevMenu :: X ()
|
runBwMenu :: IO MaybeX
|
||||||
runDevMenu = spawnCmd "rofi-dev" $ devSecrets ++ rofiArgs
|
runBwMenu = runIfInstalled [myDmenuPasswords] $
|
||||||
where
|
spawnCmd myDmenuPasswords $ ["-c", "--"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
|
||||||
rofiArgs = "--" : themeArgs "#999933" ++ myDmenuMatchingArgs
|
|
||||||
|
|
||||||
runBwMenu :: X ()
|
|
||||||
runBwMenu = spawnCmd "rofi-bw" $ ["-c", "--"] ++ themeArgs "#bb6600"
|
|
||||||
++ myDmenuMatchingArgs
|
|
||||||
|
|
||||||
|
-- TODO what to do with this if rofi doesn't exist?
|
||||||
runShowKeys :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
|
runShowKeys :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
|
||||||
runShowKeys x = addName "Show Keybindings" $ do
|
runShowKeys x = addName "Show Keybindings" $ do
|
||||||
(h, _, _, _) <- io $ createProcess' $ (shell' cmd) { std_in = CreatePipe }
|
(h, _, _, _) <- io $ createProcess' $ (shell' cmd) { std_in = CreatePipe }
|
||||||
|
@ -64,24 +81,25 @@ runShowKeys x = addName "Show Keybindings" $ do
|
||||||
where cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
|
where cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
|
||||||
++ themeArgs "#a200ff" ++ myDmenuMatchingArgs
|
++ themeArgs "#a200ff" ++ myDmenuMatchingArgs
|
||||||
|
|
||||||
runCmdMenu :: X ()
|
runCmdMenu :: IO MaybeX
|
||||||
runCmdMenu = spawnDmenuCmd ["-show", "run"]
|
runCmdMenu = spawnDmenuCmd ["-show", "run"]
|
||||||
|
|
||||||
runAppMenu :: X ()
|
runAppMenu :: IO MaybeX
|
||||||
runAppMenu = spawnDmenuCmd ["-show", "drun"]
|
runAppMenu = spawnDmenuCmd ["-show", "drun"]
|
||||||
|
|
||||||
runClipMenu :: X ()
|
-- TODO this also depends on greenclip
|
||||||
|
runClipMenu :: IO MaybeX
|
||||||
runClipMenu = spawnDmenuCmd $
|
runClipMenu = spawnDmenuCmd $
|
||||||
[ "-modi", "\"clipboard:greenclip print\""
|
[ "-modi", "\"clipboard:greenclip print\""
|
||||||
, "-show", "clipboard"
|
, "-show", "clipboard"
|
||||||
, "-run-command", "'{cmd}'"
|
, "-run-command", "'{cmd}'"
|
||||||
] ++ themeArgs "#00c44e"
|
] ++ themeArgs "#00c44e"
|
||||||
|
|
||||||
runWinMenu :: X ()
|
runWinMenu :: IO MaybeX
|
||||||
runWinMenu = spawnDmenuCmd ["-show", "window"]
|
runWinMenu = spawnDmenuCmd ["-show", "window"]
|
||||||
|
|
||||||
runNetMenu :: X ()
|
runNetMenu :: IO MaybeX
|
||||||
runNetMenu = spawnCmd "networkmanager_dmenu" $ themeArgs "#ff3333"
|
runNetMenu = spawnCmdIfInstalled myDmenuNetworks $ themeArgs "#ff3333"
|
||||||
|
|
||||||
runAutorandrMenu :: X ()
|
runAutorandrMenu :: IO MaybeX
|
||||||
runAutorandrMenu = spawnCmd "rofi-autorandr" $ themeArgs "#ff0066"
|
runAutorandrMenu = spawnCmdIfInstalled myDmenuMonitors $ themeArgs "#ff0066"
|
||||||
|
|
|
@ -52,75 +52,103 @@ import XMonad.Internal.Shell
|
||||||
import XMonad.Operations
|
import XMonad.Operations
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Some nice apps
|
-- | My Executables
|
||||||
|
|
||||||
myTerm :: String
|
myTerm :: String
|
||||||
myTerm = "urxvt"
|
myTerm = "urxvt"
|
||||||
|
|
||||||
runTerm :: X ()
|
myBrowser :: String
|
||||||
runTerm = spawn myTerm
|
myBrowser = "brave-accel"
|
||||||
|
|
||||||
runTMux :: X ()
|
myEditor :: String
|
||||||
runTMux = spawn
|
myEditor = "emacsclient"
|
||||||
$ "tmux has-session"
|
|
||||||
#!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c]
|
|
||||||
#!|| fmtNotifyCmd defNoteError { body = Just $ Text msg }
|
|
||||||
where
|
|
||||||
c = "exec tmux attach-session -d"
|
|
||||||
msg = "could not connect to tmux session"
|
|
||||||
|
|
||||||
runCalc :: X ()
|
|
||||||
runCalc = spawnCmd myTerm ["-e", "R"]
|
|
||||||
|
|
||||||
runBrowser :: X ()
|
|
||||||
runBrowser = spawn "brave-accel"
|
|
||||||
|
|
||||||
runEditor :: X ()
|
|
||||||
runEditor = spawnCmd "emacsclient"
|
|
||||||
["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"]
|
|
||||||
|
|
||||||
runFileManager :: X ()
|
|
||||||
runFileManager = spawn "pcmanfm"
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- | Multimedia Commands
|
|
||||||
|
|
||||||
myMultimediaCtl :: String
|
myMultimediaCtl :: String
|
||||||
myMultimediaCtl = "playerctl"
|
myMultimediaCtl = "playerctl"
|
||||||
|
|
||||||
runTogglePlay :: X ()
|
myBluetooth :: String
|
||||||
runTogglePlay = spawnCmd myMultimediaCtl ["play-pause"]
|
myBluetooth = "bluetoothctl"
|
||||||
|
|
||||||
runPrevTrack :: X ()
|
myCapture :: String
|
||||||
runPrevTrack = spawnCmd myMultimediaCtl ["previous"]
|
myCapture = "flameshot"
|
||||||
|
|
||||||
runNextTrack :: X ()
|
myImageBrowser :: String
|
||||||
runNextTrack = spawnCmd myMultimediaCtl ["next"]
|
myImageBrowser = "feh"
|
||||||
|
|
||||||
runStopPlay :: X ()
|
--------------------------------------------------------------------------------
|
||||||
runStopPlay = spawnCmd myMultimediaCtl ["stop"]
|
-- | Misc constants
|
||||||
|
|
||||||
volumeChangeSound :: FilePath
|
volumeChangeSound :: FilePath
|
||||||
volumeChangeSound = "smb_fireball.wav"
|
volumeChangeSound = "smb_fireball.wav"
|
||||||
|
|
||||||
runVolumeDown :: X ()
|
ethernetIface :: String
|
||||||
runVolumeDown = spawnSound volumeChangeSound >> void (lowerVolume 2)
|
ethernetIface = "enp7s0f1"
|
||||||
|
|
||||||
runVolumeUp :: X ()
|
--------------------------------------------------------------------------------
|
||||||
runVolumeUp = spawnSound volumeChangeSound >> void (raiseVolume 2)
|
-- | Some nice apps
|
||||||
|
|
||||||
runVolumeMute :: X ()
|
runTerm :: IO MaybeX
|
||||||
runVolumeMute = void toggleMute >> spawnSound volumeChangeSound
|
runTerm = spawnIfInstalled myTerm
|
||||||
|
|
||||||
|
runTMux :: IO MaybeX
|
||||||
|
runTMux = runIfInstalled [myTerm, "tmux", "bash"] cmd
|
||||||
|
where
|
||||||
|
cmd = spawn
|
||||||
|
$ "tmux has-session"
|
||||||
|
#!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c]
|
||||||
|
#!|| fmtNotifyCmd defNoteError { body = Just $ Text msg }
|
||||||
|
c = "exec tmux attach-session -d"
|
||||||
|
msg = "could not connect to tmux session"
|
||||||
|
|
||||||
|
runCalc :: IO MaybeX
|
||||||
|
runCalc = runIfInstalled [myTerm, "R"] $ spawnCmd myTerm ["-e", "R"]
|
||||||
|
|
||||||
|
runBrowser :: IO MaybeX
|
||||||
|
runBrowser = spawnIfInstalled myBrowser
|
||||||
|
|
||||||
|
runEditor :: IO MaybeX
|
||||||
|
runEditor = spawnCmdIfInstalled myEditor
|
||||||
|
["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"]
|
||||||
|
|
||||||
|
runFileManager :: IO MaybeX
|
||||||
|
runFileManager = spawnIfInstalled "pcmanfm"
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Multimedia Commands
|
||||||
|
|
||||||
|
runMultimediaIfInstalled :: String -> IO MaybeX
|
||||||
|
runMultimediaIfInstalled cmd = spawnCmdIfInstalled myMultimediaCtl [cmd]
|
||||||
|
|
||||||
|
runTogglePlay :: IO MaybeX
|
||||||
|
runTogglePlay = runMultimediaIfInstalled "play-pause"
|
||||||
|
|
||||||
|
runPrevTrack :: IO MaybeX
|
||||||
|
runPrevTrack = runMultimediaIfInstalled "previous"
|
||||||
|
|
||||||
|
runNextTrack :: IO MaybeX
|
||||||
|
runNextTrack = runMultimediaIfInstalled "next"
|
||||||
|
|
||||||
|
runStopPlay :: IO MaybeX
|
||||||
|
runStopPlay = runMultimediaIfInstalled "stop"
|
||||||
|
|
||||||
|
runVolumeDown :: IO MaybeX
|
||||||
|
runVolumeDown = spawnSound volumeChangeSound (return ()) $ void (lowerVolume 2)
|
||||||
|
|
||||||
|
runVolumeUp :: IO MaybeX
|
||||||
|
runVolumeUp = spawnSound volumeChangeSound (return ()) $ void (raiseVolume 2)
|
||||||
|
|
||||||
|
runVolumeMute :: IO MaybeX
|
||||||
|
runVolumeMute = spawnSound volumeChangeSound (void toggleMute) $ return ()
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | System commands
|
-- | System commands
|
||||||
|
|
||||||
runToggleBluetooth :: X ()
|
runToggleBluetooth :: IO MaybeX
|
||||||
runToggleBluetooth = spawn
|
runToggleBluetooth = runIfInstalled [myBluetooth] $ spawn
|
||||||
$ "bluetoothctl show | grep -q \"Powered: no\""
|
$ myBluetooth ++ " show | grep -q \"Powered: no\""
|
||||||
#!&& "a=on"
|
#!&& "a=on"
|
||||||
#!|| "a=off"
|
#!|| "a=off"
|
||||||
#!>> fmtCmd "bluetoothctl" ["power", "$a", ">", "/dev/null"]
|
#!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
|
||||||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" }
|
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" }
|
||||||
|
|
||||||
runIncBacklight :: X ()
|
runIncBacklight :: X ()
|
||||||
|
@ -138,11 +166,8 @@ runMaxBacklight = io $ void callMaxBrightness
|
||||||
runToggleDPMS :: X ()
|
runToggleDPMS :: X ()
|
||||||
runToggleDPMS = io $ void callToggle
|
runToggleDPMS = io $ void callToggle
|
||||||
|
|
||||||
ethernetIface :: String
|
runToggleEthernet :: IO MaybeX
|
||||||
ethernetIface = "enp7s0f1"
|
runToggleEthernet = runIfInstalled ["nmcli"] $ spawn
|
||||||
|
|
||||||
runToggleEthernet :: X ()
|
|
||||||
runToggleEthernet = spawn
|
|
||||||
$ "nmcli -g GENERAL.STATE device show " ++ ethernetIface ++ " | grep -q disconnected"
|
$ "nmcli -g GENERAL.STATE device show " ++ ethernetIface ++ " | grep -q disconnected"
|
||||||
#!&& "a=connect"
|
#!&& "a=connect"
|
||||||
#!|| "a=disconnect"
|
#!|| "a=disconnect"
|
||||||
|
@ -199,25 +224,25 @@ getCaptureDir = do
|
||||||
where
|
where
|
||||||
fallback = (</> ".local/share") <$> getHomeDirectory
|
fallback = (</> ".local/share") <$> getHomeDirectory
|
||||||
|
|
||||||
runFlameshot :: String -> X ()
|
runFlameshot :: String -> IO MaybeX
|
||||||
runFlameshot mode = do
|
runFlameshot mode = runIfInstalled [myCapture] $ do
|
||||||
ssDir <- io getCaptureDir
|
ssDir <- io getCaptureDir
|
||||||
spawnCmd "flameshot" $ mode : ["-p", ssDir]
|
spawnCmd myCapture $ mode : ["-p", ssDir]
|
||||||
|
|
||||||
-- TODO this will steal focus from the current window (and puts it
|
-- TODO this will steal focus from the current window (and puts it
|
||||||
-- in the root window?) ...need to fix
|
-- in the root window?) ...need to fix
|
||||||
runAreaCapture :: X ()
|
runAreaCapture :: IO MaybeX
|
||||||
runAreaCapture = runFlameshot "gui"
|
runAreaCapture = runFlameshot "gui"
|
||||||
|
|
||||||
-- myWindowCap = "screencap -w" --external script
|
-- myWindowCap = "screencap -w" --external script
|
||||||
|
|
||||||
runScreenCapture :: X ()
|
runDesktopCapture :: IO MaybeX
|
||||||
runScreenCapture = runFlameshot "screen"
|
|
||||||
|
|
||||||
runDesktopCapture :: X ()
|
|
||||||
runDesktopCapture = runFlameshot "full"
|
runDesktopCapture = runFlameshot "full"
|
||||||
|
|
||||||
runCaptureBrowser :: X ()
|
runScreenCapture :: IO MaybeX
|
||||||
runCaptureBrowser = do
|
runScreenCapture = runFlameshot "screen"
|
||||||
|
|
||||||
|
runCaptureBrowser :: IO MaybeX
|
||||||
|
runCaptureBrowser = runIfInstalled [myImageBrowser] $ do
|
||||||
dir <- io getCaptureDir
|
dir <- io getCaptureDir
|
||||||
spawnCmd "feh" [dir]
|
spawnCmd myImageBrowser [dir]
|
||||||
|
|
|
@ -31,8 +31,8 @@ import XMonad.Prompt.ConfirmPrompt
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Core commands
|
-- | Core commands
|
||||||
|
|
||||||
runScreenLock :: X ()
|
runScreenLock :: IOMaybeX
|
||||||
runScreenLock = spawn "screenlock"
|
runScreenLock = spawnIfInstalled "screenlock"
|
||||||
|
|
||||||
runPowerOff :: X ()
|
runPowerOff :: X ()
|
||||||
runPowerOff = spawn "systemctl poweroff"
|
runPowerOff = spawn "systemctl poweroff"
|
||||||
|
@ -119,6 +119,6 @@ runPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction
|
||||||
sendAction a = setInput (show $ fromEnum a) >> setSuccess True >> setDone True
|
sendAction a = setInput (show $ fromEnum a) >> setSuccess True >> setDone True
|
||||||
executeAction a = case toEnum $ read a of
|
executeAction a = case toEnum $ read a of
|
||||||
Poweroff -> runPowerOff
|
Poweroff -> runPowerOff
|
||||||
Shutdown -> runScreenLock >> runSuspend
|
Shutdown -> (io runScreenLock >>= whenInstalled) >> runSuspend
|
||||||
Hibernate -> runScreenLock >> runHibernate
|
Hibernate -> (io runScreenLock >>= whenInstalled) >> runHibernate
|
||||||
Reboot -> runReboot
|
Reboot -> runReboot
|
||||||
|
|
|
@ -23,6 +23,7 @@ import System.IO.Streams.UnixSocket
|
||||||
|
|
||||||
import XMonad.Core
|
import XMonad.Core
|
||||||
import XMonad.Internal.Command.Power
|
import XMonad.Internal.Command.Power
|
||||||
|
import XMonad.Internal.Shell
|
||||||
import XMonad.Internal.Concurrent.ClientMessage
|
import XMonad.Internal.Concurrent.ClientMessage
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
@ -100,4 +101,6 @@ handleACPI tag = do
|
||||||
Sleep -> runSuspendPrompt
|
Sleep -> runSuspendPrompt
|
||||||
LidClose -> do
|
LidClose -> do
|
||||||
status <- io isDischarging
|
status <- io isDischarging
|
||||||
forM_ status $ \s -> runScreenLock >> when s runSuspend
|
forM_ status $ \s -> do
|
||||||
|
io runScreenLock >>= whenInstalled
|
||||||
|
when s runSuspend
|
||||||
|
|
|
@ -56,7 +56,7 @@ removedHasDrive [_, a] = maybe False (driveFlag `elem`)
|
||||||
removedHasDrive _ = False
|
removedHasDrive _ = False
|
||||||
|
|
||||||
playSoundMaybe :: FilePath -> Bool -> IO ()
|
playSoundMaybe :: FilePath -> Bool -> IO ()
|
||||||
playSoundMaybe p b = when b $ spawnSound p
|
playSoundMaybe p b = when b $ playSound p
|
||||||
|
|
||||||
-- NOTE: the udisks2 service should be already running for this module to work.
|
-- NOTE: the udisks2 service should be already running for this module to work.
|
||||||
-- If it not already, we won't see any signals from the dbus until it is
|
-- If it not already, we won't see any signals from the dbus until it is
|
||||||
|
|
|
@ -2,23 +2,69 @@
|
||||||
-- | Functions for formatting and spawning shell commands
|
-- | Functions for formatting and spawning shell commands
|
||||||
|
|
||||||
module XMonad.Internal.Shell
|
module XMonad.Internal.Shell
|
||||||
( fmtCmd
|
( MaybeExe(..)
|
||||||
|
, MaybeX
|
||||||
|
, IOMaybeX
|
||||||
|
, runIfInstalled
|
||||||
|
, whenInstalled
|
||||||
|
, spawnIfInstalled
|
||||||
|
, spawnCmdIfInstalled
|
||||||
|
, noCheck
|
||||||
|
, fmtCmd
|
||||||
, spawnCmd
|
, spawnCmd
|
||||||
, spawnSound
|
, spawnSound
|
||||||
|
, playSound
|
||||||
, doubleQuote
|
, doubleQuote
|
||||||
, singleQuote
|
, singleQuote
|
||||||
|
, skip
|
||||||
, (#!&&)
|
, (#!&&)
|
||||||
, (#!||)
|
, (#!||)
|
||||||
, (#!>>)
|
, (#!>>)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Control.Monad (filterM)
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
|
|
||||||
import System.FilePath.Posix
|
import Data.Maybe (isNothing)
|
||||||
|
|
||||||
import XMonad.Core (getXMonadDir)
|
import System.FilePath.Posix
|
||||||
|
import System.Directory (findExecutable)
|
||||||
|
|
||||||
|
import XMonad.Core (getXMonadDir, X)
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Gracefully handling missing binaries
|
||||||
|
|
||||||
|
data MaybeExe m = Installed (m ()) | Missing [String] | Noop
|
||||||
|
|
||||||
|
type MaybeX = MaybeExe X
|
||||||
|
|
||||||
|
type IOMaybeX = IO MaybeX
|
||||||
|
|
||||||
|
runIfInstalled :: MonadIO m => [String] -> m () -> IO (MaybeExe m)
|
||||||
|
runIfInstalled exes x = do
|
||||||
|
missing <- filterM (fmap isNothing . findExecutable) exes
|
||||||
|
return $ case missing of
|
||||||
|
[] -> Installed x
|
||||||
|
ms -> Missing ms
|
||||||
|
|
||||||
|
spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe m)
|
||||||
|
spawnIfInstalled exe = runIfInstalled [exe] $ spawn exe
|
||||||
|
|
||||||
|
spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe m)
|
||||||
|
spawnCmdIfInstalled exe args = runIfInstalled [exe] $ spawnCmd exe args
|
||||||
|
|
||||||
|
whenInstalled :: Monad m => MaybeExe m -> m ()
|
||||||
|
whenInstalled (Installed x) = x
|
||||||
|
whenInstalled _ = return ()
|
||||||
|
|
||||||
|
skip :: Monad m => m ()
|
||||||
|
skip = return ()
|
||||||
|
|
||||||
|
noCheck :: Monad m => a () -> m (MaybeExe a)
|
||||||
|
noCheck = return . Installed
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Opening subshell
|
-- | Opening subshell
|
||||||
|
|
||||||
|
@ -31,8 +77,12 @@ spawnCmd cmd args = spawn $ fmtCmd cmd args
|
||||||
soundDir :: FilePath
|
soundDir :: FilePath
|
||||||
soundDir = "sound"
|
soundDir = "sound"
|
||||||
|
|
||||||
spawnSound :: MonadIO m => FilePath -> m ()
|
spawnSound :: MonadIO m => FilePath -> m () -> m () -> IO (MaybeExe m)
|
||||||
spawnSound file = do
|
spawnSound file pre post = runIfInstalled ["paplay"]
|
||||||
|
$ pre >> playSound file >> post
|
||||||
|
|
||||||
|
playSound :: MonadIO m => FilePath -> m ()
|
||||||
|
playSound file = do
|
||||||
path <- (</> soundDir </> file) <$> getXMonadDir
|
path <- (</> soundDir </> file) <$> getXMonadDir
|
||||||
-- paplay seems to have less latency than aplay
|
-- paplay seems to have less latency than aplay
|
||||||
spawnCmd "paplay" [path]
|
spawnCmd "paplay" [path]
|
||||||
|
|
Loading…
Reference in New Issue