[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