You are not logged in.

#1 2008-09-17 21:00:34

X/ax
Member
From: Oost vlaanderen, Belgium
Registered: 2008-01-13
Posts: 275
Website

The great xmonad.hs thread

For several reasons, I wanted to start the great xmonad.hs thread.
Idea is simple: just post the xmonad.hs file you're using, and/or discuss yours/someone else's.

To start off, this is my (small) xmonad.hs file:

[cpf@galactica .xmonad]% cat xmonad.hs

-- module Main where

import XMonad
import XMonad.Config.Xfce
-- import XMonad.Config.Gnome
import qualified Data.Map as M

main = xmonad $ xfceConfig 
    {
        terminal = "urxvt",
        modMask = mod4Mask,
        keys = \c -> myKeys c `M.union` keys xfceConfig c
    }

myKeys (XConfig {modMask = modm}) = M.fromList $
    [ ((modm, xK_p), spawn "hayaku"),
      ((modm .|. shiftMask, xK_p), spawn "xfrun4"),
      ((modm .|. shiftMask, xK_q), spawn "xfce4-session-logout")

My coding blog (or an attempt at it)
Archer start page (or an attempt at it)

Offline

#2 2008-09-17 21:55:54

Vintendo
Member
From: Netherlands
Registered: 2008-04-21
Posts: 375
Website

Re: The great xmonad.hs thread

Nice idea, xmonad has a nice config style.

mine:

import XMonad
import System.Exit
import XMonad.Hooks.SetWMName

--dzen nessesesity's
import IO
import XMonad.Hooks.DynamicLog
import XMonad.Util.Run
import XMonad.Util.Dzen
import XMonad.Hooks.ManageDocks

--For the Keybindings
import XMonad.Actions.CycleWS
import XMonad.Util.EZConfig
import XMonad.Actions.SinkAll

--Layouts
import XMonad.Layout.Grid

--Java issues
import XMonad.Hooks.SetWMName

import qualified XMonad.StackSet as W
import qualified Data.Map        as M

modm = mod1Mask
    
main :: IO ()
main = do 
    h <- spawnPipe "dzen2 -fn '-*-terminus-*-*-*-*-12-*-*-*-*-*-*-*' -bg black -fg grey -h 14 -w 300 -ta l "
    xmonad $ defaultConfig
     {
         -- simple stuff
        terminal           = "urxvt"
        ,focusFollowsMouse  = True
        ,borderWidth        = 1
        ,modMask            = mod1Mask
        ,workspaces         = ["opera","ftd","three","four","five","six"]
        ,normalBorderColor  = "#555b2f"
        ,focusedBorderColor = "#b22222"
      --    ,defaultGaps        = [(14,0,0,0)]
         
        -- hooks, layouts
        ,layoutHook         = avoidStruts $ tiled ||| Grid ||| Mirror tiled ||| Full
        ,manageHook            = composeAll     [ className =? "Opera" --> doF(W.shift "opera")
                                            , className =? "Openftd_gui" --> doF(W.shift "ftd") ]
                              <+> manageDocks
        ,logHook             = dynamicLogWithPP defaultPP
                             { ppCurrent          = dzenColor "red" "" . wrap "[" "]" 
                             , ppVisible           = wrap "[" "]"
                            , ppHidden              = dzenColor "grey" "" 
                             , ppHiddenNoWindows    = dzenColor "grey"  ""
                             , ppSep                = " ^fg(grey)^r(2x17) " 
                            , ppUrgent            = dzenColor "red" "" . wrap "^" ""
                             , ppLayout            = dzenColor "grey" "" 
                            , ppTitle            = const ""     
                            , ppOutput           = hPutStrLn h                             }
        ,startupHook        = setWMName "LG3D"
                 
        }
        
        `additionalKeys`
        [
        -- Move focus in workspace
          ((modm,                                xK_Right ),     windows W.focusDown)                 
         ,((modm,                                xK_Left ),         windows W.focusUp  )
        -- Moce windows in workspace
        ,((modm .|. shiftMask,                     xK_Right ),     windows W.swapDown  )
        ,((modm .|. shiftMask,                     xK_Left ),         windows W.swapUp    )
        -- Move screenfocus    
          ,((controlMask,                            xK_Right),         nextScreen)    
        ,((controlMask,                            xK_Left ),         prevScreen)
          -- Move windows across screens    
        ,((controlMask .|. shiftMask,             xK_Right),         shiftNextScreen)
        ,((controlMask .|. shiftMask,             xK_Left),          shiftPrevScreen)
        -- Switch workspace
        ,((controlMask .|. modm,                 xK_Right),         nextWS)
        ,((controlMask .|. modm,                 xK_Left),          prevWS)
        -- Move windows across workspaces
        ,((controlMask .|. modm .|. shiftMask,     xK_Right),         shiftToNext)
        ,((controlMask .|. modm .|. shiftMask,     xK_Left),          shiftToPrev)
        -- Sink all windows into tiling
        ,((modm,                                xK_t),             sinkAll)
        -- Java hack
        ,((modm,                                xK_F12),        setWMName "LG3D")
        --Hide dzen
        ,((modm,                                 xK_b),             sendMessage ToggleStruts)
        --Commands
        ,((modm,                                  xK_a),            spawn "urxvt")

        ]

        where
            tiled = Tall 1 (3/100) (1/2)

Offline

Board footer

Powered by FluxBB