New patches: [keep focus stack. David Roundy **20070505175709] < > { hunk ./StackSet.hs 47 , 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) 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, an exception is thrown. index :: Integral i => i -> StackSet i j a -> [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 188 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) } + 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 195 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 132 prop_delete_push i x = not (member i x) ==> delete i (push i x) == x where _ = x :: T +prop_delete_insert i j x = not (member i x) ==> delete i (insert i j x) == x + where _ = x :: T + prop_delete2 i x = delete i x == delete i (delete i x) where _ = x :: T hunk ./tests/Properties.hs 143 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 149 -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 152 + f x' = foldr (\_ y -> rotate GT y) x' [1..n] prop_viewview r x = hunk ./tests/Properties.hs 339 ,("delete/not.member", mytest prop_delete_uniq) ,("delete idempotent", mytest prop_delete2) ,("delete.push identity" , mytest prop_delete_push) + ,("delete.insert identity" , mytest prop_delete_insert) ,("focus", mytest prop_focus1) } Context: [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: f2218fcf6c601b19b735db4b8d50aa8ec635756f