[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:55:17 EST 2009
Brent has pointed out that this advice may be confusing, especially if
you're getting xmonad as a binary package. So: how did you install
xmonad, and how did you update it? What does ghc-pkg list say? What
exactly do you mean by "freeze"?
~d
Quoting wagnerdm at seas.upenn.edu:
> 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
>>
>>
>
>
> _______________________________________________
> xmonad mailing list
> xmonad at haskell.org
> http://www.haskell.org/mailman/listinfo/xmonad
>
>
More information about the xmonad
mailing list