REF keymaps and commands

This commit is contained in:
Nathan Dwarshuis 2020-03-14 14:54:23 -04:00
parent 97b0dc2e8b
commit 7c4f005f03
1 changed files with 187 additions and 73 deletions

260
xmonad.hs
View File

@ -201,7 +201,7 @@ myManageHook = composeOne
myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d } myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
| t == bITMAP = do | t == bITMAP = do
let (magic, tag) = splitXMsg d let (magic, tag) = splitXMsg d
if | magic == magicString -> removeEmptyWorkspaceByTag' tag if | magic == magicStringWS -> removeEmptyWorkspaceByTag' tag
| magic == acpiMagic -> do | magic == acpiMagic -> do
let acpiTag = readMaybe tag :: Maybe ACPIEvent let acpiTag = readMaybe tag :: Maybe ACPIEvent
forM_ acpiTag $ \case forM_ acpiTag $ \case
@ -281,12 +281,22 @@ data PowerPrompt = PowerPrompt
instance XPrompt PowerPrompt where instance XPrompt PowerPrompt where
showXPrompt PowerPrompt = "Select Option: " showXPrompt PowerPrompt = "Select Option: "
runScreenLock = spawn myScreenLock runScreenLock :: X ()
runScreenLock = spawn "screenlock"
runPowerOff :: X ()
runPowerOff = spawn "systemctl poweroff" runPowerOff = spawn "systemctl poweroff"
runSuspend :: X ()
runSuspend = spawn "systemctl suspend" runSuspend = spawn "systemctl suspend"
runHibernate :: X ()
runHibernate = spawn "systemctl hibernate" runHibernate = spawn "systemctl hibernate"
runReboot :: X ()
runReboot = spawn "systemctl reboot" runReboot = spawn "systemctl reboot"
myPowerPrompt :: X ()
myPowerPrompt = mkXPrompt PowerPrompt conf comps myPowerPrompt = mkXPrompt PowerPrompt conf comps
$ fromMaybe (return ()) $ fromMaybe (return ())
. (`lookup` commands) . (`lookup` commands)
@ -300,57 +310,152 @@ myPowerPrompt = mkXPrompt PowerPrompt conf comps
, ("reboot", runReboot) , ("reboot", runReboot)
] ]
-- osd myQuitPrompt :: X ()
myQuitPrompt = confirmPrompt myPromptTheme "quit?" $ io exitSuccess
-- getOffset :: X Int -- shell commands
-- getOffset = withWindowSet $
-- \W.StackSet { W.current = W.Screen { W.screenDetail = SD { screenRect = Rectangle {rect_x=x}}}} -> return $
-- fromIntegral x
-- displayOsd osd msg = do formatCmd :: String -> [String] -> String
-- xpos <- getOffset formatCmd cmd args = unwords $ cmd : args
-- io $ set osd [HOffset xpos]
-- io $ Graphics.XOSD.display osd 0 msg
-- showVolume :: XOSD -> X () spawnCmd :: String -> [String] -> X ()
-- showVolume osd = do spawnCmd cmd args = spawn $ formatCmd cmd args
-- volume <- io $ fmap round $ getVolumeChannels ["default"]
-- muted <- io $ getMute
-- displayOsd osd $ Percent $ if muted then 0 else volume
-- keybindings (#!&&) :: String -> String -> String
myModMask = mod4Mask cmdA #!&& cmdB = cmdA ++ " && " ++ cmdB
_myRofi = "rofi -m -4" -- show rofi always with the focused window infixr 0 #!&&
magicStringWS :: String
magicStringWS = "%%%%%"
spawnCmdOwnWS :: String -> [String] -> String -> X ()
spawnCmdOwnWS cmd args ws = spawn
$ formatCmd cmd args
#!&& formatCmd "xit-event" [magicStringWS, ws]
spawnKill :: [String] -> X ()
spawnKill cmds = spawn $ formatCmd "killall" cmds
myTerm :: String
myTerm = "urxvt" myTerm = "urxvt"
myBrowser = "brave"
myEditor = "emacsclient -c -e \"(select-frame-set-input-focus (selected-frame))\"" runTerm :: X ()
myCalc = "urxvt -e R" runTerm = spawn myTerm
myFileManager = "pcmanfm"
myRun = _myRofi ++ " -show run" runCalc :: X ()
myAppRun = _myRofi ++ " -show drun" runCalc = spawnCmd myTerm ["-e", "R"]
myClipboard = _myRofi ++ " -modi \"clipboard:greenclip print\" \
\-show clipboard -run-command '{cmd}' \ myDmenuCmd :: String
\-theme-str '#element.selected.normal \ myDmenuCmd = "rofi"
\{ background-color: #00c44e; }'"
myNetSel = "networkmanager_dmenu -m -4" -- TODO this almost works except when a workspace with no windows is
myWinSel = _myRofi ++ " -show window" -- focuses. In this case, rofi considers the root window to be focused
myDevSel = "rofi-devices" -- and will showup wherever the mouse pointer is. Need a way to get
-- the focused workspace and translate that to a monitor number for
-- rofi to consume
myDmenuArgs :: [String]
myDmenuArgs = ["-m", "-4"] -- show rofi with the focused window
spawnDmenuCmd :: [String] -> X ()
spawnDmenuCmd args = spawnCmd myDmenuCmd $ myDmenuArgs ++ args
runCmdMenu :: X ()
runCmdMenu = spawnDmenuCmd ["-show", "run"]
runAppMenu :: X ()
runAppMenu = spawnDmenuCmd ["-show", "drun"]
runClipMenu :: X ()
runClipMenu = spawnDmenuCmd
[ "-modi", "\"clipboard:greenclip print\""
, "-show", "clipboard"
, "-run-command", "'{cmd}'"
, "-theme-str", "'#element.selected.normal { background-color: #00c44e; }'"
]
runWinMenu :: X ()
runWinMenu = spawnDmenuCmd ["-show", "window"]
runNetMenu :: X ()
runNetMenu = spawnCmd "networkmanager_dmenu" myDmenuArgs
runDevMenu :: X ()
runDevMenu = spawn "rofi-devices"
runBrowser :: X ()
runBrowser = spawn "brave"
runEditor :: X ()
runEditor = spawnCmd "emacsclient"
["-c", "-e", "(select-frame-set-input-focus (selected-frame))\""]
runFileManager :: X ()
runFileManager = spawn "pcmanfm"
-- 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
myScreenCap = "flameshot gui" --external script runScreenCap :: X ()
runScreenCap = spawn "flameshot gui"
-- myWindowCap = "screencap -w" --external script -- myWindowCap = "screencap -w" --external script
myScreenLock = "screenlock" --external script
removeWorkspaceOnExit cmd ws = runVBox :: X ()
unwords [cmd, "&&", "xit-event", magicString, ws] runVBox = spawnCmdOwnWS "vbox-start win8raw" [] myVMWorkspace
magicString = "%%%%%" runGimp :: X ()
runGimp = spawnCmdOwnWS "gimp" [] myGimpWorkspace
myVBox = removeWorkspaceOnExit "vbox-start win8raw" myVMWorkspace runCleanup :: X ()
myGimp = removeWorkspaceOnExit "gimp" myGimpWorkspace runCleanup = spawnKill ["xmobar", "powermon"]
showVBox = windows $ W.view myVMWorkspace runRestart :: X ()
runRestart = spawnCmd "xmonad" ["--restart"]
runRecompile :: X ()
runRecompile = spawnCmd "xmonad" ["--recompile"]
myMultimediaCtl :: String
myMultimediaCtl = "playerctl"
runTogglePlay :: X ()
runTogglePlay = spawnCmd myMultimediaCtl ["play-pause"]
runPrevTrack :: X ()
runPrevTrack = spawnCmd myMultimediaCtl ["previous"]
runNextTrack :: X ()
runNextTrack = spawnCmd myMultimediaCtl ["next"]
runStopPlay :: X ()
runStopPlay = spawnCmd myMultimediaCtl ["stop"]
runVolumeDown :: X ()
runVolumeDown = void (lowerVolume 2)
runVolumeUp :: X ()
runVolumeUp = void (lowerVolume 2)
runVolumeMute :: X ()
runVolumeMute = void toggleMute
runToggleBluetooth :: X ()
runToggleBluetooth = spawn "togglebt"
runIncBacklight :: X ()
runIncBacklight = spawnCmd "adj_backlight" ["up"]
runDecBacklight :: X ()
runDecBacklight = spawnCmd "adj_backlight" ["down"]
runMinBacklight :: X ()
runMinBacklight = spawnCmd "adj_backlight" ["min"]
runMaxBacklight :: X ()
runMaxBacklight = spawnCmd "adj_backlight" ["max"]
showWorkspace tag = windows $ W.view tag
-- keybindings
showKeybindings :: [((KeyMask, KeySym), NamedAction)] -> NamedAction showKeybindings :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
showKeybindings x = addName "Show Keybindings" $ io $ do showKeybindings x = addName "Show Keybindings" $ io $ do
@ -359,11 +464,20 @@ showKeybindings x = addName "Show Keybindings" $ io $ do
hClose h hClose h
return () return ()
myModMask :: KeyMask
myModMask = mod4Mask
mkNamedSubmap
:: XConfig l
-> String
-> [(String, NamedAction)]
-> [((KeyMask, KeySym), NamedAction)]
mkNamedSubmap c sectionName bindings = mkNamedSubmap c sectionName bindings =
(subtitle sectionName:) $ mkNamedKeymap c bindings (subtitle sectionName:) $ mkNamedKeymap c bindings
-- NOTE: the following bindings are used by dunst: -- NOTE: the following bindings are used by dunst:
-- "M-~", "M-<esc>", "M-S-<esc>", "M-S-." -- "M-~", "M-<esc>", "M-S-<esc>", "M-S-."
myKeys :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
myKeys c = myKeys c =
mkNamedSubmap c "Window Layouts" mkNamedSubmap c "Window Layouts"
[ ("M-j", addName "focus down" $ windows W.focusDown) [ ("M-j", addName "focus down" $ windows W.focusDown)
@ -372,6 +486,7 @@ myKeys c =
, ("M-S-j", addName "swap down" $ windows W.swapDown) , ("M-S-j", addName "swap down" $ windows W.swapDown)
, ("M-S-k", addName "swap up" $ windows W.swapUp) , ("M-S-k", addName "swap up" $ windows W.swapUp)
, ("M-S-m", addName "swap master" $ windows W.swapMaster) , ("M-S-m", addName "swap master" $ windows W.swapMaster)
-- TODO this will decrement past 0?
, ("M-C-j", addName "remove master window" $ sendMessage (IncMasterN (-1))) , ("M-C-j", addName "remove master window" $ sendMessage (IncMasterN (-1)))
, ("M-C-k", addName "add master window" $ sendMessage (IncMasterN 1)) , ("M-C-k", addName "add master window" $ sendMessage (IncMasterN 1))
, ("M-<Return>", addName "next layout" $ sendMessage NextLayout) , ("M-<Return>", addName "next layout" $ sendMessage NextLayout)
@ -389,8 +504,8 @@ myKeys c =
[ ("M-", "switch to workspace", W.view) [ ("M-", "switch to workspace", W.view)
, ("M-S-", "move client to workspace", W.shift)] , ("M-S-", "move client to workspace", W.shift)]
] ++ ] ++
[ ("M-v", addName "switch to VM workspace" showVBox) [ ("M-v", addName "switch to VM workspace" $ showWorkspace myVMWorkspace)
, ("M-M1-g", addName "switch to Gimp workspace" $ windows $ W.view myGimpWorkspace) , ("M-M1-g", addName "switch to Gimp workspace" $ showWorkspace myGimpWorkspace)
]) ++ ]) ++
mkNamedSubmap c "Screens" mkNamedSubmap c "Screens"
@ -404,46 +519,45 @@ myKeys c =
mkNamedSubmap c "Actions" mkNamedSubmap c "Actions"
[ ("M-q", addName "close window" kill1) [ ("M-q", addName "close window" kill1)
, ("M-r", addName "run program" $ spawn myRun) , ("M-r", addName "run program" runCmdMenu)
, ("M-C-s", addName "capture screen area" $ spawn myScreenCap) , ("M-C-s", addName "capture screen area" runScreenCap)
-- , ("M-C-S-s", addName "capture focused window" $ spawn myWindowCap) -- , ("M-C-S-s", addName "capture focused window" $ spawn myWindowCap)
, ("M-<Delete>", addName "lock screen" $ spawn myScreenLock) , ("M-<Delete>", addName "lock screen" runScreenLock)
] ++ ] ++
mkNamedSubmap c "Launchers" mkNamedSubmap c "Launchers"
[ ("<XF86Search>", addName "select/launch app" $ spawn myAppRun ) [ ("<XF86Search>", addName "select/launch app" runAppMenu)
, ("M-g", addName "launch clipboard manager" $ spawn myClipboard ) , ("M-g", addName "launch clipboard manager" runClipMenu)
, ("M-a", addName "launch network selector" $ spawn myNetSel ) , ("M-a", addName "launch network selector" runNetMenu)
, ("M-w", addName "launch window selector" $ spawn myWinSel ) , ("M-w", addName "launch window selector" runWinMenu)
, ("M-u", addName "launch device selector" $ spawn myDevSel ) , ("M-u", addName "launch device selector" runDevMenu)
, ("M-C-e", addName "launch editor" $ spawn myEditor) , ("M-C-e", addName "launch editor" runEditor)
, ("M-C-w", addName "launch browser" $ spawn myBrowser) , ("M-C-w", addName "launch browser" runBrowser)
, ("M-C-t", addName "launch terminal" $ spawn myTerm) , ("M-C-t", addName "launch terminal" runTerm)
, ("M-C-q", addName "launch calc" $ spawn myCalc) , ("M-C-q", addName "launch calc" runCalc)
, ("M-C-f", addName "launch file manager" $ spawn myFileManager) , ("M-C-f", addName "launch file manager" runFileManager)
, ("M-C-v", addName "launch windows VM" $ spawn myVBox >> appendWorkspace myVMWorkspace) , ("M-C-v", addName "launch windows VM" $ runVBox >> appendWorkspace myVMWorkspace)
, ("M-C-g", addName "launch GIMP" $ spawn myGimp >> appendWorkspace myGimpWorkspace) , ("M-C-g", addName "launch GIMP" $ runGimp >> appendWorkspace myGimpWorkspace)
] ++ ] ++
mkNamedSubmap c "Multimedia" mkNamedSubmap c "Multimedia"
[ ("<XF86AudioPlay>", addName "toggle play/pause" $ spawn "playerctl play-pause") [ ("<XF86AudioPlay>", addName "toggle play/pause" runTogglePlay)
, ("<XF86AudioPrev>", addName "previous track" $ spawn "playerctl previous") , ("<XF86AudioPrev>", addName "previous track" runPrevTrack)
, ("<XF86AudioNext>", addName "next track" $ spawn "playerctl next") , ("<XF86AudioNext>", addName "next track" runNextTrack)
, ("<XF86AudioStop>", addName "stop" $ spawn "playerctl stop") , ("<XF86AudioStop>", addName "stop" runStopPlay)
, ("<XF86AudioLowerVolume>", addName "volume down" $ void (lowerVolume 2)) , ("<XF86AudioLowerVolume>", addName "volume down" runVolumeDown)
, ("<XF86AudioRaiseVolume>", addName "volume up" $ void (raiseVolume 2)) , ("<XF86AudioRaiseVolume>", addName "volume up" runVolumeUp)
, ("<XF86AudioMute>", addName "volume mute" $ void toggleMute) , ("<XF86AudioMute>", addName "volume mute" runVolumeMute)
, ("M-C-b", addName "toggle bluetooth" $ spawn "togglebt") , ("M-C-b", addName "toggle bluetooth" runToggleBluetooth)
] ++ ] ++
mkNamedSubmap c "System" mkNamedSubmap c "System"
[ ("M-.", addName "backlight up" $ spawn "adj_backlight up") [ ("M-.", addName "backlight up" runIncBacklight)
, ("M-,", addName "backlight down" $ spawn "adj_backlight down") , ("M-,", addName "backlight down" runDecBacklight)
, ("M-M1-,", addName "backlight min" $ spawn "adj_backlight min") , ("M-M1-,", addName "backlight min" runMaxBacklight)
, ("M-M1-.", addName "backlight max" $ spawn "adj_backlight max") , ("M-M1-.", addName "backlight max" runMinBacklight)
, ("M-<F2>", addName "restart xmonad" $ spawn "killall xmobar; killall powermon; xmonad --restart") , ("M-<F2>", addName "restart xmonad" $ runCleanup >> runRestart)
, ("M-S-<F2>", addName "recompile xmonad" $ spawn "killall xmobar; killall powermon; xmonad --recompile && xmonad --restart") , ("M-S-<F2>", addName "recompile xmonad" $ runCleanup >> runRecompile)
, ("M-<End>", addName "power menu" myPowerPrompt) , ("M-<End>", addName "power menu" myPowerPrompt)
, ("M-<Home>", addName "quit xmonad" $ , ("M-<Home>", addName "quit xmonad" myQuitPrompt)
confirmPrompt myPromptTheme "Quit XMonad?" $ io exitSuccess)
] ]