This is an XConfig modifier designed to be used with external display
program like dzen2 or osd_cat. You give it a String -> X(), it modifies
bindings so when you use one, whatever your function does with the
string representing that key or mouse binding is sequenced with the
normal action. There's a custom format version too. It doesn't work with
submapped keys, i.e. sequences like "M-x f".
Amazing how something with the potential to screw up every single action
in XMonad never once broke my xmonad. Yay for xmonad's design, monads,
and functional programming!
regards,
Wirt
Sat Nov 1 22:51:09 MDT 2008 Wirt Wolff
* Actions.DisplayUI, for displaying bindings onscreen during screencasts
New patches:
[Actions.DisplayUI, for displaying bindings onscreen during screencasts
Wirt Wolff **20081102045109] {
addfile ./XMonad/Actions/DisplayUI.hs
hunk ./XMonad/Actions/DisplayUI.hs 1
+--------------------------------------------------------------------
+-- |
+-- Module : XMonad.Actions.DisplayUI
+-- Copyright : Wirt Wolff
+-- License : BSD3-style (see LICENSE)
+--
+-- Maintainer : Wirt Wolff
+--
+-- Functions for displaying key and mouse bindings on screen while
+-- making screencasts, along with related helper functions. DisplayUI
+-- does not provide a way to display or parse the related X() actions
+-- from files. It also does not display submapped keys, i.e. a sequence
+-- like \"M1-x f\" will only display \"M1-x\". It was designed to be used with
+-- an external on screen display program like osd_cat or dzen2, but can
+-- be used for any String -> X().
+--
+-- (See also "XMonad.Util.EZConfig", "XMonad.Actions.Submap" in xmonad-contrib.)
+--
+--------------------------------------------------------------------
+
+module XMonad.Actions.DisplayUI (
+ -- * Usage
+ -- $usage
+
+ displayUI,
+
+ -- * Using a custom UI display format
+ -- $formats
+ displayUIWith,
+ UIFormat (..),
+ defaultUIFormat, altUIFormat, longUIFormat, hsUIFormat,
+
+ -- * Troubleshooting
+ -- $troubleshooting
+
+ -- * toString utilities
+ -- $tostring
+ keyToString, mouseToString,
+ modifierToString,
+ keyToStringWith, mouseToStringWith,
+ modifierToStringWith
+
+ ) where
+
+
+import XMonad
+
+import Data.Bits ((.&.))
+import Graphics.X11.Xlib (keysymToString)
+import Data.List (zip, filter, intercalate)
+import qualified Data.Map as M (mapWithKey)
+
+
+-- $usage
+-- To use this module, first add it to the imports in your @~\/.xmonad\/xmonad.hs@:
+-- Import "XMonad.Util.Run", too, if you haven't already, to spawn shell programs.
+--
+-- > import XMonad
+-- > -- other imports ...
+-- > import XMonad.Actions.DisplayUI
+-- > import XMonad.Util.Run
+--
+-- Choose an on screen display program, such as dzen2, or osd_cat (part of the
+-- xosd library.) You probably want something which accepts text on its stdin.
+-- osd_cat gives a transparent background effect like television OSD's. dzen2 has
+-- an opaque background of whatever color you choose. Define a function from type
+-- String to X() with parameters appropriate for your configuration. Anything you
+-- could bind a key to will work for the value of your function.
+--
+-- For example:
+-- If running the command @echo \"Some message\" | osd_cat -o 100 -i 500 -c '#4f2'@
+-- @ -d 1 -f '-*-terminus-bold-r-*-*-32-*-*-*-*-*-*-*'@ in a shell gives the effect
+-- you are after, add the following @osd_cat = ...@ definition outside your existing
+-- xmonad configuration. Also include a type signature, e.g. @osd_cat :: String -> X()@.
+--
+-- > main = xmonad $ defaultConfig { terminal = "urxvt" }
+-- > `additionalKeys`
+-- > [ ((mod1Mask, xK_F12), spawn "xscreensaver-command -lock")
+-- > , ((mod1Mask .|. controlMask, xK_Return), spawn "specialTerminal")
+-- > ]
+-- >
+-- > osd_cat :: String -> X()
+-- > osd_cat = \ui -> spawn $ "echo '" ++ ui ++ "' | osd_cat --offset 100 \
+-- > \ --indent 500 --color '#4f2' --delay 1 \
+-- > \ --font '-*-terminus-bold-r-*-*-32-*-*-*-*-*-*-*'"
+--
+-- Using dzen2 it would be something like this:
+--
+-- > osdDzen :: String -> X()
+-- > osdDzen = \ui -> spawn $ "echo '" ++ ui ++ "' | dzen2 -x 500 -y 100 -w 600 \
+-- > \ -ta c -fg '#4f2' -p 1 -h 48 \
+-- > \ -fn '-*-terminus-bold-r-*-*-32-*-*-*-*-*-*-*'"
+--
+-- (Note the \' \' quotes around the ui string, colors, and fonts.) To
+-- see what core fonts and sizes are available, run @xfontsel@. dzen2
+-- and osd_cat do not currently support fontconfig/xft.
+--
+-- Now add a 'displayUI' or 'displayUIWith' line to modify your XMonad config
+-- to run the X() action you set up and have XMonad display user interface
+-- bindings as you use them.
+--
+-- > main = xmonad $
+-- > displayUI osdDzen $
+-- > defaultConfig { terminal = "urxvt" }
+-- > `additionalKeys`
+-- > [ ((mod1Mask, xK_F12), spawn "xscreensaver-command -lock")
+-- > , ((mod1Mask .|. controlMask, xK_Return), spawn "specialTerminal")
+-- > ]
+--
+-- You don't have to put @displayUI osdDzen $@ on a separate line, but
+-- it's easier to comment out since you're probably only using this module
+-- for making screencasts. Now if all's in place, simply save the file,
+-- @mod-q@ and you should have bindings being displayed when you use them.
+--
+-- The default 'displayUI' format is very close to the one in "XMonad.Util.EZConfig"\'s
+-- @additionalKeysP@ and @additionalMouseBindings@ functions, but without the
+-- angle brackets, e.g. \"M3-C-S-F9\", \"M4-button3\". DisplayUI always uses "Graphics.X11"
+-- @keysymToString@ to choose what string will be displayed for keys. These are
+-- as in the keysymdef.h file (usually in \/usr\/include\/X11\/) less the xK_ part.
+
+-- $formats
+-- 'displayUIWith' takes an additional argument: a 'UIFormat' record describing
+-- how to format the user interface binding strings. In addition to the default,
+-- some ready made ones are provided: 'longUIFormat' (\"Mod4-Shift-space\",
+-- \"Mod4-MouseButton3\", etc.) 'altUIFormat' (\"alt-win-F9\"), and for fun, 'hsUIFormat'
+-- that builds strings like \"shiftMask .|. mod1Mask, xK_F4\". For example:
+--
+-- > main = xmonad $
+-- > displayUIWith altUIFormat osd_cat $
+-- > defaultConfig { terminal = "urxvt" }
+--
+
+-- | UIFormat records define how to display the modifiers, keys, buttons, and bindings
+-- as a whole. The modifier string list, @mods@, is in bit order, least significant bit first,
+-- the same as xmodmap. (caps) lockMask is left as empty string in the predefined UIFormats.
+-- For example, here is the definition of altUIFormat:
+--
+-- > altUIFormat :: UIFormat
+-- > altUIFormat = UIFormat {
+-- > mods = ["shift", "", "ctrl", "alt", "mod2", "mod3", "win", "mod5"]
+-- > , modSep = "-" -- string to separate modifiers
+-- > , lastSep = "-" -- string to separate modifiers from key or button
+-- > , button = "mouse"
+-- > }
+--
+data UIFormat = UIFormat
+ { mods :: [String] -- string used to display each modifier (in bit order 0..)
+ , modSep :: String
+ , lastSep :: String
+ , button :: String
+ }
+
+-- | Close to "XMonad.Util.EZConfig" parser format, but no angle brackets
+defaultUIFormat :: UIFormat
+defaultUIFormat = UIFormat
+ { mods = ["S", "", "C"] ++ ['M': show n | n <- [1..5]::[Int] ]
+ , modSep = "-"
+ , lastSep = "-"
+ , button = "button"
+ }
+
+-- | Common names from ms US keys, lower case (\"ctrl\", \"alt\",\"win\", \"mouse\")
+altUIFormat :: UIFormat
+altUIFormat = defaultUIFormat
+ { mods = ["shift", "", "ctrl", "alt", "mod2", "mod3", "win", "mod5"]
+ , button = "mouse"
+ }
+
+-- | Longer capitalized format (\"Control\", \"MouseButton\")
+longUIFormat :: UIFormat
+longUIFormat = defaultUIFormat
+ { mods = ["Shift", "", "Control"] ++ ["Mod" ++ show n | n <- [1..5]::[Int] ]
+ , button = "MouseButton"
+ }
+
+-- | May as well have a default haskell format (as in xmonad.hs)
+hsUIFormat :: UIFormat
+hsUIFormat = UIFormat
+ { mods = ["shiftMask", "", "controlMask", "mod1Mask", "mod2Mask", "mod3Mask", "mod4Mask", "mod5Mask"]
+ , modSep = " .|. "
+ , lastSep = ", xK_"
+ , button = "button"
+ }
+
+-- | Modifies the xmonad key and mouse bindings so that whenever one's used,
+-- the normal action is performed along with a displayUI action that has use
+-- of the ui binding string. displayUI's first parameter is the function from
+-- a binding string to X() defining what to do.
+displayUI :: (String -> X()) -> XConfig l -> XConfig l
+displayUI sa conf = conf
+ { keys = \c -> M.mapWithKey (sequenceXk sa) (keys conf c)
+ , mouseBindings = \c -> M.mapWithKey (sequenceXm sa) (mouseBindings conf c) }
+
+-- | Combine a key binding action with a displayUI action using the default
+-- "S-M4-Return" format similar to "XMonad.Util.EZConfig" additionalKeysP
+sequenceXk :: (String -> X()) -> (Modifier, KeySym) -> X() -> X()
+sequenceXk sa k f = (sa $ keyToString k) >> f
+
+-- | Combine a mouse binding action with a displayUI action using the default
+-- "M4-button1" format.
+sequenceXm :: (String -> X()) -> (Modifier, Button) -> (Window -> X()) -> (Window -> X())
+sequenceXm sa k f = (>> ( sa $ mouseToString k)) . f
+
+-- | Like displayUI, but using a custom format from UIFormat fields.
+displayUIWith :: UIFormat -> (String -> X()) -> XConfig l -> XConfig l
+displayUIWith fmt sa conf = conf
+ { keys = \c -> M.mapWithKey (sequenceXk' fmt sa) (keys conf c)
+ , mouseBindings = \c -> M.mapWithKey (sequenceXm' fmt sa) (mouseBindings conf c) }
+
+-- | Combine a key binding action with a displayUI action using a custom format.
+sequenceXk' :: UIFormat -> (String -> X()) -> (Modifier, KeySym) -> X() -> X()
+sequenceXk' fmt sa k f = (sa $ keyToStringWith fmt k) >> f
+
+-- | Combine a mouse binding action with a displayUI action using a custom format.
+sequenceXm' :: UIFormat -> (String -> X()) -> (Modifier, Button) -> (Window -> X()) -> (Window -> X())
+sequenceXm' fmt sa k f = (>> (sa $ mouseToStringWith fmt k)) . f
+
+-- $troubleshooting
+-- @osd_cat@ refused to use anything but the default --align left during my
+-- testing, so if your display doesn't show, check that. Also, a common
+-- problem from forums is using fonts or colors without wrapping with
+-- \' \', e.g. use \'\#f00\' not \#f00 and '-*-fixed-...' not -*-fixed-...
+--
+-- Key sequences, aka "XMonad.Actions.Submap" submaps aren't displayed. Only
+-- the first key is shown. At some point that may get added, if it seems worth it.
+
+-- $tostring
+-- The 'modifierToString' and 'modifierToStringWith' functions complement
+-- keySymToString from the Graphics.X11 package. 'modifierToStringWith' will
+-- work on buttonMasks if you add the button mask strings you want to a custom
+-- UIFormat, but xmonad bindings seem to only use key masks so button masks
+-- are ignored in the default 'UIFormat's.
+
+-- String utilities using a default format
+-- | Build a default format keybinding string. e.g. \"S-M1-Space\"
+keyToString :: (Modifier, KeySym) -> String
+keyToString k = keyToStringWith defaultUIFormat k
+
+-- | Build a default format mouse binding string. e.g. \"S-M1-button3\"
+mouseToString :: (Modifier, Button) -> String
+mouseToString b = mouseToStringWith defaultUIFormat b
+
+-- | Build a default format modifier masks string. e.g. \"S-C-M4\"
+modifierToString :: Modifier -> String
+modifierToString m = modifierToStringWith defaultUIFormat m
+
+-- String utilities using a custom format
+-- | Build a keybinding string using the given format. For example:
+-- @keyToStringWith longUIFormat (controlMask, xK_h) == \"Control-h\"@
+keyToStringWith :: UIFormat -> (Modifier, KeySym) -> String
+keyToStringWith fmt (m, sym) =
+ modifierToStringWith fmt m ++ (lastSep fmt) ++ keysymToString sym
+
+-- | Build a mouse binding string using the given format.
+mouseToStringWith :: UIFormat -> (Modifier, Button) -> String
+mouseToStringWith fmt (m, b) =
+ modifierToStringWith fmt m ++ (lastSep fmt) ++ (button fmt) ++ show b
+
+-- | Build a modifier masks string using the given format.
+modifierToStringWith :: UIFormat -> Modifier -> String
+modifierToStringWith fmt mask = intercalate (modSep fmt) $
+ map snd . filter (sharesMask mask) $ zip maskList $ mods fmt
+ where sharesMask m (m',_) = 0 /= m .&. m'
+
+-- | List of modifier masks in bit order, least signifigant bit first
+maskList :: [Modifier]
+maskList = [shiftMask,lockMask,controlMask,mod1Mask,mod2Mask,mod3Mask,mod4Mask,mod5Mask]
+ ++ [button1Mask,button2Mask,button3Mask,button4Mask,button5Mask]
hunk ./xmonad-contrib.cabal 77
+ XMonad.Actions.DisplayUI
}
Context:
[Prompt.hs rename deleteConsecutiveDuplicates
gwern0@gmail.com**20081008205131
That name is really unwieldy and long.
]
[Prompt.hs: have historyCompletion filter dupes
gwern0@gmail.com**20081008204710
Specifically, it calls deleteConsecutiveDuplicates on the end product. uniqSort reverses order in an unfortunate way, so we don't use that.
The use-case is when a user has added the same input many times - as it stands, if the history records 30 'top's or whatever, the completion will show 30 'top' entries! This fixes that.
]
[Prompt.hs: tweak haddocks
gwern0@gmail.com**20081008204649]
[Prompt.hs: mv uniqSort to next to its confreres, and mention the trade-off
gwern0@gmail.com**20081008192645]
[Do not consider XMONAD_TIMER unknown
Joachim Breitner **20081008195643]
[Kill window without focusing it first
Joachim Breitner **20081005002533
This patch requires the patch "add killWindow function" in xmonad.
Before this patch, people would experience “workspace flicker” when closing
a window via EWMH that is not on the current workspace, for example when
quitting pidgin via the panel icon.
]
[let MagnifyLess actually magnify less
daniel@wagner-home.com**20081015153911]
[Actions.Search: add a few search engines
intrigeri@boum.org**20081008104033
Add Debian {package, bug, tracking system} search engines, as well as Google
Images and isohunt.
]
[Implement HiddenNonEmptyWS with HiddenWS and NonEmptyWS
Joachim Breitner **20081006211027
(Just to reduce code duplication)
]
[Add straightforward HiddenWS to WSType
Joachim Breitner **20081006210548
With NonEmptyWS and HiddenNonEmptyWS present, HiddenWS is obviously missing.
]
[Merge emptyLayoutMod into redoLayout
Joachim Breitner **20081005190220
This removes the emptyLayoutMod method from the LayoutModifier class, and
change the Stack parameter to redoLayout to a Maybe Stack one. It also changes
all affected code. This should should be a refactoring without any change in
program behaviour.
]
[SmartBorders even for empty layouts
Joachim Breitner **20081005184426
Fixes: http://code.google.com/p/xmonad/issues/detail?id=223
]
[Paste.hs: improve haddocks
gwern0@gmail.com**20080927150158]
[Paste.hs: fix haddock
gwern0@gmail.com**20080927145238]
[minor explanatory comment
daniel@wagner-home.com**20081003015919]
[XMonad.Layout.HintedGrid: add GridRatio (--no-test because of haddock breakage)
Lukas Mai **20080930141715]
[XMonad.Util.Font: UTF8 -> USE_UTF8
Lukas Mai **20080930140056]
[Paste.hs: implement noModMask suggestion
gwern0@gmail.com**20080926232056]
[fix a divide by zero error in Grid
daniel@wagner-home.com**20080926204148]
[-DUTF8 flag with -DUSE_UTF8
gwern0@gmail.com**20080921154014]
[XSelection.hs: use CPP to compile against utf8-string
gwern0@gmail.com**20080920151615]
[add XMonad.Config.Azerty
Devin Mullins **20080924044946]
[flip GridRatio to match convention (x/y)
Devin Mullins **20080922033354]
[let Grid have a configurable aspect ratio goal
daniel@wagner-home.com**20080922010950]
[Paste.hs: +warning about ASCII limitations
gwern0@gmail.com**20080921155038]
[Paste.hs: shorten comment lines to under 80 columns per sjanssen
gwern0@gmail.com**20080921154950]
[Forgot to enable historyFilter :(
Spencer Janssen **20080921094254]
[Prompt: add configurable history filters
Spencer Janssen **20080921093453]
[Update my config to use 'statusBar'
Spencer Janssen **20080921063513]
[Rename pasteKey functions to sendKey
Spencer Janssen **20080921062016]
[DynamicLog: doc fixes
Spencer Janssen **20080921061314]
[Move XMonad.Util.XPaste to XMonad.Util.Paste
Spencer Janssen **20080921060947]
[Depend on X11 >= 1.4.3
Spencer Janssen **20080921055456]
[statusBar now supplies the action to toggle struts
Spencer Janssen **20080918013858]
[cleanup - use currentTag
Devin Mullins **20080921011159]
[XPaste.hs: improve author info
gwern0@gmail.com**20080920152342]
[+XMonad.Util.XPaste: a module for pasting strings to windows
gwern0@gmail.com**20080920152106]
[UrgencyHook bug fix: cleanupUrgents should clean up reminders, too
Devin Mullins **20080920062117]
[Sketch of XMonad.Config.Monad
Spencer Janssen **20080917081838]
[raiseMaster
seanmce33@gmail.com**20080912184830]
[Add missing space between dzen command and flags
Daniel Neri **20080915131009]
[Big DynamicLog refactor. Added statusBar, improved compositionality for dzen and xmobar
Spencer Janssen **20080913205931
Compatibility notes:
- dzen type change
- xmobar type change
- dynamicLogDzen removed
- dynamicLogXmobar removed
]
[Take maintainership of XMonad.Prompt
Spencer Janssen **20080911230442]
[Overhaul Prompt to use a zipper for history navigation. Fixes issue #216
Spencer Janssen **20080911225940]
[Use the new completion on tab setting
Spencer Janssen **20080911085940]
[Only start to show the completion window with more than one match
Joachim Breitner **20080908110129]
[XPrompt: Add showCompletionOnTab option
Joachim Breitner **20080908105758
This patch partially implements
http://code.google.com/p/xmonad/issues/detail?id=215
It adds a XPConfig option that, if enabled, hides the completion window
until the user presses Tab once. Default behaviour is preserved.
TODO: If Tab causes a unique completion, continue to hide the completion
window.
]
[XMonad.Actions.Plane.planeKeys: function to make easier to configure
Marco Túlio Gontijo e Silva **20080714153601]
[XMonad.Actions.Plane: removed unneeded hiding
Marco Túlio Gontijo e Silva **20080714152631]
[Improvements in documentation
Marco Túlio Gontijo e Silva **20080709002425]
[Fix haddock typos in XMonad.Config.{Desktop,Gnome,Kde}
Spencer Janssen **20080911040808]
[add clearUrgents for your keys
Devin Mullins **20080909055425]
[add reminder functionality to UrgencyHook
Devin Mullins **20080824200548
I'm considering rewriting remindWhen and suppressWhen as UrgencyHookModifiers, so to speak. Bleh.
]
[TAG 0.8
Spencer Janssen **20080905195420]
Patch bundle hash:
dc8f746c1319799df0ed431610cc259c77dc7a48