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
|
||||
, sortOn
|
||||
)
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Maybe (isJust, mapMaybe)
|
||||
import Data.Monoid (All (..))
|
||||
|
||||
import Graphics.X11.Types
|
||||
|
@ -74,9 +74,10 @@ main = do
|
|||
, childPIDs = [p]
|
||||
, childHandles = [h]
|
||||
}
|
||||
ekbs <- evalExternal $ externalBindings ts
|
||||
launch
|
||||
$ ewmh
|
||||
$ addKeymap ts
|
||||
$ addKeymap (filterExternal ekbs)
|
||||
$ def { terminal = myTerm
|
||||
, modMask = myModMask
|
||||
, layoutHook = myLayouts
|
||||
|
@ -369,126 +370,162 @@ xMsgEventHook _ = return (All True)
|
|||
myModMask :: KeyMask
|
||||
myModMask = mod4Mask
|
||||
|
||||
addKeymap :: ThreadState -> XConfig l -> XConfig l
|
||||
addKeymap ts = addDescrKeys' ((myModMask, xK_F1), runShowKeys) (mkKeys ts)
|
||||
addKeymap :: [KeyGroup (X ())] -> XConfig l -> XConfig l
|
||||
addKeymap external = addDescrKeys' ((myModMask, xK_F1), runShowKeys)
|
||||
(\c -> concatMap (mkNamedSubmap c) $ internalBindings c ++ external)
|
||||
|
||||
mkKeys :: ThreadState -> XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
|
||||
mkKeys ts c =
|
||||
mkNamedSubmap "Window Layouts"
|
||||
[ ("M-j", "focus down", windows W.focusDown)
|
||||
, ("M-k", "focus up", windows W.focusUp)
|
||||
, ("M-m", "focus master", windows W.focusMaster)
|
||||
, ("M-d", "focus master", runHide)
|
||||
, ("M-S-j", "swap down", windows W.swapDown)
|
||||
, ("M-S-k", "swap up", windows W.swapUp)
|
||||
, ("M-S-m", "swap master", windows W.swapMaster)
|
||||
, ("M-<Return>", "next layout", sendMessage NextLayout)
|
||||
, ("M-S-<Return>", "reset layout", setLayout $ layoutHook c)
|
||||
, ("M-t", "sink tiling", withFocused $ windows . W.sink)
|
||||
, ("M-S-t", "float tiling", withFocused O.float)
|
||||
, ("M--", "shrink", sendMessage Shrink)
|
||||
, ("M-=", "expand", sendMessage Expand)
|
||||
, ("M-S--", "remove master window", sendMessage $ IncMasterN (-1))
|
||||
, ("M-S-=", "add master window", sendMessage $ IncMasterN 1)
|
||||
] ++
|
||||
internalBindings :: XConfig Layout -> [KeyGroup (X ())]
|
||||
internalBindings c =
|
||||
[ KeyGroup "Window Layouts"
|
||||
[ KeyBinding "M-j" "focus down" $ windows W.focusDown
|
||||
, KeyBinding "M-k" "focus up" $ windows W.focusUp
|
||||
, KeyBinding "M-m" "focus master" $ windows W.focusMaster
|
||||
, KeyBinding "M-d" "focus master" runHide
|
||||
, KeyBinding "M-S-j" "swap down" $ windows W.swapDown
|
||||
, KeyBinding "M-S-k" "swap up" $ windows W.swapUp
|
||||
, KeyBinding "M-S-m" "swap master" $ windows W.swapMaster
|
||||
, KeyBinding "M-<Return>" "next layout" $ sendMessage NextLayout
|
||||
, KeyBinding "M-S-<Return>" "reset layout" $ setLayout $ layoutHook c
|
||||
, KeyBinding "M-t" "sink tiling" $ withFocused $ windows . W.sink
|
||||
, KeyBinding "M-S-t" "float tiling" $ withFocused O.float
|
||||
, KeyBinding "M--" "shrink" $ sendMessage Shrink
|
||||
, KeyBinding "M-=" "expand" $ sendMessage Expand
|
||||
, KeyBinding "M-S--" "remove master window" $ sendMessage $ IncMasterN (-1)
|
||||
, KeyBinding "M-S-=" "add master window" $ sendMessage $ IncMasterN 1
|
||||
]
|
||||
|
||||
mkNamedSubmap "Workspaces"
|
||||
-- ASSUME standard workspaces only use numbers 0-9 (otherwise we won't get
|
||||
-- valid keysyms)
|
||||
([ (mods ++ n, msg ++ n, f n) | n <- myWorkspaces
|
||||
, (mods, msg, f) <-
|
||||
[ ("M-", "switch to workspace ", windows . W.view)
|
||||
, ("M-S-", "move client to workspace ", windows . W.shift)
|
||||
, ("M-C-", "follow client to workspace ", \n' -> do
|
||||
windows $ W.shift n'
|
||||
windows $ W.view n')
|
||||
]
|
||||
] ++
|
||||
[ ("M-M1-l", "move up workspace", moveTo Next HiddenNonEmptyWS)
|
||||
, ("M-M1-h", "move down workspace", moveTo Prev HiddenNonEmptyWS)
|
||||
]) ++
|
||||
, KeyGroup "Workspaces"
|
||||
-- ASSUME standard workspaces only use numbers 0-9 (otherwise we won't get
|
||||
-- valid keysyms)
|
||||
([ KeyBinding (mods ++ n) (msg ++ n) (f n) | n <- myWorkspaces
|
||||
, (mods, msg, f) <-
|
||||
[ ("M-", "switch to workspace ", windows . W.view)
|
||||
, ("M-S-", "move client to workspace ", windows . W.shift)
|
||||
, ("M-C-", "follow client to workspace ", \n' -> do
|
||||
windows $ W.shift n'
|
||||
windows $ W.view n')
|
||||
]
|
||||
] ++
|
||||
[ KeyBinding "M-M1-l" "move up workspace" $ moveTo Next HiddenNonEmptyWS
|
||||
, KeyBinding "M-M1-h" "move down workspace" $ moveTo Prev HiddenNonEmptyWS
|
||||
])
|
||||
|
||||
mkNamedSubmap "Dynamic Workspaces"
|
||||
[ ("M-C-" ++ [k], "launch/switch to " ++ n, cmd)
|
||||
| DynWorkspace { dwTag = t, dwKey = k, dwCmd = a, dwName = n } <- allDWs,
|
||||
let cmd = case a of
|
||||
Just a' -> spawnOrSwitch t a'
|
||||
Nothing -> windows $ W.view t
|
||||
] ++
|
||||
, KeyGroup "Dynamic Workspaces"
|
||||
[ KeyBinding ("M-C-" ++ [k]) ("launch/switch to " ++ n) cmd
|
||||
| DynWorkspace { dwTag = t, dwKey = k, dwCmd = a, dwName = n } <- allDWs,
|
||||
let cmd = case a of
|
||||
Just a' -> spawnOrSwitch t a'
|
||||
Nothing -> windows $ W.view t
|
||||
]
|
||||
|
||||
mkNamedSubmap "Screens"
|
||||
[ ("M-l", "move up screen", nextScreen)
|
||||
, ("M-h", "move down screen", prevScreen)
|
||||
, ("M-C-l", "follow client up screen", shiftNextScreen >> nextScreen)
|
||||
, ("M-C-h", "follow client down screen", shiftPrevScreen >> prevScreen)
|
||||
, ("M-S-l", "shift workspace up screen", swapNextScreen >> nextScreen)
|
||||
, ("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)
|
||||
] ++
|
||||
, KeyGroup "Screens"
|
||||
[ KeyBinding "M-l" "move up screen" nextScreen
|
||||
, KeyBinding "M-h" "move down screen" prevScreen
|
||||
, KeyBinding "M-C-l" "follow client up screen" $ shiftNextScreen >> nextScreen
|
||||
, KeyBinding "M-C-h" "follow client down screen" $ shiftPrevScreen >> prevScreen
|
||||
, KeyBinding "M-S-l" "shift workspace up screen" $ swapNextScreen >> nextScreen
|
||||
, KeyBinding "M-S-h" "shift workspace down screen" $ swapPrevScreen >> prevScreen
|
||||
]
|
||||
|
||||
-- dummy map for dunst commands (defined separately but this makes them show
|
||||
-- up in the help menu)
|
||||
mkNamedSubmap "Dunst"
|
||||
[ ("M-`", "dunst history", return ())
|
||||
, ("M-S-`", "dunst close", return ())
|
||||
, ("M-M1-`", "dunst context menu", return ())
|
||||
, ("M-C-`", "dunst close all", return ())
|
||||
] ++
|
||||
|
||||
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)
|
||||
, KeyGroup "Dunst"
|
||||
[ KeyBinding "M-`" "dunst history" skip
|
||||
, KeyBinding "M-S-`" "dunst close" skip
|
||||
, KeyBinding "M-M1-`" "dunst context menu" skip
|
||||
, KeyBinding "M-C-`" "dunst close all" skip
|
||||
]
|
||||
]
|
||||
|
||||
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
|
||||
mkNamedSubmap header bindings = (subtitle header:) $ mkNamedKeymap c
|
||||
$ map (\(key, name, cmd) -> (key, addName name cmd)) bindings
|
||||
go k@KeyGroup { kgBindings = bs } =
|
||||
(\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 System.IO
|
||||
import System.Directory (getXdgDirectory, XdgDirectory(..))
|
||||
|
||||
import XMonad.Core hiding (spawn)
|
||||
import XMonad.Internal.Process
|
||||
|
@ -25,13 +26,28 @@ import XMonad.Internal.Shell
|
|||
import XMonad.Util.NamedActions
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Other internal functions
|
||||
-- | DMenu executables
|
||||
|
||||
myDmenuCmd :: String
|
||||
myDmenuCmd = "rofi"
|
||||
|
||||
spawnDmenuCmd :: [String] -> X ()
|
||||
spawnDmenuCmd = spawnCmd myDmenuCmd
|
||||
myDmenuDevices :: String
|
||||
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 hexColor =
|
||||
|
@ -45,18 +61,19 @@ myDmenuMatchingArgs = ["-i"] -- case insensitivity
|
|||
--------------------------------------------------------------------------------
|
||||
-- | Exported Commands
|
||||
|
||||
devSecrets :: [String]
|
||||
devSecrets = ["-c", "/home/ndwar/.config/rofi/devices.yml"]
|
||||
runDevMenu :: IO MaybeX
|
||||
runDevMenu = runIfInstalled [myDmenuDevices] $ do
|
||||
c <- io $ getXdgDirectory XdgConfig "rofi/devices.yml"
|
||||
spawnCmd myDmenuDevices
|
||||
$ ["-c", c]
|
||||
++ "--" : themeArgs "#999933"
|
||||
++ myDmenuMatchingArgs
|
||||
|
||||
runDevMenu :: X ()
|
||||
runDevMenu = spawnCmd "rofi-dev" $ devSecrets ++ rofiArgs
|
||||
where
|
||||
rofiArgs = "--" : themeArgs "#999933" ++ myDmenuMatchingArgs
|
||||
|
||||
runBwMenu :: X ()
|
||||
runBwMenu = spawnCmd "rofi-bw" $ ["-c", "--"] ++ themeArgs "#bb6600"
|
||||
++ myDmenuMatchingArgs
|
||||
runBwMenu :: IO MaybeX
|
||||
runBwMenu = runIfInstalled [myDmenuPasswords] $
|
||||
spawnCmd myDmenuPasswords $ ["-c", "--"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
|
||||
|
||||
-- TODO what to do with this if rofi doesn't exist?
|
||||
runShowKeys :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
|
||||
runShowKeys x = addName "Show Keybindings" $ do
|
||||
(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"]
|
||||
++ themeArgs "#a200ff" ++ myDmenuMatchingArgs
|
||||
|
||||
runCmdMenu :: X ()
|
||||
runCmdMenu :: IO MaybeX
|
||||
runCmdMenu = spawnDmenuCmd ["-show", "run"]
|
||||
|
||||
runAppMenu :: X ()
|
||||
runAppMenu :: IO MaybeX
|
||||
runAppMenu = spawnDmenuCmd ["-show", "drun"]
|
||||
|
||||
runClipMenu :: X ()
|
||||
-- TODO this also depends on greenclip
|
||||
runClipMenu :: IO MaybeX
|
||||
runClipMenu = spawnDmenuCmd $
|
||||
[ "-modi", "\"clipboard:greenclip print\""
|
||||
, "-show", "clipboard"
|
||||
, "-run-command", "'{cmd}'"
|
||||
] ++ themeArgs "#00c44e"
|
||||
|
||||
runWinMenu :: X ()
|
||||
runWinMenu :: IO MaybeX
|
||||
runWinMenu = spawnDmenuCmd ["-show", "window"]
|
||||
|
||||
runNetMenu :: X ()
|
||||
runNetMenu = spawnCmd "networkmanager_dmenu" $ themeArgs "#ff3333"
|
||||
runNetMenu :: IO MaybeX
|
||||
runNetMenu = spawnCmdIfInstalled myDmenuNetworks $ themeArgs "#ff3333"
|
||||
|
||||
runAutorandrMenu :: X ()
|
||||
runAutorandrMenu = spawnCmd "rofi-autorandr" $ themeArgs "#ff0066"
|
||||
runAutorandrMenu :: IO MaybeX
|
||||
runAutorandrMenu = spawnCmdIfInstalled myDmenuMonitors $ themeArgs "#ff0066"
|
||||
|
|
|
@ -52,75 +52,103 @@ import XMonad.Internal.Shell
|
|||
import XMonad.Operations
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Some nice apps
|
||||
-- | My Executables
|
||||
|
||||
myTerm :: String
|
||||
myTerm = "urxvt"
|
||||
|
||||
runTerm :: X ()
|
||||
runTerm = spawn myTerm
|
||||
myBrowser :: String
|
||||
myBrowser = "brave-accel"
|
||||
|
||||
runTMux :: X ()
|
||||
runTMux = spawn
|
||||
$ "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
|
||||
myEditor :: String
|
||||
myEditor = "emacsclient"
|
||||
|
||||
myMultimediaCtl :: String
|
||||
myMultimediaCtl = "playerctl"
|
||||
|
||||
runTogglePlay :: X ()
|
||||
runTogglePlay = spawnCmd myMultimediaCtl ["play-pause"]
|
||||
myBluetooth :: String
|
||||
myBluetooth = "bluetoothctl"
|
||||
|
||||
runPrevTrack :: X ()
|
||||
runPrevTrack = spawnCmd myMultimediaCtl ["previous"]
|
||||
myCapture :: String
|
||||
myCapture = "flameshot"
|
||||
|
||||
runNextTrack :: X ()
|
||||
runNextTrack = spawnCmd myMultimediaCtl ["next"]
|
||||
myImageBrowser :: String
|
||||
myImageBrowser = "feh"
|
||||
|
||||
runStopPlay :: X ()
|
||||
runStopPlay = spawnCmd myMultimediaCtl ["stop"]
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Misc constants
|
||||
|
||||
volumeChangeSound :: FilePath
|
||||
volumeChangeSound = "smb_fireball.wav"
|
||||
|
||||
runVolumeDown :: X ()
|
||||
runVolumeDown = spawnSound volumeChangeSound >> void (lowerVolume 2)
|
||||
ethernetIface :: String
|
||||
ethernetIface = "enp7s0f1"
|
||||
|
||||
runVolumeUp :: X ()
|
||||
runVolumeUp = spawnSound volumeChangeSound >> void (raiseVolume 2)
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Some nice apps
|
||||
|
||||
runVolumeMute :: X ()
|
||||
runVolumeMute = void toggleMute >> spawnSound volumeChangeSound
|
||||
runTerm :: IO MaybeX
|
||||
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
|
||||
|
||||
runToggleBluetooth :: X ()
|
||||
runToggleBluetooth = spawn
|
||||
$ "bluetoothctl show | grep -q \"Powered: no\""
|
||||
runToggleBluetooth :: IO MaybeX
|
||||
runToggleBluetooth = runIfInstalled [myBluetooth] $ spawn
|
||||
$ myBluetooth ++ " show | grep -q \"Powered: no\""
|
||||
#!&& "a=on"
|
||||
#!|| "a=off"
|
||||
#!>> fmtCmd "bluetoothctl" ["power", "$a", ">", "/dev/null"]
|
||||
#!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
|
||||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" }
|
||||
|
||||
runIncBacklight :: X ()
|
||||
|
@ -138,11 +166,8 @@ runMaxBacklight = io $ void callMaxBrightness
|
|||
runToggleDPMS :: X ()
|
||||
runToggleDPMS = io $ void callToggle
|
||||
|
||||
ethernetIface :: String
|
||||
ethernetIface = "enp7s0f1"
|
||||
|
||||
runToggleEthernet :: X ()
|
||||
runToggleEthernet = spawn
|
||||
runToggleEthernet :: IO MaybeX
|
||||
runToggleEthernet = runIfInstalled ["nmcli"] $ spawn
|
||||
$ "nmcli -g GENERAL.STATE device show " ++ ethernetIface ++ " | grep -q disconnected"
|
||||
#!&& "a=connect"
|
||||
#!|| "a=disconnect"
|
||||
|
@ -199,25 +224,25 @@ getCaptureDir = do
|
|||
where
|
||||
fallback = (</> ".local/share") <$> getHomeDirectory
|
||||
|
||||
runFlameshot :: String -> X ()
|
||||
runFlameshot mode = do
|
||||
runFlameshot :: String -> IO MaybeX
|
||||
runFlameshot mode = runIfInstalled [myCapture] $ do
|
||||
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
|
||||
-- in the root window?) ...need to fix
|
||||
runAreaCapture :: X ()
|
||||
runAreaCapture :: IO MaybeX
|
||||
runAreaCapture = runFlameshot "gui"
|
||||
|
||||
-- myWindowCap = "screencap -w" --external script
|
||||
|
||||
runScreenCapture :: X ()
|
||||
runScreenCapture = runFlameshot "screen"
|
||||
|
||||
runDesktopCapture :: X ()
|
||||
runDesktopCapture :: IO MaybeX
|
||||
runDesktopCapture = runFlameshot "full"
|
||||
|
||||
runCaptureBrowser :: X ()
|
||||
runCaptureBrowser = do
|
||||
runScreenCapture :: IO MaybeX
|
||||
runScreenCapture = runFlameshot "screen"
|
||||
|
||||
runCaptureBrowser :: IO MaybeX
|
||||
runCaptureBrowser = runIfInstalled [myImageBrowser] $ do
|
||||
dir <- io getCaptureDir
|
||||
spawnCmd "feh" [dir]
|
||||
spawnCmd myImageBrowser [dir]
|
||||
|
|
|
@ -31,8 +31,8 @@ import XMonad.Prompt.ConfirmPrompt
|
|||
--------------------------------------------------------------------------------
|
||||
-- | Core commands
|
||||
|
||||
runScreenLock :: X ()
|
||||
runScreenLock = spawn "screenlock"
|
||||
runScreenLock :: IOMaybeX
|
||||
runScreenLock = spawnIfInstalled "screenlock"
|
||||
|
||||
runPowerOff :: X ()
|
||||
runPowerOff = spawn "systemctl poweroff"
|
||||
|
@ -119,6 +119,6 @@ runPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction
|
|||
sendAction a = setInput (show $ fromEnum a) >> setSuccess True >> setDone True
|
||||
executeAction a = case toEnum $ read a of
|
||||
Poweroff -> runPowerOff
|
||||
Shutdown -> runScreenLock >> runSuspend
|
||||
Hibernate -> runScreenLock >> runHibernate
|
||||
Shutdown -> (io runScreenLock >>= whenInstalled) >> runSuspend
|
||||
Hibernate -> (io runScreenLock >>= whenInstalled) >> runHibernate
|
||||
Reboot -> runReboot
|
||||
|
|
|
@ -23,6 +23,7 @@ import System.IO.Streams.UnixSocket
|
|||
|
||||
import XMonad.Core
|
||||
import XMonad.Internal.Command.Power
|
||||
import XMonad.Internal.Shell
|
||||
import XMonad.Internal.Concurrent.ClientMessage
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
@ -100,4 +101,6 @@ handleACPI tag = do
|
|||
Sleep -> runSuspendPrompt
|
||||
LidClose -> do
|
||||
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
|
||||
|
||||
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.
|
||||
-- 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
|
||||
|
||||
module XMonad.Internal.Shell
|
||||
( fmtCmd
|
||||
( MaybeExe(..)
|
||||
, MaybeX
|
||||
, IOMaybeX
|
||||
, runIfInstalled
|
||||
, whenInstalled
|
||||
, spawnIfInstalled
|
||||
, spawnCmdIfInstalled
|
||||
, noCheck
|
||||
, fmtCmd
|
||||
, spawnCmd
|
||||
, spawnSound
|
||||
, playSound
|
||||
, doubleQuote
|
||||
, singleQuote
|
||||
, skip
|
||||
, (#!&&)
|
||||
, (#!||)
|
||||
, (#!>>)
|
||||
) where
|
||||
|
||||
import Control.Monad (filterM)
|
||||
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
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | 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
|
||||
|
||||
|
@ -31,8 +77,12 @@ spawnCmd cmd args = spawn $ fmtCmd cmd args
|
|||
soundDir :: FilePath
|
||||
soundDir = "sound"
|
||||
|
||||
spawnSound :: MonadIO m => FilePath -> m ()
|
||||
spawnSound file = do
|
||||
spawnSound :: MonadIO m => FilePath -> m () -> m () -> IO (MaybeExe m)
|
||||
spawnSound file pre post = runIfInstalled ["paplay"]
|
||||
$ pre >> playSound file >> post
|
||||
|
||||
playSound :: MonadIO m => FilePath -> m ()
|
||||
playSound file = do
|
||||
path <- (</> soundDir </> file) <$> getXMonadDir
|
||||
-- paplay seems to have less latency than aplay
|
||||
spawnCmd "paplay" [path]
|
||||
|
|
Loading…
Reference in New Issue