ENH noop programs that are missing

This commit is contained in:
Nathan Dwarshuis 2021-06-19 00:17:47 -04:00
parent 359312ff50
commit dd4f45f61c
7 changed files with 342 additions and 209 deletions

View File

@ -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
]
]

View File

@ -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"

View File

@ -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]

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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]