Difference between revisions of "Xmonad/General xmonad.hs config tips"

From HaskellWiki
Jump to navigation Jump to search
m (remove errant linebreak)
(Added avoidStruts info from GNOME page (should be moved to general FAQ eventually))
Line 104: Line 104:
   
 
</haskell>
 
</haskell>
  +
  +
===Make space for a panel, tray or dock application===
  +
  +
[http://hackage.haskell.org/packages/archive/xmonad-contrib/0.5/doc/html/XMonad-Hooks-ManageDocks.html ManageDocks] makes it possible for Xmonad to work with panels in the way they expect, automatically leaving the appropriate amount of room for them at the edges of the screen. ''ManageDocks'' has been enabled in the example configuration above. By itself, configuration looks like this:
  +
  +
<haskell>
  +
import XMonad.Hooks.ManageDocks
  +
main = xmonad defaultConfig
  +
{ manageHook = manageDocks <+> manageHook defaultConfig
  +
, layoutHook = avoidStruts $ layoutHook defaultConfig
  +
}
  +
</haskell>
  +
  +
Prior to version 0.7, Xmonad alternatively supported a ''gaps'' option, configured like this:
  +
  +
<haskell>
  +
main = xmonad defaultConfig
  +
{ defaultGaps = [(24,24,0,0)]
  +
}
  +
</haskell>
  +
   
 
[[Category:XMonad configuration]]
 
[[Category:XMonad configuration]]

Revision as of 16:07, 2 April 2008

This site is for general tips for configuring xmonad.hs, for example "How to make window X float by default" and others. If you can't find what you're searching for, you may want to look at the Config archive.

Please add what you found useful in your xmonad.hs and course improving existing tips or adding alternatives is highly appreciated!

Making window float by default, or send it to specific workspace

This example sends Firefox to workspace "web" by default, makes Gajim float and sends it to webspace "jabber" and Xmessage is floating by default, too.

  main = xmonad $ defaultConfig
  {
  ....
  , manageHook    = manageHook defaultConfig <+> myManageHook
  ...
  }
  myManageHook :: ManageHook
  myManageHook = composeAll . concat $
      [ [ className =? c --> doFloat | c <- myFloats ]
      , [ className =? "Firefox-bin" --> doF (W.shift "web" ) ]
      , [ className =? "Gajim.py" --> doF (W.shift "jabber" ) ] ]
      where myFloats = ["Gajim.py", "Xmessage"]

Adding your own keybindings

This adds Mod-x keybinding for running xlock.

  import qualified Data.Map as M
  ....
  main = xmonad $ defaultConfig
  {
  ....
  , keys          = \c -> mykeys c `M.union` keys defaultConfig c }
  ....
  }
  where
      mykeys (XConfig {modMask = modm}) = M.fromList $
           [ ((modm , xK_x), spawn "xlock") ]

For a list of the identifiers used for various keys, see [1].

This is also described in [2]

Adding your own mouse bindings

Adding your own mouse bindings is explained in [3]

If you have a mouse with more than 5 buttons you can simply use '6' instead of 'button6' which isn't defined.

e.g. with EZConfig:

 ,((0, 6), (\w -> focus w >> windows W.swapMaster))


Sharing a configuration across different hosts

It is possible to have different parts of the configuration file vary from one host to another, without needing a different config file for each host. Here is an example from my configuration file:

   import System.Posix.Unistd
   .
   .
   .
   main = do
       host <- fmap nodeName getSystemID
       xmonad $ defaultConfig
         { terminal           = "rxvt"
         , modMask            = (if host == "janice" then
                                   mod1Mask .|. controlMask
                                 else
                                   mod4Mask)}

Binding keys to a specific layout

Sometimes people want to bind a key to a particular layout, rather than having to cycle through the available layouts:

You can do this using the JumpToLayout message from the XMonad.Layout.LayoutCombinators extension module. For example:

   import XMonad hiding ( (|||) )  -- don't use the normal ||| operator
   import XMonad.Layout.LayoutCombinators   -- use the one from LayoutCombinators instead
   import XMonad.Util.EZConfig  -- add keybindings easily

   main = xmonad myConfig

   myConfig = defaultConfig {
     ...                     
     layoutHook = tall ||| Mirror tall ||| Full
     ...                                       
   } `additionalKeysP`
     [ ("M-<F1>", sendMessage $ JumpToLayout "Tall")
     , ("M-<F2>", sendMessage $ JumpToLayout "Mirror Tall")
     , ("M-<F3>", sendMessage $ JumpToLayout "Full")       
     ]                                              
      
   tall = Tall 1 (3/100) (1/2)

Make space for a panel, tray or dock application

ManageDocks makes it possible for Xmonad to work with panels in the way they expect, automatically leaving the appropriate amount of room for them at the edges of the screen. ManageDocks has been enabled in the example configuration above. By itself, configuration looks like this:

import XMonad.Hooks.ManageDocks
main = xmonad defaultConfig
              { manageHook = manageDocks <+> manageHook defaultConfig
              , layoutHook = avoidStruts  $  layoutHook defaultConfig
              }

Prior to version 0.7, Xmonad alternatively supported a gaps option, configured like this:

main = xmonad defaultConfig
              { defaultGaps = [(24,24,0,0)]
              }