xmonad-config/bin/xmonad.hs

{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE LambdaCase #-}

module Main (main) where

import ACPI
import SendXMsg
import qualified Theme as T

import Control.Monad (foldM, mapM_, forM_, void, when)

import Data.List (find, sortBy, sortOn)
import qualified Data.Map.Lazy as M
import Data.Maybe (isJust)
import Data.Monoid (All(..))

import Graphics.X11.Xlib.Atom
import Graphics.X11.Xlib.Extras
import Graphics.X11.Types
import Graphics.X11.Xrandr

import Control.Arrow (first)
import Control.Exception

import System.Directory
import System.Exit
import System.IO
import System.Process (waitForProcess)
import System.Process.Internals
  ( ProcessHandle__(ClosedHandle, OpenHandle)
  , withProcessHandle
  , mkProcessHandle)
import System.Posix.IO
import System.Posix.Process
import System.Posix.Signals
import System.Posix.Types

import Text.Read (readMaybe)

import XMonad
import XMonad.Actions.CopyWindow
import XMonad.Actions.CycleWS
import XMonad.Actions.DynamicWorkspaces
import XMonad.Actions.PhysicalScreens
import XMonad.Actions.Volume
-- import XMonad.Config.Desktop
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.EwmhDesktops
import XMonad.Hooks.ManageDocks
-- import XMonad.Layout.IndependentScreens
import XMonad.Hooks.ManageHelpers
-- import XMonad.Layout.BinarySpacePartition (emptyBSP)
-- import XMonad.Layout.DragPane
-- import XMonad.Layout.IM
-- import XMonad.Layout.LayoutCombinators hiding ((|||))
import XMonad.Layout.Named
import XMonad.Layout.NoBorders
import XMonad.Layout.NoFrillsDecoration
import XMonad.Layout.PerWorkspace
-- import XMonad.Layout.ResizableTile
import XMonad.Layout.Tabbed
-- import XMonad.Layout.ToggleLayouts (ToggleLayout(..), toggleLayouts)
import XMonad.Prompt
import XMonad.Prompt.ConfirmPrompt
-- import XMonad.Prompt.XMonad
-- import XMonad.Prompt.Shell
import XMonad.Util.EZConfig
import XMonad.Util.NamedActions
import XMonad.Util.Run
-- import XMonad.Util.WindowProperties

import qualified XMonad.StackSet as W

main = do
  (barPID, h) <- spawnPipe' "xmobar"
  pwrPID <- spawnPID "powermon"
  launch
    $ ewmh
    $ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [pwrPID, barPID])
    $ def { terminal = myTerm
          , modMask = myModMask
          , layoutHook = myLayouts
          , manageHook = myManageHook <+> manageDocks <+> manageHook def
          , handleEventHook = myEventHook <+> docksEventHook <+> handleEventHook def
          , startupHook = docksStartupHook <+> startupHook def
          , workspaces = myWorkspaces
          , logHook = myLoghook h
          , clickJustFocuses = False
          , focusFollowsMouse = False
          }

spawnPipe' :: MonadIO m => String -> m (ProcessID, Handle)
spawnPipe' x = io $ do
    (rd, wr) <- createPipe
    setFdOption wr CloseOnExec True
    h <- fdToHandle wr
    hSetBuffering h LineBuffering
    p <- xfork $ do
          _ <- dupTo rd stdInput
          executeFile "/bin/sh" False ["-c", x] Nothing
    closeFd rd
    return (p, h)

myWorkspaces = map show [1..10 :: Int]

myVMWorkspace = "VM"
myGimpWorkspace = "GIMP"

myLayouts = onWorkspace myVMWorkspace (noBorders Full)
  -- $ onWorkspace myGimpWorkspace gimpLayout
  $ tall ||| single ||| full
  where
    addTopBar = noFrillsDeco shrinkText T.tabbedTheme
    tall = named "Tall"
      $ avoidStruts
      $ addTopBar
      $ noBorders
      $ Tall 1 0.03 0.5
    single = named "Tabbed"
      -- $ addTopBar
      $ avoidStruts
      $ noBorders
      $ tabbedAlways shrinkText T.tabbedTheme
    full = named "Full"
      $ noBorders Full
    -- gimpLayout = named "Gimp Layout"
    --   $ avoidStruts
    --   $ (tabbedAlways shrinkText defaultTheme) ****||* Full
    --   -- $ withIM (11/64) (Or (Title "Toolbox") (Title "Tool Options"))
    --   -- $ (tabbedAlways shrinkText defaultTheme)

-- | Format workspace and layout in loghook
-- The format will be like "[<1> 2 3] 4 5 | LAYOUT" where each digit
-- is the workspace and LAYOUT is the current layout. Each workspace
-- in the brackets is currently visible and the order reflects the
-- physical location of each screen. The "<>" is the workspace
-- that currently has focus
myLoghook h = withWindowSet $ io . hPutStrLn h . myWindowSetXinerama

myWindowSetXinerama ws = wsString ++ sep ++ layout
  where
    wsString = xmobarColor T.backdropFgColor "" $ onscreen ++ offscreen'
    offscreen' = if null offscreen then "" else " " ++ offscreen
    sep = xmobarColor T.backdropFgColor "" " : "
    onscreen = xmobarColor hilightFgColor hilightBgColor
      $ wrap " " " "
      $ unwords
      $ map (fmtTags . W.tag . W.workspace)
      . sortBy compareXCoord
      $ W.current ws : W.visible ws
    fmtTags t = if t == W.currentTag ws
      then xmobarColor T.fgColor hilightBgColor t
      else t
    offscreen = unwords
      $ map W.tag
      . filter (isJust . W.stack)
      . sortOn W.tag
      $ W.hidden ws
    hilightBgColor = "#8fc7ff"
    hilightFgColor = T.blend' 0.5 hilightBgColor T.fgColor
    layout = description . W.layout . W.workspace . W.current $ ws
    compareXCoord s0 s1 = compare x0 x1
      where
        (_, Rectangle x0 _ _ _) = getScreenIdAndRectangle s0
        (_, Rectangle x1 _ _ _) = getScreenIdAndRectangle s1

getFocusedScreen :: X Rectangle
getFocusedScreen = withWindowSet $ return . screenRect . W.screenDetail . W.current

myManageHook = composeOne
  -- assume virtualbox is not run with the toolbar in fullscreen mode
  -- as this makes a new window that confusingly must go over the
  -- actual VM window
  [ className =? "VirtualBoxVM" -?> doShift myVMWorkspace
  -- the seafile applet
  , className =? "Seafile Client" -?> doFloat
  -- gnucash
  , (className =? "Gnucash" <&&> title =? "Transaction Import Assistant") -?> doFloat
  -- xsane
  , className =? "Xsane" -?> doFloat
  -- all of GIMP
  , className =? "Gimp" -?> doFloat >> doShift myGimpWorkspace
  -- , title =? "GIMP Startup" -?> doIgnore
  -- plots and graphics created by R
  , className =? "R_x11" -?> doFloat
  , className =? "mpv"    -?> doFloat
  -- the floating windows created by the brave browser
  , stringProperty "WM_NAME" =? "Brave" -?> doFloat
  , (stringProperty "WM_WINDOW_ROLE" =? "pop-up"
     <&&> className =? "Brave-browser") -?> doFloat
  -- the dialog windows created by the zotero addon in Google Docs
  , (className =? "Zotero" <&&> resource =? "Toplevel") -?> doFloat
  , isDialog              -?> doCenterFloat
  ]

-- This is a giant hack to "listen" for applications that close. Some
-- apps like Virtualbox go on their own workspace which is dynamically
-- created. But I want said workspace to disappear when the app
-- closes. This is actually hard. We can't just listen to
-- DestroyWindow events as VBox will "destroy" windows when it
-- switches to fullscreen and back. We also can't just monitor the
-- process from the window since WindowDestroy events don't have PIDs
-- attached to them. Therefore, the hack to make this all work is to
-- make a script fire when VirtualBox (and other apps that I want to
-- control in this manner) close. This script fires a bogus
-- ClientMessage event to the root window. This event will have a
-- BITMAP atom (which should do nothing) and a "magic string" in the
-- data field that can be intercepted here. When this event is
-- registered here, close the dynamic workspaces that are empty.
myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
  | t == bITMAP = do
    let (magic, tag) = splitXMsg d
    if | magic == magicStringWS -> removeEmptyWorkspaceByTag' tag
       | magic == acpiMagic -> do
         let acpiTag = readMaybe tag :: Maybe ACPIEvent
         forM_ acpiTag $ \case
           Power -> myPowerPrompt
           Sleep -> confirmPrompt T.promptTheme "suspend?" runSuspend
           LidClose -> do
             status <- io isDischarging
             forM_ status $ \s -> runScreenLock >> when s runSuspend
       | otherwise -> return ()
    return (All True)
  | otherwise = return (All True)
myEventHook _ = return (All True)

removeEmptyWorkspaceByTag' tag = do
  -- TODO this function works by first hiding the workspace to be
  -- removed and then removing it. This won't work if there are no
  -- other hidden workspaces to take it's place. So, need to scan
  -- through the list of workspaces and swap the first one that is
  -- empty with the workspace to be removed. If it actually is empty,
  -- this will be enough to make it disappear.
  removeEmptyWorkspaceByTag tag

data PowerPrompt = PowerPrompt

instance XPrompt PowerPrompt where
    showXPrompt PowerPrompt = "(P)oweroff (S)uspend (H)ibernate (R)eboot:"

runScreenLock :: X ()
runScreenLock = spawn "screenlock"

runPowerOff :: X ()
runPowerOff = spawn "systemctl poweroff"

runSuspend :: X ()
runSuspend = spawn "systemctl suspend"

runHibernate :: X ()
runHibernate = spawn "systemctl hibernate"

runReboot :: X ()
runReboot = spawn "systemctl reboot"

myPowerPrompt :: X ()
myPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction
  where
    comp = mkComplFunFromList []
    theme = T.promptTheme { promptKeymap = keymap }
    keymap = M.fromList
      $ ((controlMask, xK_g), quit) :
      map (first $ (,) 0)
      [ (xK_p, sendAction "p")
      , (xK_s, sendAction "s")
      , (xK_h, sendAction "h")
      , (xK_r, sendAction "r")
      , (xK_Return, quit)
      , (xK_Escape, quit)
      ]
    sendAction a = setInput a >> setSuccess True >> setDone True
    executeAction a
      | a == "p" = runPowerOff
      | a == "s" = runScreenLock >> runSuspend
      | a == "h" = runScreenLock >> runHibernate
      | a == "r" = runReboot
      | otherwise = return () -- should never happen

myQuitPrompt :: X ()
myQuitPrompt = confirmPrompt T.promptTheme "quit?" $ io exitSuccess

-- TODO for some reason the screen never wakes up after suspend when
-- the nvidia card is up, so block suspend if nvidia card is running
-- and warn user
isUsingNvidia :: IO Bool
isUsingNvidia = doesDirectoryExist "/sys/module/nvidia"

runOptimusPrompt :: X ()
runOptimusPrompt = do
  nvidiaOn <- io isUsingNvidia
  switch $ if nvidiaOn then "intel" else "nvidia"
  where
    switch mode = confirmPrompt T.promptTheme (prompt mode) (cmd mode)
    prompt mode = "gpu switch to " ++ mode ++ "?"
    cmd mode = spawnCmd "optimus-manager"
      ["--switch", mode, "--no-confirm"]
      >> io exitSuccess

-- shell commands

fmtCmd :: String -> [String] -> String
fmtCmd cmd args = unwords $ cmd : args

spawnCmd :: String -> [String] -> X ()
spawnCmd cmd args = spawn $ fmtCmd cmd args

(#!&&) :: String -> String -> String
cmdA #!&& cmdB = cmdA ++ " && " ++ cmdB

infixr 0 #!&&

(#!||) :: String -> String -> String
cmdA #!|| cmdB = cmdA ++ " || " ++ cmdB

infixr 0 #!||

(#!>>) :: String -> String -> String
cmdA #!>> cmdB = cmdA ++ "; " ++ cmdB

infixr 0 #!>>

magicStringWS :: String
magicStringWS = "%%%%%"

spawnCmdOwnWS :: String -> [String] -> String -> X ()
spawnCmdOwnWS cmd args ws = spawn
  $ fmtCmd cmd args
  #!&& fmtCmd "xit-event" [magicStringWS, ws]

-- spawnKill :: [String] -> X ()
-- spawnKill = mapM_ (spawn . ("killall " ++))

myTerm :: String
myTerm = "urxvt"

runTerm :: X ()
runTerm = spawn myTerm

runCalc :: X ()
runCalc = spawnCmd myTerm ["-e", "R"]

myDmenuCmd :: String
myDmenuCmd = "rofi"

-- TODO this almost works except when a workspace with no windows is
-- focuses. In this case, rofi considers the root window to be focused
-- 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

-- TODO simplify the convoluted garbage heap...to be fair, this is
-- going to be ugly simply because rofi uses xrandr and xmonad uses
-- xinerama to get screen information...and apparently these index
-- differently. However, I'm sure there's a way to condense this code
-- to something more sane :(
getMonitorName :: X (Maybe String)
getMonitorName = do
  dpy <- asks display
  root <- asks theRoot
  res <- io $ xrrGetScreenResourcesCurrent dpy root
  outputs <- io $ case res of
    Just res' -> foldM (procOutput dpy res') [] $ xrr_sr_outputs res'
    Nothing -> return []
  (Rectangle sx sy _ _) <- getFocusedScreen
  return $ case find (\(_, x, y) -> x == fromIntegral sx && y == fromIntegral sy) outputs of
    Just (name, _, _) -> Just name
    Nothing -> Nothing
  where
    procOutput dpy res acc output = do
      oi <- xrrGetOutputInfo dpy res output
      case oi of
        Just oi' -> procResources dpy res acc oi'
        Nothing -> return acc
    procResources dpy res acc oi = do
      let name = xrr_oi_name oi
      -- 0 = connected; 1 = disconnected
      if xrr_oi_connection oi == 0 then do
        ci <- xrrGetCrtcInfo dpy res $ xrr_oi_crtc oi
        return $ case ci of
          Just ci' -> (name, xrr_ci_x ci', xrr_ci_y ci') : acc
          Nothing -> acc
      else return acc

spawnDmenuCmd :: [String] -> X ()
spawnDmenuCmd args = do
  name <- getMonitorName
  case name of
    Just n -> spawnCmd myDmenuCmd $ ["-m", n] ++ args
    Nothing -> io $ putStrLn "fail"

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 = do
  name <- getMonitorName
  case name of
    Just n -> spawnCmd "networkmanager_dmenu" ["-m", n]
    Nothing -> io $ putStrLn "fail"

-- TODO this command does not know how to take external args
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"

getScreenshotDir :: IO FilePath
getScreenshotDir = do
  h <- getHomeDirectory
  return $ h ++ "/Pictures/screenshots"

runFlameshot :: String -> X ()
runFlameshot mode = do
  ssDir <- io getScreenshotDir
  spawnCmd "flameshot" $ 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 = runFlameshot "gui"

-- myWindowCap = "screencap -w" --external script

runScreenCapture :: X ()
runScreenCapture = runFlameshot "screen"

runDesktopCapture :: X ()
runDesktopCapture = runFlameshot "full"

runVBox :: X ()
runVBox = spawnCmdOwnWS "vbox-start win8raw" [] myVMWorkspace

runGimp :: X ()
runGimp = spawnCmdOwnWS "gimp" [] myGimpWorkspace

runCleanup :: [ProcessID] -> X ()
runCleanup ps = io $ mapM_ killPID ps

killPID :: ProcessID -> IO ()
killPID pID = do
  h <- mkProcessHandle pID False
  -- this may fail of the PID does not exist
  _ <- try $ sendSIGTERM h :: IO (Either IOException ())
  -- this may fail if the process exits instantly and the handle
  -- is destroyed by the time we get to this line (I think?)
  _ <- try $ waitForProcess h :: IO (Either IOException ExitCode)
  return ()
  where
    sendSIGTERM h = withProcessHandle h $ \case
      OpenHandle _ -> signalProcess sigTERM pID
      ClosedHandle _ -> return ()
      _ -> return () -- this should never happen

runRestart :: X ()
runRestart = restart "xmonad" True

runRecompile :: X ()
runRecompile = do
  -- assume that the conf directory contains a valid stack project
  -- TODO this is hacky AF
  confDir <- getXMonadDir
  spawn $ cmd confDir
  where
    cmd c = fmtCmd "cd" [c]
      #!&& fmtCmd "stack" ["install", ":xmonad"]
      #!&& fmtCmd "notify-send" ["\"compilation succeeded\""]
      #!|| fmtCmd "notify-send" ["\"compilation failed\""]

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 (raiseVolume 2)

runVolumeMute :: X ()
runVolumeMute = void toggleMute

-- TODO make a formatter for the notify command
runToggleBluetooth :: X ()
runToggleBluetooth = spawn
  $ "bluetoothctl show | grep -q \"Powered: no\""
  #!&& "a=on"
  #!|| "a=off"
  #!>> fmtCmd "bluetoothctl" ["power", "$a", ">", "/dev/null"]
  #!&& fmtCmd "notify-send" ["\"bluetooth powered $a\""]

-- TODO write these in haskell
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

enableDPMS :: X ()
enableDPMS = spawnCmd "xset" ["s", "on", "+dpms"]

disableDPMS :: X ()
disableDPMS = spawnCmd "xset" ["s", "off", "-dpms"]

-- keybindings

showKeybindings :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
showKeybindings x = addName "Show Keybindings" $ io $ do
    h <- spawnPipe cmd
    hPutStr h (unlines $ showKm x)
    hClose h
    return ()
  where cmd = fmtCmd myDmenuCmd $ myDmenuArgs ++
          [ "-dmenu"
          , "-p"
          , "commands"
          , "-theme-str"
          , "'#element.selected.normal { background-color: #a200ff; }'"
          ]

myModMask :: KeyMask
myModMask = mod4Mask

mkNamedSubmap
  :: XConfig l
     -> String
     -> [(String, NamedAction)]
     -> [((KeyMask, KeySym), NamedAction)]
mkNamedSubmap c sectionName bindings = 
  (subtitle sectionName:) $ mkNamedKeymap c bindings

-- NOTE: the following bindings are used by dunst:
-- "M-~", "M-<esc>", "M-S-<esc>", "M-S-."
myKeys :: [ProcessID] -> XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
myKeys hs c =
  mkNamedSubmap c "Window Layouts"
  [ ("M-j", addName "focus down" $ windows W.focusDown)
  , ("M-k", addName "focus up" $ windows W.focusUp)
  , ("M-m", addName "focus master" $ windows W.focusMaster)
  , ("M-S-j", addName "swap down" $ windows W.swapDown)
  , ("M-S-k", addName "swap up" $ windows W.swapUp)
  , ("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-k", addName "add master window" $ sendMessage (IncMasterN 1))
  , ("M-<Return>", addName "next layout" $ sendMessage NextLayout)
  , ("M-S-<Return>", addName "reset layout" $ setLayout $ XMonad.layoutHook c)
  , ("M-t", addName "sink tiling" $ withFocused $ windows . W.sink)
  , ("M--", addName "shrink" $ sendMessage Shrink)
  , ("M-=", addName "expand" $ sendMessage Expand)
  ] ++

  mkNamedSubmap c "Workspaces"
  -- NOTE this assumes that there are workspaces bound to numbers
  ([ (mods ++ show i, addName (msg ++ " " ++ show i) $ windows $ f w)
    | (w, i) <- zip (XMonad.workspaces c) [1..] :: [(String, Int)]
    , (mods, msg, f) <-
      [ ("M-", "switch to workspace", W.view)
      , ("M-S-", "move client to workspace", W.shift)]
  ] ++
  [ ("M-v", addName "switch to VM workspace" $ showWorkspace myVMWorkspace)
  , ("M-M1-g", addName "switch to Gimp workspace" $ showWorkspace myGimpWorkspace)
  ]) ++

  mkNamedSubmap c "Screens"
  [ ("M-l", addName "move up screen" nextScreen)
  , ("M-h", addName "move down screen" prevScreen)
  , ("M-C-l", addName "move client up screen" $ shiftNextScreen >> nextScreen)
  , ("M-C-h", addName "move client down screen" $ shiftPrevScreen >> prevScreen)
  , ("M-S-l", addName "shift up screen" $ swapNextScreen >> nextScreen)
  , ("M-S-h", addName "shift down screen" $ swapPrevScreen >> prevScreen)
  ] ++

  mkNamedSubmap c "Actions"
  [ ("M-q", addName "close window" kill1)
  , ("M-r", addName "run program" runCmdMenu)
  , ("M-C-s", addName "capture area" runAreaCapture)
  , ("M-C-S-s", addName "capture screen" runScreenCapture)
  , ("M-C-d", addName "capture desktop" runDesktopCapture)
  -- , ("M-C-S-s", addName "capture focused window" $ spawn myWindowCap)
  , ("M-<Delete>", addName "lock screen" runScreenLock)
  ] ++

  mkNamedSubmap c "Launchers"
  [ ("<XF86Search>", addName "select/launch app" runAppMenu)
  , ("M-g", addName "launch clipboard manager" runClipMenu)
  , ("M-a", addName "launch network selector" runNetMenu)
  , ("M-w", addName "launch window selector" runWinMenu)
  , ("M-u", addName "launch device selector" runDevMenu)
  , ("M-C-e", addName "launch editor" runEditor)
  , ("M-C-w", addName "launch browser" runBrowser)
  , ("M-C-t", addName "launch terminal" runTerm)
  , ("M-C-q", addName "launch calc" runCalc)
  , ("M-C-f", addName "launch file manager" runFileManager)
  , ("M-C-v", addName "launch windows VM" $ runVBox >> appendWorkspace myVMWorkspace)
  , ("M-C-g", addName "launch GIMP" $ runGimp >> appendWorkspace myGimpWorkspace)
  ] ++

  mkNamedSubmap c "Multimedia"
  [ ("<XF86AudioPlay>", addName "toggle play/pause" runTogglePlay)
  , ("<XF86AudioPrev>", addName "previous track" runPrevTrack)
  , ("<XF86AudioNext>", addName "next track" runNextTrack)
  , ("<XF86AudioStop>", addName "stop" runStopPlay)
  , ("<XF86AudioLowerVolume>", addName "volume down" runVolumeDown)
  , ("<XF86AudioRaiseVolume>", addName "volume up" runVolumeUp)
  , ("<XF86AudioMute>", addName "volume mute" runVolumeMute)
  , ("M-C-b", addName "toggle bluetooth" runToggleBluetooth)
  ] ++

  mkNamedSubmap c "System"
  [ ("M-.", addName "backlight up" runIncBacklight)
  , ("M-,", addName "backlight down" runDecBacklight)
  , ("M-M1-,", addName "backlight min" runMinBacklight)
  , ("M-M1-.", addName "backlight max" runMaxBacklight)
  , ("M-M1-=", addName "enable screensaver" enableDPMS)
  , ("M-M1--", addName "disable screensaver" disableDPMS)
  , ("M-<F2>", addName "restart xmonad" $ runCleanup hs >> runRestart)
  , ("M-S-<F2>", addName "recompile xmonad" runRecompile)
  , ("M-<End>", addName "power menu" myPowerPrompt)
  , ("M-<Home>", addName "quit xmonad" myQuitPrompt)
  , ("M-<Esc>", addName "switch gpu" runOptimusPrompt)
  ]