Matthieu,

I'm new to xmonad too (half a year) and also know nothing of haskell, but I think I can help you.
The easiest way I found to add my own key bindings is using EZConfig additionalKeysP, like this:

import XMonad
import XMonad.Actions.CycleWS
import XMonad.Config.Gnome
import XMonad.Util.EZConfig

main = do
    xmonad $ gnomeConfig
        { modMask = mod4Mask
        } `additionalKeysP`
        [ ("M-<L>", prevWS )
        , ("M-<R>", nextWS )
        , ("M-S-<L>", shiftToPrev)
        , ("M-S-<R>", shiftToNext)
        ]

If I understood right, this should do what you want.
The mod-[1..9] and mod-shift-[1..9] are already part of the default bidings.

Regards,
Henrique G. Abreu


On Sat, Sep 12, 2009 at 10:50, Matthieu Dubuget <matthieu.dubuget@gmail.com> wrote:
Hello,

I'm a happy user of xmonad since about 1 year.
But I don't know haskell language at all.
(I know: I should learn, but… lack of time, and
also happy OCaml programmer).

My problem:

I just installed a brand new computer. Then xmonad,
and I use it with Gnome.

My xmonad.hs is:

import XMonad
import XMonad.Config.Gnome
main = xmonad gnomeConfig
    { modMask = mod4Mask
    }


I now want to integrate some more key bindings,
but I'm not able to put together all the informations
gathered from the documentation.

Here are the binding I'd like to add:

-- import XMonad.Actions.CycleWS
-- import qualified XMonad.StackSet as S

------------------------------------------------------------------------
-- Key bindings. Add, modify or remove key bindings here.
--
-- myKeys conf =
--
--     --
--     -- mod-[1..9], Switch to workspace N
--     -- mod-shift-[1..9], Move client to workspace N
--     --
--     [((modMask, k), windows $ S.greedyView i)
--          | (i, k) <- zip (XMonad.workspaces conf) [xK_F1 .. xK_F9]
--     --     , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]
--     ]
--     ++
--     [ ((modMask,               xK_Left  ), prevWS )
--     , ((modMask,               xK_Right ), nextWS )
--     , ((modMask .|. shiftMask, xK_Left  ), shiftToPrev )
--     , ((modMask .|. shiftMask, xK_Right ), shiftToNext )]


First problem: the last 2 lines have a problem.

   Couldn't match expected type `XConfig l -> KeyMask'
          against inferred type `KeyMask'
   In the second argument of `(.|.)', namely `shiftMask'
   In the expression: modMask .|. shiftMask
   In the expression: (modMask .|. shiftMask, xK_Left)


Second problem: how to integrate myKeys with Config.Gnome bindings ?

Thanks in advance

Matt
_______________________________________________
xmonad mailing list
xmonad@haskell.org
http://www.haskell.org/mailman/listinfo/xmonad