xmonad のキー設定にヘルプ書けるようにしてくれる君。 mod + shift + / (?) でキー設定一覧表示したり、キー押された時に画面に表示したりする。

KeysWithHelp.hs

module XMonad.Util.KeysWithHelp
    ( h
    , keysWithHelp
    , keysWithHelp'
    , defaultKeysWithHelp
    , defaultKeysWithHelp'
    ) where

import XMonad
import XMonad.Actions.ShowText (defaultSTConfig, flashText)
import XMonad.Util.Run (runProcessWithInputAndWait)

import Control.Monad (when)
import Data.Bits ((.&.), complement)
import System.Exit (exitWith, ExitCode(ExitSuccess))
import qualified Data.Map as Map
import qualified XMonad.StackSet as W


type Help = String

h :: Help -> ((KeyMask, KeySym), X ()) -> (Help, ((KeyMask, KeySym), X ()))
h = (,)


keysWithHelp :: (XConfig Layout -> [(Help, ((KeyMask, KeySym), X ()))])
              -> XConfig Layout -> Map.Map (KeyMask, KeySym) (X ())
keysWithHelp ckeys xconf@(XConfig { modMask = modm }) =
    -- TODO: make help display key configurable
    Map.insert (modm .|. shiftMask, xK_slash) (displayHelp message) keys
  where
    hkeys = ckeys xconf
    keys = Map.fromList $ map snd hkeys
    message = getHelp hkeys


-- | like keysWithHelp but also show help when key pressed
-- require X.A.ShowText.handleTimerEvent to be appended to your handleEventHook
keysWithHelp' :: (XConfig Layout -> [(Help, ((KeyMask, KeySym), X ()))])
                    -> XConfig Layout -> Map.Map (KeyMask, KeySym) (X ())
keysWithHelp' ckeys xconf@(XConfig { modMask = modm }) =
    -- TODO: make help display key configurable
    Map.insert (modm .|. shiftMask, xK_slash) (displayHelp message) keys
  where
    hkeys = ckeys xconf
    keys = Map.fromList $ map (\(h, (k, x)) -> (k, flashHelp h >> x)) hkeys
    message = getHelp hkeys
    flashHelp h = when (h /= "") $ flashText defaultSTConfig 1 h


displayHelp :: String -> X ()
displayHelp message =
    runProcessWithInputAndWait "zenity" ["--title=" ++ title, "--width=640", "--height=480",
                                         "--list", "--text=" ++ title, "--column=key", "--column=help"] message 0
  where
    title = "keymap help"


getHelp :: [(Help, ((KeyMask, KeySym), X ()))] -> String
getHelp hkeys = unlines $ map (\(h, k) -> showKey k ++ "\n" ++ h) $ helps
  where
    helps = map (\(h, (k, _)) -> (h, k)) hkeys


showKey :: (KeyMask, KeySym) -> String
showKey (km, ks) = keymaskToString km ++ keysymToString ks


keymaskToString :: KeyMask -> String
keymaskToString m = s
  where
    pick n str = if n .&. complement m == 0 then str else ""
    s = concatMap (++"-") . filter (not . null) . map (uncurry pick) $
            [
              (mod1Mask,    "mod1")
            , (mod2Mask,    "mod2")
            , (mod3Mask,    "mod3")
            , (mod4Mask,    "mod4")
            , (mod5Mask,    "mod5")
            , (controlMask, "ctrl")
            , (shiftMask,   "shift")
            ]


-- | xmonad's default keys with help
defaultKeysWithHelp = keysWithHelp defaultKeys'
defaultKeysWithHelp' = keysWithHelp' defaultKeys'

defaultKeys' conf@(XConfig { modMask = modm }) =
    [ h"launch terminal"
      ((modm .|. shiftMask, xK_Return), spawn $ terminal conf)
    , h"close the focused window"
      ((modm .|. shiftMask, xK_c     ), kill)

    , h"rotate through the available layout algorithms"
      ((modm,               xK_space ), sendMessage NextLayout)
    , h"reset the layouts on the current workspace to default"
      ((modm .|. shiftMask, xK_space ), setLayout $ layoutHook conf)

    -- modifying the window order
    , h"swap the focused window and the master window"
      ((modm,               xK_Return), windows W.swapMaster)

    -- floating layer support
    , h"push window back into tiling"
      ((modm,               xK_t     ), withFocused $ windows . W.sink)

    -- quit, or restart
    , h"quit xmonad"
      ((modm .|. shiftMask, xK_q     ), io (exitWith ExitSuccess))
    , h"restart xmonad"
      ((modm              , xK_q     ), spawn "if type xmonad; then xmonad --recompile && xmonad --restart; else xmessage xmonad not in \\$PATH: \"$PATH\"; fi")
    ]
    ++
    -- mod-[1..9] %! Switch to workspace N
    -- mod-shift-[1..9] %! Move client to workspace N
    [h("move to workspace" ++ i) ((m .|. modm, k), windows $ f i)
        | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]
        , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
    ++
    -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3
    -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3
    [h("switch to screen" ++ show sc) ((m .|. modm, key), screenWorkspace sc >>= flip whenJust (windows . f))
        | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
        , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]