New patches: [keep focus stack. David Roundy **20070510131637] < > { hunk ./StackSet.hs 45 , screen2ws:: !(M.Map j i) -- ^ screen -> workspace , ws2screen:: !(M.Map i j) -- ^ workspace -> screen map , stacks :: !(M.Map i ([a], [a])) -- ^ screen -> (floating, normal) - , focus :: !(M.Map i a) -- ^ the window focused in each stack + , focus :: !(M.Map i [a]) -- ^ the stack of window focus in each stack , cache :: !(M.Map a i) -- ^ a cache of windows back to their stacks } deriving (Eq, Show, Read) hunk ./StackSet.hs 100 -- | /O(log s)/. Extract the element on the top of the given stack. If no such -- element exists, Nothing is returned. peekStack :: Integral i => i -> StackSet i j a -> Maybe a -peekStack i w = M.lookup i (focus w) +peekStack i w = M.lookup i (focus w) >>= maybeHead + +maybeHead :: [a] -> Maybe a +maybeHead (x:_) = Just x +maybeHead [] = Nothing + +-- | /O(log s)/. Set the focus for the given stack to the given element. +pushFocus :: (Eq a, Integral i) => i -> a -> StackSet i j a -> StackSet i j a +pushFocus i a w = w { focus = M.insert i ((a:) $ L.delete a $ M.findWithDefault [] i $ focus w) (focus w) } hunk ./StackSet.hs 110 +popFocus :: (Eq a, Integral i) => i -> a -> StackSet i j a -> StackSet i j a +popFocus i a w = w { focus = M.update upd i (focus w) } + where upd xs = case L.delete a xs of [] -> Nothing; xs' -> Just xs' + -- | /O(log s)/. Index. Extract the stack at workspace 'n'. -- If the index is invalid, returns Nothing. index :: Integral i => i -> StackSet i j a -> Maybe [a] hunk ./StackSet.hs 158 -- rotate :: (Integral i, Eq a) => Ordering -> StackSet i j a -> StackSet i j a rotate o w = maybe w id $ do - f <- M.lookup (current w) (focus w) + f <- peekStack (current w) w s <- fmap (uncurry (++)) $ M.lookup (current w) (stacks w) ea <- case o of EQ -> Nothing _ -> elemAfter f (if o == GT then s else reverse s) hunk ./StackSet.hs 162 - return $ w { focus = M.insert (current w) ea (focus w) } + return $ pushFocus (current w) ea w -- | /O(log n)/. shift. move the client on top of the current stack to -- the top of stack 'n'. If the stack to move to is not valid, and hunk ./StackSet.hs 177 -- If the index is wrong an exception is thrown. -- insert :: (Integral i, Ord a) => a -> i -> StackSet i j a -> StackSet i j a -insert k n old = new { cache = M.insert k n (cache new) - , stacks = M.adjust (\(f, ks) -> (f, k:ks)) n (stacks new) - , focus = M.insert n k (focus new) } +insert k n old = pushFocus n k $ + new { cache = M.insert k n (cache new) + , stacks = M.adjust (\(f, ks) -> (f, k:ks)) n (stacks new) } where new = delete k old -- | /O(log n)/. Delete an element entirely from from the StackSet. hunk ./StackSet.hs 187 -- If the element doesn't exist, the original StackSet is returned unmodified. delete :: (Integral i, Ord a) => a -> StackSet i j a -> StackSet i j a delete k w = maybe w del (M.lookup k (cache w)) - where - del i = w { cache = M.delete k (cache w) - , stacks = M.adjust (\(xs, ys) -> (L.delete k xs, L.delete k ys)) i (stacks w) - , focus = M.update (\k' -> if k == k' then elemAfter k =<< index i w - else Just k') i (focus w) } + where del i = popFocus i k $ + w { cache = M.delete k (cache w) + , stacks = M.adjust (\(xs, ys) -> (L.delete k xs, L.delete k ys)) i (stacks w) } -- | /O(log n)/. If the given window is contained in a workspace, make it the -- focused window of that workspace, and make that workspace the current one. hunk ./StackSet.hs 194 raiseFocus :: (Integral i, Integral j, Ord a) => a -> StackSet i j a -> StackSet i j a -raiseFocus k w = case M.lookup k (cache w) of - Nothing -> w - Just i -> (view i w) { focus = M.insert i k (focus w) } +raiseFocus k w = maybe w (\i -> pushFocus i k $ view i w) $ M.lookup k (cache w) -- | Swap the currently focused window with the master window (the -- window on top of the stack). Focus moves to the master. hunk ./tests/Properties.hs 163 where _ = x :: T -} +prop_delete_push i x = not (member i x) ==> delete i (push i x) == x + where _ = x :: T + prop_delete2 i x = delete i x == delete i (delete i x) where _ = x :: T hunk ./tests/Properties.hs 174 where _ = x :: T -- rotation is reversible in two directions -prop_rotaterotate1 (x :: T) = rotate LT (rotate GT x) == x -prop_rotaterotate2 (x :: T) = rotate GT (rotate LT x) == x +prop_rotaterotate1 (x :: T) = rotate LT (rotate GT x') == x' + where x' = rotate LT x +prop_rotaterotate2 (x :: T) = rotate GT (rotate LT x') == x' + where x' = rotate GT x -- rotation through the height of a stack gets us back to the start hunk ./tests/Properties.hs 180 -prop_rotate_all (x :: T) = foldr (\_ y -> rotate GT y) x [1..n] == x +prop_rotate_all (x :: T) = f (f x) == f x where n = height (current x) x hunk ./tests/Properties.hs 183 + f x' = foldr (\_ y -> rotate GT y) x' [1..n] prop_viewview r x = hunk ./tests/Properties.hs 253 where _ = x :: T -- promote doesn't mess with other windows -prop_promote_raise_id x b = (not . null . fromMaybe [] . flip index x . current $ x) ==> - (raiseFocus y . promote . raiseFocus z . promote) x == x +prop_promote_raise_id x = (not . null . fromMaybe [] . flip index x . current $ x) ==> + (promote . promote . promote) x == promote x where _ = x :: T hunk ./tests/Properties.hs 256 - dir = if b then LT else GT - (Just y) = peek x - (Just (z:_)) = flip index x . current $ x -- push shouldn't change anything but the current workspace prop_push_local (x :: T) i = not (member i x) ==> hidden x == hidden (push i x) hunk ./tests/Properties.hs 378 ,("delete/not.member", mytest prop_delete_uniq) ,("delete idempotent", mytest prop_delete2) - -- disabled, for now ,("delete.push identity" , mytest prop_delete_push) + ,("delete.push identity" , mytest prop_delete_push) ,("focus", mytest prop_focus1) } Context: [Remove broken prop_promoterotate, replace it with prop_promote_raise_id Spencer Janssen **20070508211907] [Disable shift_reversible until focus issues are decided. Spencer Janssen **20070508210952] [Disable delete.push until focus issues are decided Spencer Janssen **20070508204921] [Remove unsafe fromJust Spencer Janssen **20070508163822] [Add the initial Catch testing framework for StackSet Neil Mitchell **20070508154621] [Work around the fact that Yhc gets defaulting a bit wrong Neil Mitchell **20070508124949] [Make tests typecheck Spencer Janssen **20070508152449] [Remove unsafe use of head Spencer Janssen **20070508152116] [Make 'index' return Nothing, rather than error Spencer Janssen **20070508151200] [Use 'drop 1' rather than tail, skip equality check. Spencer Janssen **20070508150943] [Redundant parens Spencer Janssen **20070508150412] [StackSet.view: ignore invalid indices Spencer Janssen **20070508143951] [Change the swap function so its Haskell 98, by using list-comps instead of pattern-guards. Neil Mitchell **20070508123158] [Arbitrary instance for StackSet must set random focus on each workspace Don Stewart **20070508051126 When focus was separated from the stack order on each workspace, we forgot to update the Arbitrary instance to set random focus. As spotted by David R, this then invalidates 4 of our QC properties. In particular, the property involving where focus goes after a random transient (annoying behaviour) appeared to be correct, but wasn't, due to inadequate coverage. This patch sets focus to a random window on each workspace. As a result, we now catch the focus/raise/delete issue people have been complaining about. Lesson: make sure your QuickCheck generators are doing what you think they are. ] [make Properties.hs exit with failure on test failure Jason Creighton **20070505174357] [make quickcheck tests friendlier to read. David Roundy **20070505175415] [since we just ignore type errors, no need to derive Show Don Stewart **20070504094143] [Constrain layout messages to be members of a Message class Don Stewart **20070504081649 Using Typeables as the only constraint on layout messages is a bit scary, as a user can send arbitrary values to layoutMsg, whether they make sense or not: there's basically no type feedback on the values you supply to layoutMsg. Folloing Simon Marlow's dynamically extensible exceptions paper, we use an existential type, and a Message type class, to constrain valid arguments to layoutMsg to be valid members of Message. That is, a user writes some data type for messages their layout algorithm accepts: data MyLayoutEvent = Zoom | Explode | Flaming3DGlassEffect deriving (Typeable) and they then add this to the set of valid message types: instance Message MyLayoutEvent Done. We also reimplement the dynamic type check while we're here, to just directly use 'cast', rather than expose a raw fromDynamic/toDyn. With this, I'm much happier about out dynamically extensible layout event subsystem. ] [Handle empty layout lists Spencer Janssen **20070504045644] [refactoring, style, comments on new layout code Don Stewart **20070504023618] [use anyKey constant instead of magic number Jason Creighton **20070504015043] [added mirrorLayout to mirror arbitrary layouts Jason Creighton **20070504014653] [Fix layout switching order Spencer Janssen **20070503235632] [More Config.hs bugs Spencer Janssen **20070503234607] [Revert accidental change to Config.hs Spencer Janssen **20070503233148] [Add -fglasgow-exts for pattern guards. Properties.hs doesn't complain anymore Spencer Janssen **20070503214221] [Avoid the unsafe pattern match, in case Config.hs has no layouts Spencer Janssen **20070503214007] [add support for extensible layouts. David Roundy **20070503144750] [comments. and stop tracing events to stderr Don Stewart **20070503075821] [-Wall police Don Stewart **20070503074937] [elaborate documentation in Config.hs Don Stewart **20070503074843] [Use updated refreshKeyboardMapping. Requires latest X11-extras Spencer Janssen **20070503032040] [run QC tests in addition to LOC test Jason Creighton **20070503003202] [Add 'mod-n': refreshes current layout Spencer Janssen **20070503002252] [Fix tests after StackSet changes Spencer Janssen **20070502201622] [First steps to adding floating layer Spencer Janssen **20070502195917] [update motivational text using xmonad.org Don Stewart **20070502061859] [Sort dependencies in installation order Spencer Janssen **20070501204249] [Recommend X11-extras 0.1 Spencer Janssen **20070501204121] [elaborate description in .cabal Don Stewart **20070501035414] [use -fasm by default. Much faster Don Stewart **20070501031220] [check we never generate invalid stack sets Don Stewart **20070430065946] [Make border width configurable Spencer Janssen **20070430163515] [Add Config.hs-boot, remove defaultLayoutDesc from XConf Spencer Janssen **20070430162647] [Comment only Spencer Janssen **20070430161635] [Comment only Spencer Janssen **20070430161511] [view n . shift n . view i . shift i) x == x --> shift + view is invertible Don Stewart **20070430062901] [add rotate all and view idempotency tests Don Stewart **20070430055751] [Add XConf for values that don't change. Spencer Janssen **20070430054715] [Control.Arrow is suspicious, add an explicit import Spencer Janssen **20070430053623] [push is idempotent Don Stewart **20070430054345] [add two properties relating to empty window managers Don Stewart **20070430051016] [new QC property: opening a window only affects the current screen Don Stewart **20070430050133] [configurable border colors Jason Creighton **20070430043859 This also fixes a bug where xmonad was assuming a 24-bit display, and just using, eg, 0xff0000 as an index into a colormap without querying the X server to determine the proper pixel value for "red". ] [a bit more precise about building non-empty stacksets for one test Don Stewart **20070430035729] [remove redundant call to 'delete' in 'shift' Don Stewart **20070430031151] [clean 'delete' a little Don Stewart **20070430025319] [shrink 'swap' Don Stewart **20070430024813] [shrink 'rotate' a little Don Stewart **20070430024525] [move size into Properties.hs Don Stewart **20070430021758] [don't need 'size' operation on StackSet Don Stewart **20070430015927] [add homepage: field to .cabal file Don Stewart **20070429041011] [add fromList to Properties.hs Don Stewart **20070429035823] [move fromList into Properties.hs, -17 loc Don Stewart **20070429035804] [avoid grabbing all keys when a keysym is undefined Jason Creighton **20070428180046 XKeysymToKeycode() returns zero if the keysym is undefined. Zero also happens to be the value of AnyKey. ] [Further refactoring Spencer Janssen **20070426212257] [Refactor in Config.hs (no real changes) Spencer Janssen **20070426211407] [Add the manpage to extra-source-files Spencer Janssen **20070426014105] [add xmonad manpage David Lazar **20070426010812] [Remove toList Spencer Janssen **20070426005713] [Ignore numlock and capslock in keybindings Jason Creighton **20070424013357] [Clear numlock bit Spencer Janssen **20070424010352] [force window border to 1px Jason Creighton **20070423050824] [s/creigh// Don Stewart **20070423024026] [some other things to do Don Stewart **20070423023151] [Start TODOs for 0.2 Spencer Janssen **20070423021526] [update readme Don Stewart **20070422090507] [TAG 0.1 Spencer Janssen **20070422083033] Patch bundle hash: 18b1c2be165ec0a491721ea06cad9d915a5bfd06