[xmonad] 0.8 to 0.9.2 problems with xmonad.hs - a real mess -
debug help needed please - system is freezing after a while
yvonne barrymore
yvonneyb at gmail.com
Wed Dec 2 01:19:48 EST 2009
Fresh install yesterday of up-to-date xmonad and xmonad-contrib ARCH
linux. All up to date with all necessary dependencies.
The freeze starts with not being able to change windows. M+1 M+2 etc.
And/or worse, having no ability to being up term to reboot. This is
only vaguely what happens, I'm sorry to say. I have thought that it is
my calls to script from in one of the xmonad.hs I posted. And of
course there is the line in my .xinitrc that calls stalonetray and
dzen2.
Really I would first love to know what it is about both my xmonad.hs
files I posted that are not 0.9.2 ready. If that is possible. I know
there are elements that need to be changed or removed. I am unable to
do this from reading manpages at this point.
Then, with good enough xmonad.hs files I can try things as I have many
area to experiment with though first I believe I should know the
xmonad.hs files to be good for 0.9.2. Or can you say this should not
matter?
yes, I do think there is part of the problem with me getting dzen2
running. Is the old or bad code in my two xmonad.hs files I posted
irrelevant as far as freeze crash goes?
I am very happy to have received your replies and interest. Many thanks!
P.S. when I receive a reply, and wish to reply to it, do I change the
address to <xmonad at haskell.org>, again? And then, will the system
know to add my reply to thread due to subject?
On Tue, Dec 1, 2009 at 1:55 PM, <wagnerdm at seas.upenn.edu> wrote:
> 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
>>> }
>>> -- }}}
>>>
>>> ===
>>> _______________________________________________
More information about the xmonad
mailing list