[xmonad] How to prefix workspace names with numbers?
Jacek Generowicz
jacek.generowicz at cern.ch
Tue Oct 9 13:43:46 CEST 2012
JG> Select workspace by name Automatically switches when unique starting
JG> substring is entered: this means that most workspace switches take
JG> just two keystrokes. And I don't have to remember that, say, files
JG> is 4: I just have to remember that files starts with 'f' (or, in
JG> extremis, 'fi').
HC> Hm, maybe I should get used to that instead, it sounds really
HC> nice. Can you please tell me more about how you have configured it
HC> to switch automatically and/or post the relevant parts of your
HC> xmonad.hs? I use the default keybindings, so I have to hit tab and
HC> return after entering the substring in order to switch, which is a
HC> bit too slow for my liking.
OK, I'll have a go. I won't paste my whole config file, as that could
well overwhelm you with irrelevant nonsense (and I'm embarassed about
how much of a mess some of it is :-).
Let's see, I'll paste sections of my config file, with some commentary
in between
First of all, the ad-hoc spread of keybindings was driving me insane, so
I hacked up something which allows me to define keybindings in tabular
form. This gives me a convenient overview of my current keybindings and
really helps with selecting new keybindings or coming up with a sensible
set of bindings that works for me. (For the sake of brevity I've elided
some of the action wrapper definitions from the /where/ section, leaving
mostly the ones related to window/workspace manipulation):
--------------------------------------------------------------------------------
myKeyBindingsTable conf = mkKeymap conf $ concat $ table conf
-- key M- M-S- M-C- M-S-C-
table conf =
[ k "<Return>" __ __ openTerminal __
, k "a" gotoScreen1 sendScreen1 takeScreen1 swapScreen1
, k "b" gotoWorkspace sendWorkspace takeWorkspace makeWorkspace
, k "c" conkeror emacsclient __ __
, k "d" launchWithDmenu __ __ __
, k "e" wicdNetwork __ __ __
, k "f" fullscreen mirror mirror __
, k "g" gotoMenu' bringMenu' windowMenu' xmonadCommands
, k "h" __ __ __ __
, k "i" __ __ __ __
, k "j" __ __ __ __
, k "k" focusUrgent' __ __ clearUrgents'
, k "l" expandMaster shrinkMaster incMaster decMaster
, k "m" gotoMaster __ shiftMaster' __
, k "n" nextWindow prevWindow nextWindowSwap prevWindowSwap
, k "o" __ __ __ __
, k "p" prevWindow nextWindow prevWindowSwap nextWindowSwap -- reversed version of 'n'
, k "q" restartXMonad __ __ quitXMonad
, k "r" __ __ __ __
, k "s" toggleStruts cntrlCenter __ swapScreens
, k "t" tileFloating __ __ __
, k "u" gotoScreen0 sendScreen0 takeScreen0 swapScreen0
, k "v" volumeMuteToggle volumeDown volumeUp __
, k "w" nextWorkspace prevWorkspace renameWorkspace' deleteWorkspace
, k "x" __ __ __ __
, k "y" __ __ __ __
, k "z" __ __ __ __
, k "<Backspace>" closeWindow __ __ deleteWorkspace
, k "<Space>" nextLayout prevLayout __ resetLayout
, k "-" gotoRecentWS sendRecentWS takeRecentWS __
]
where
k key m ms mc msc =
[ bind "M-" key m
, bind "M-S-" key ms
, bind "M-C-" key mc
, bind "M-S-C-" key msc
]
bind modifiers key (U comment action) = (modifiers ++ key, action)
bind modifiers key (B comment action) = (modifiers ++ key, action $ modifiers ++ key)
__ = B "Available for use"
(\key -> spawn $ "xmessage '" ++ key ++ " is not bound.'")
openTerminal = U "Open a terminal" (spawn "rxvt-unicode +sb -fg wheat -bg grey10")
closeWindow = U "Close the focused window" kill
launchWithDmenu = U "Dmenu" (spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"")
gotoMenu' = U "Switch to window chosen by name via dmenu" gotoMenu
bringMenu' = U "Bring a window chosen by name via dmenu" bringMenu
windowMenu' = U "Pop up a 'flower' of actions to perform on window" windowMenu
xmonadCommands = U "Execute an XMonad command via dmenu" (defaultCommands >>= runCommand)
gotoScreen0 = U "Go to screen 0" (onScreen 0 gotoX)
sendScreen0 = U "Send to screen 0" (onScreen 0 sendX)
takeScreen0 = U "Take to screen 0" (onScreen 0 takeX)
gotoScreen1 = U "Go to screen 1" (onScreen 1 gotoX)
sendScreen1 = U "Send to screen 1" (onScreen 1 sendX)
takeScreen1 = U "Take to screen 1" (onScreen 1 takeX)
gotoRecentWS = U "Switch to the most recently visited invisible workspace" (windows gotoRecent)
sendRecentWS = U "Send to the most recently visited invisible workspace" (windows sendRecent)
takeRecentWS = U "Take to the most recently visited invisible workspace" (windows takeRecent)
gotoWorkspace = U "Switch to named workspace with autoComplete" (selectWorkspace myXPConfig)
makeWorkspace = U "Switch to named workspace" (selectWorkspace myXPConfig { autoComplete = Nothing })
sendWorkspace = U "Send to named workspace" (withWorkspace myXPConfig sendX)
takeWorkspace = U "Take to named workspace" (withWorkspace myXPConfig takeX)
nextWorkspace = U "Go to next workspace" (nextWS)
prevWorkspace = U "Go to previous workspace" (prevWS)
renameWorkspace' = U "Rename workspace" (renameWorkspace myXPConfig)
deleteWorkspace = U "Remove workspace" (removeWorkspace)
fullscreen = U "Toggle fullscreening" (sendMessage $ Toggle NBFULL)
mirror = U "Toggle layout mirrorring" (sendMessage $ Toggle MIRROR)
expandMaster = U "Increase the size of the master area" (sendMessage Expand)
shrinkMaster = U "Increase the size of the master area" (sendMessage Shrink)
incMaster = U "Increase the nummber of windows in the master area" (sendMessage (IncMasterN 1))
decMaster = U "Decrease the nummber of windows in the master area" (sendMessage (IncMasterN (-1)))
gotoMaster = U "Move focus to the master window" (windows focusMaster)
shiftMaster' = U "Make focused master, push others down." (windows shiftMaster)
-- TODO: + Make focus stay on the originally focused window
-- + Think about the keybinding
-- + Generalize to N screens
swapScreens = U "Swap currest screen with other" (windows swapTopScreens)
swapScreen0 = U "Swap current screen with screen 0" (windows $ swapTopScreenWith 0)
swapScreen1 = U "Swap current screen with screen 1" (windows $ swapTopScreenWith 1)
--------------------------------------------------------------------------------
mkKeymap comes from XMonad.Util.EZConfig
The Bs and Us all over the place are mine:
--------------------------------------------------------------------------------
-- Two varieties of Action: B(ound) is aware of the key that was used to
-- invoke it, U(nbound) is not aware of the key.
data Action = U String ( X ()) |
B String (String -> X ())
--------------------------------------------------------------------------------
I planned to use the string in an automatically generated table of
keybindings that pops up at the behest of a keystroke, but I never got
around to doing that. (Ideas welcome.)
Homing in on the details of your question: from the bindings table you
can see that I use 'b' as my workspace selection key:
--------------------------------------------------------------------------------
, k "b" gotoWorkspace sendWorkspace takeWorkspace makeWorkspace
--------------------------------------------------------------------------------
The corresponding action wrappers are defined as
--------------------------------------------------------------------------------
gotoWorkspace = U "Switch to named workspace with autoComplete" (selectWorkspace myXPConfig)
makeWorkspace = U "Switch to named workspace" (selectWorkspace myXPConfig { autoComplete = Nothing })
sendWorkspace = U "Send to named workspace" (withWorkspace myXPConfig sendX)
takeWorkspace = U "Take to named workspace" (withWorkspace myXPConfig takeX)
--------------------------------------------------------------------------------
U is a constructor of my Action type (shown above).
selectWorkspace and withWorkspace come from XMonad.Actions.DynamicWorkspaces
myXPConfig is rather simple:
--------------------------------------------------------------------------------
myXPConfig = defaultXPConfig {
-- If only one completion remains, auto-select it after 1
-- microsecond. Increasing the delay could help to stop accidentally
-- sending keypresses to the newly focused window, but with my
-- current usage, 1 microsecond is working just fine.
autoComplete = Just 1
}
--------------------------------------------------------------------------------
defaultXPConfig comes from XMonad.Prompt
I define sendX, takeX:
--------------------------------------------------------------------------------
gotoX = windows . view
sendX = windows . shift
takeX = sendX ->> gotoX
-- Helpers for performing multiple actions on the same entity
infixl 1 ->>
(a ->> b) c = do a c
b c
--------------------------------------------------------------------------------
view and shift come from XMonad.StackSet
The whole lot is installed thus:
--------------------------------------------------------------------------------
myConfig = gnomeConfig
{ ...
, keys = myKeyBindingsTable
...
}
--------------------------------------------------------------------------------
and gnomeConfig comes from XMonad.Config.Gnome (though I suspect that
there's nothing Gnome specific left in my config at all, by now).
I think I've shown all the necessary bits for the core of your question,
if not, don't hesitate to ask.
Hope it will be of some use.
More information about the xmonad
mailing list