[xmonad] 0.8 to 0.9.2 problems with xmonad.hs - a real mess - debug help needed please - system is freezing after a while

wagnerdm at seas.upenn.edu wagnerdm at seas.upenn.edu
Tue Dec 1 16:46:09 EST 2009


Crashes are usually a result of library mismatch.  The standard thing  
to try here is to:

1. clean and rebuild the Haskell X11 library
2. clean and rebuild xmonad
3. clean and rebuild xmonad-contrib
4. clean and rebuild your config by calling "xmonad --recompile"

(in that order).  If all of these succeed and the crashes persist, we  
definitely want to know.
~d

Quoting yvonne barrymore <yvonneyb at gmail.com>:

> Hi, getting a lot of system freeze. I haven't changed what I believe
> needs to be altered as I'm almost certain to get it wrong.
> I also am attempting to get dzen2 working (script showing top right) I
> work with these 2 .xmonad.hs files. They both have many issues for me.
> sorry about asking, I hope this post is not too long. I have tried for
> 2 weeks.
>
> I do not use many of the features in the xmonad.hs files. They are
> from examples I found. I also cannot get the dzen.sh script to show up
> lately.
> I know i will keep trying until I understand! :=)
>
> I would be happy just to know what is causing my system freeze. So
> maybe I can get help to update to 0.9.2 ??
> I unfortunately need the actual code changes as I have not the skill
> to read man pages and then do myself. I have read the 0.9 changelog
> and tried.
> defaultGaps, Scratchpad, yes, many problems running in 0.9.2 I believe.
>
>
> === .xinitrc ===
>
> #!/bin/sh
>
> # ~/.xinitrc
>
> urxvtd -q -o -f &
> xmodmap ~/.Xmodmap &
> autocutsel &
>
> eval `cat ~/.fehbg` &
>
> xsetroot -cursor_name left_ptr -solid '#090909' &
>
> stalonetray -i 16 --max-width 48 --icon-gravity E --geometry 48x16-0+0
> -bg '#2e3436' --sticky --skip-taskbar & ~/bin/dzen.sh | dzen2 -e
> 'onstart=lower' -p -ta r -fn
> '-*-terminus-medium-*-*-*-12-*-*-*-*-*-iso8859-1' -bg '#2e3436' -fg
> '#babdb6' -h 16 -w 1632 &
>
> exec xmonad
>
> ===
>
> === xmonad.hs NUMBER 1 ===
>
> import XMonad hiding ((|||))
> import XMonad.ManageHook
> import qualified XMonad.StackSet as W
> import XMonad.Actions.CycleWS
> import XMonad.Actions.Promote
> import XMonad.Hooks.DynamicLog
> import XMonad.Hooks.ManageDocks
> import XMonad.Hooks.UrgencyHook
> import XMonad.Layout.DwmStyle
> import XMonad.Layout.IM
> import XMonad.Layout.LayoutCombinators
> import XMonad.Layout.Named
> import XMonad.Layout.NoBorders
> import XMonad.Layout.PerWorkspace
> import XMonad.Layout.Reflect
> import XMonad.Layout.ResizableTile
> import XMonad.Layout.Tabbed
> import XMonad.Util.EZConfig
> import XMonad.Util.Run
> import XMonad.Util.Scratchpad
>
> import Data.Ratio ((%))
>
> statusBarCmd= "dzen2 -e '' -w 720 -ta l -fn
> '-*-terminus-*-*-*-*-12-*-*-*-*-*-*-*' -bg black -fg #d3d7cf "
>
> main = do
>        din <- spawnPipe statusBarCmd
>        xmonad $ withUrgencyHook dzenUrgencyHook { args = ["-fn",
> "-*-terminus-*-*-*-*-12-*-*-*-*-*-*-*","-bg", "yellow", "-fg",
> "black"] } $ defaultConfig
>                      { borderWidth        = 2
>                      , workspaces         =
> ["1:main","2:im","3:web","4:mail"] ++ map show [5..9]
>                      , terminal           = "urxvt -e tmux -2 new-session"
>                      , modMask            = mod4Mask
>                      , manageHook         = myManageHook <+>
> manageHook defaultConfig <+> manageDocks <+>
> scratchpadManageHookDefault
>                      , logHook            = dynamicLogWithPP $ myPP din
>                      , layoutHook         = myLayouts
>                      }
>                      `additionalKeysP` myKeys din
>
> myManageHook  = composeAll [ className =? "Pidgin"         --> doF
> (W.shift "2:im")
>                            , className =? "Firefox"        --> doF
> (W.shift "3:web")
>                            , className =? "Gran Paradiso"  --> doF
> (W.shift "3:web")
>                            , title     =? "mutt"           --> doF
> (W.shift "4:mail")
>                            ]
>
> myKeys conf = [ ("M-<Return>", spawn "urxvt")
>               , ("M-p",        spawn "dmenu_run")
>               , ("M-c",        kill)
>               -- run programs
>               , ("M-f",        spawn "firefox")
>               , ("M-e",        spawn "pcmanfm")
>               , ("M-s",        scratchpadSpawnActionTerminal "urxvt")
>               -- resize tile
>               , ("M-a",        sendMessage MirrorShrink)
>               , ("M-z",        sendMessage MirrorExpand)
>               -- moving workspaces
>               , ("M-<Left>",    prevWS)
>               , ("M-<Right>",   nextWS)
>               , ("M-S-<Left>",  shiftToPrev)
>               , ("M-S-<Right>", shiftToNext)
>               , ("M-<Tab>",     toggleWS)
>
>               , ("M-S-<Return>", promote)
>
>               , ("M-u", focusUrgent)
>               ]
>
> myPP h = defaultPP
>                  {  ppCurrent = wrap "^fg(#000000)^bg(#a6c292) " "  
> ^fg()^bg()"
>                   , ppHidden  = wrap "^i(~/icons/dzen/has_win_nv.xbm)" " "
>                   , ppHiddenNoWindows  = wrap " " " "
>                   , ppSep     = " ^fg(grey60)^r(3x3)^fg() "
>                   , ppWsSep   = ""
>                   , ppLayout  = dzenColor "#80AA83" "" .
>                                 (\x -> case x of
>                                          "Tall"  ->  
> "^i(~/icons/dzen/tall.xbm)"
>                                          "Mirror" ->
> "^i(~/icons/dzen/mtall.xbm)"
>                                          "Tabs" -> "Tabs"
>                                          "IM"  -> "IM"
>                                 )
>                   , ppTitle   = dzenColor "white" "" . wrap "< " " >"
>                   , ppOutput  = hPutStrLn h
>                   }
>
> myTheme = defaultTheme { decoHeight = 16
>                         , activeColor = "#a6c292"
>                         , activeBorderColor = "#a6c292"
>                         , activeTextColor = "#000000"
>                         , inactiveBorderColor = "#000000"
>                         }
>
> myLayouts = avoidStruts $ smartBorders $
>   onWorkspace "2:im" (named "IM" (reflectHoriz $ withIM (1%8) (Title
> "Buddy List") (reflectHoriz $ dwmStyle shrinkText myTheme tiled |||
> (smartBorders $ tabs)))) $
>   onWorkspace "3:web" (tabs) $
>   (tiled ||| named "Mirror" (Mirror tiled) ||| tabs)
>     where
>       tiled = named "Tall" (ResizableTall 1 (3/100) (1/2) [])
>       tabs = named "Tabs" (tabbed shrinkText myTheme)
>
>
>
>
>
> ====================
> === xmonad.hs NUMBER 2 ===
>
> -- vim :fdm=marker sw=4 sts=4 ts=4 et ai:
>
> -- Imports {{{
> import XMonad
> import XMonad.Layout
> import XMonad.Layout.NoBorders (noBorders)
> import XMonad.Layout.PerWorkspace
> import XMonad.Layout.LayoutHints
> import XMonad.Layout.ThreeColumns
> import XMonad.Hooks.DynamicLog   (PP(..), dynamicLogWithPP, wrap, defaultPP)
> import XMonad.Hooks.UrgencyHook
> import XMonad.Util.Run (spawnPipe)
> import qualified XMonad.StackSet as W
> import qualified Data.Map as M
>
> import System.IO (hPutStrLn)
> -- }}}
>
> -- Control Center {{{
> -- Colour scheme {{{
> myNormalBGColor     = "#2e3436"
> myFocusedBGColor    = "#414141"
> myNormalFGColor     = "#babdb6"
> myFocusedFGColor    = "#73d216"
> myUrgentFGColor     = "#f57900"
> myUrgentBGColor     = myNormalBGColor
> mySeperatorColor    = "#2e3436"
> -- }}}
>
> myBitmapsDir        = "~/icons/dzen"
> myFont              = "-*-terminus-medium-*-*-*-12-*-*-*-*-*-iso8859-1"
> -- }}}
>
> -- Workspaces {{{
> myWorkspaces :: [WorkspaceId]
> myWorkspaces = ["general", "internet", "chat", "code"] ++ map show  
> [5..9 :: Int]
> -- }}}
>
> -- Keybindings {{{
> myKeys conf@(XConfig {modMask = modm}) = M.fromList $
>     [
>         ((modm , xK_p), spawn ("exec `dmenu_path | dmenu -fn '" ++
> myFont ++ "' -nb '" ++ myNormalBGColor ++ "' -nf '" ++ myNormalFGColor
> ++ "' -sb '" ++ myFocusedBGColor ++ "' -sf '" ++ myFocusedFGColor ++
> "'`")),
>         ((modm , xK_g), spawn ("exec gajim-remote toggle_roster_appearance"))
>     ]
>     ++
>     -- Remap switching workspaces to M-[asdfzxcv]
>     [((m .|. modm, k), windows $ f i)
>         | (i, k) <- zip (XMonad.workspaces conf) [xK_a, xK_s, xK_d,  
> xK_f, xK_v]
>         , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
> -- }}}
>
> statusBarCmd= "dzen2 -p -h 16 -ta l -bg '" ++ myNormalBGColor ++ "'
> -fg '" ++ myNormalFGColor ++ "' -w 768 -sa c -fn '" ++ myFont ++ "'"
>
>
> defaultGaps = [(18,0,0,0)]
> --
> -- Fields are: top, bottom, left, right.
> --
> myDefaultGaps   = [(0,20,0,0),(0,20,0,0)]
>
>
> -- Main {{{
> main = do
>     statusBarPipe <- spawnPipe statusBarCmd
>     xmonad $ withUrgencyHook NoUrgencyHook $defaultConfig {
>         modMask = mod4Mask,
>         borderWidth = 3,
>         terminal = "urxvt",
>         normalBorderColor = myNormalBGColor,
>         focusedBorderColor = myFocusedFGColor,
>      --   defaultGaps = [(16,0,0,0)],
>         manageHook = manageHook defaultConfig <+> myManageHook,
>         layoutHook = onWorkspace "chat" chatLayout globalLayout,
>         workspaces = myWorkspaces,
>         logHook = dynamicLogWithPP $ myPP statusBarPipe,
>         keys = \c -> myKeys c `M.union` keys defaultConfig c
>     }
>     where
>         globalLayout = layoutHints (tiled) ||| layoutHints (noBorders
> Full) ||| layoutHints (Mirror tiled) ||| layoutHints (Tall 1 (3/100)
> (1/2))
>         chatLayout = layoutHints (noBorders Full)
>         tiled = ThreeCol 1 (3/100) (1/2)
> -- }}}
>
> -- Window rules (floating, tagging, etc) {{{
> myManageHook = composeAll [
>         className   =? "Firefox-bin"        --> doF(W.shift "internet"),
>         className   =? "Gajim.py"           --> doF(W.shift "chat"),
>
>         title       =? "Gajim"              --> doFloat,
>         className   =? "stalonetray"        --> doIgnore,
>         className   =? "trayer"             --> doIgnore
>     ]
> -- }}}
>
> -- Dzen Pretty Printer {{{
> myPP handle = defaultPP {
>         ppCurrent = wrap ("^fg(" ++ myFocusedFGColor ++ ")^bg(" ++
> myFocusedBGColor ++ ")^p(4)") "^p(4)^fg()^bg()",
>         ppUrgent = wrap ("^fg(" ++ myUrgentFGColor ++ ")^bg(" ++
> myUrgentBGColor ++ ")^p(4)") "^p(4)^fg()^bg()",
>         ppVisible = wrap ("^fg(" ++ myNormalFGColor ++ ")^bg(" ++
> myNormalBGColor ++ ")^p(4)") "^p(4)^fg()^bg()",
>         ppSep     = "^fg(" ++ mySeperatorColor ++ ")^r(3x3)^fg()",
>         ppLayout  = (\x -> case x of
>                     "Tall"          -> " ^i(" ++ myBitmapsDir ++  
> "/tall.xbm) "
>                     "Mirror Tall"   -> " ^i(" ++ myBitmapsDir ++  
> "/mtall.xbm) "
>                     "Full"          -> " ^i(" ++ myBitmapsDir ++  
> "/full.xbm) "
>                     "ThreeCol"      -> " ^i(" ++ myBitmapsDir ++
> "/threecol.xbm) "
>                     "Hinted Tall"          -> " ^i(" ++ myBitmapsDir
> ++ "/tall.xbm) "
>                     "Hinted Mirror Tall"   -> " ^i(" ++ myBitmapsDir
> ++ "/mtall.xbm) "
>                     "Hinted Full"          -> " ^i(" ++ myBitmapsDir
> ++ "/full.xbm) "
>                     "Hinted ThreeCol"      -> " ^i(" ++ myBitmapsDir
> ++ "/threecol.xbm) "
>                     _               -> " " ++ x ++ " "
>                 ),
>         ppTitle   = wrap ("^fg(" ++ myFocusedFGColor ++ ")") "^fg()" ,
>         ppOutput  = hPutStrLn handle
> }
> -- }}}
>
> ===
> _______________________________________________
> xmonad mailing list
> xmonad at haskell.org
> http://www.haskell.org/mailman/listinfo/xmonad
>
>




More information about the xmonad mailing list