New patches: [Introduce NonEmptyStack. David Roundy **20070526021804] < > { hunk ./Operations.hs 101 modify (\s -> s { windowset = news }) refresh -- TODO: this requires too much mucking about with StackSet internals - mapM_ hide . concatMap (integrate . W.stack) $ + mapM_ hide . concatMap (W.integrate . W.stack) $ intersectBy (\w x -> W.tag w == W.tag x) (map W.workspace $ W.current oldws : W.visible oldws) (W.hidden news) -- intersection of previously visible with currently hidden clearEnterEvents hunk ./Operations.hs 105 - where - -- TODO: move this into StackSet. This isn't exactly the usual integrate. - integrate W.Empty = [] - integrate (W.Node x l r) = x : l ++ r -- | hide. Hide a window by moving it off screen. hide :: Window -> X () hunk ./StackSet.hs 78 -- 'delete'. -- module StackSet ( - StackSet(..), Workspace(..), Screen(..), Stack(..), + StackSet(..), Workspace(..), Screen(..), Stack, NonEmptyStack, new, view, lookupWorkspace, peek, index, focusLeft, focusRight, hunk ./StackSet.hs 80 + integrate, focusWindow, member, findIndex, insertLeft, delete, shift, swapMaster, swapLeft, swapRight, modify -- needed by users ) where hunk ./StackSet.hs 144 -- structures, it is the differentiation of a [a], and integrating it -- back has a natural implementation used in 'index'. -- -data Stack a = Empty - | Node { focus :: !a -- focused thing in this set - , left :: [a] -- clowns to the left - , right :: [a] } -- jokers to the right +type Stack a = Maybe (NonEmptyStack a) +data NonEmptyStack a = Node { focus :: !a -- focused thing in this set + , left :: [a] -- clowns to the left + , right :: [a] } -- jokers to the right deriving (Show, Read, Eq) -- --------------------------------------------------------------------- hunk ./StackSet.hs 163 new n m | n > 0 && m > 0 = StackSet n cur visi unseen | otherwise = error "non-positive arguments to StackSet.new" - where (seen,unseen) = L.genericSplitAt m $ Workspace 0 Empty : [ Workspace i Empty | i <- [1 ..n-1]] + where (seen,unseen) = L.genericSplitAt m $ Workspace 0 Nothing : [ Workspace i Nothing | i <- [1 ..n-1]] (cur:visi) = [ Screen i s | (i,s) <- zip seen [0..] ] -- now zip up visibles with their screen id hunk ./StackSet.hs 209 -- -- The 'with' function takes a default value, a function, and a --- StackSet. If the current stack is Empty, 'with' returns the +-- StackSet. If the current stack is Nothing, 'with' returns the -- default value. Otherwise, it applies the function to the stack, -- returning the result. It is like 'maybe' for the focused workspace. -- hunk ./StackSet.hs 213 -with :: b -> (Stack a -> b) -> StackSet i a s -> b -with dflt f s = case stack (workspace (current s)) of Empty -> dflt; v -> f v +with :: b -> (NonEmptyStack a -> b) -> StackSet i a s -> b +with dflt f s = case stack (workspace (current s)) of Nothing -> dflt; Just v -> f v -- TODO: ndm: a 'catch' proof here that 'f' only gets Node -- constructors, hence all 'f's are safe below? hunk ./StackSet.hs 219 -- --- Apply a function, and a default value for Empty, to modify the current stack. +-- Apply a function, and a default value for Nothing, to modify the current stack. -- hunk ./StackSet.hs 221 -modify :: Stack a -> (Stack a -> Stack a) -> StackSet i a s -> StackSet i a s +modify :: NonEmptyStack a -> (NonEmptyStack a -> NonEmptyStack a) -> StackSet i a s -> StackSet i a s modify d f s = s { current = (current s) hunk ./StackSet.hs 223 - { workspace = (workspace (current s)) { stack = with d f s }}} + { workspace = (workspace (current s)) { stack = Just $ with d f s }}} + +-- +-- Apply a function to modify the current stack unless it's empty. +-- +modifyExisting :: (NonEmptyStack a -> NonEmptyStack a) -> StackSet i a s -> StackSet i a s +modifyExisting f s = s { current = (current s) { workspace = cws { stack = f `fmap` (stack cws) }}} + where cws = workspace $ current s -- -- /O(1)/. Extract the focused element of the current stack. hunk ./StackSet.hs 263 -- the wrapping model should 'cycle' on the current stack. -- focusLeft, focusRight, swapLeft, swapRight :: StackSet i a s -> StackSet i a s -focusLeft = modify Empty $ \c -> case c of +focusLeft = modifyExisting $ \c -> case c of Node _ [] [] -> c Node t (l:ls) rs -> Node l ls (t:rs) Node t [] rs -> Node x (xs ++ [t]) [] where (x:xs) = reverse rs hunk ./StackSet.hs 268 -focusRight = modify Empty $ \c -> case c of +focusRight = modifyExisting $ \c -> case c of Node _ [] [] -> c Node t ls (r:rs) -> Node r (t:ls) rs Node t ls [] -> Node x [] (xs ++ [t]) where (x:xs) = reverse ls hunk ./StackSet.hs 273 -swapLeft = modify Empty $ \c -> case c of +swapLeft = modifyExisting $ \c -> case c of Node _ [] [] -> c Node t (l:ls) rs -> Node t ls (l:rs) Node t [] rs -> Node t (reverse rs) [] hunk ./StackSet.hs 278 -swapRight = modify Empty $ \c -> case c of +swapRight = modifyExisting $ \c -> case c of Node _ [] [] -> c Node t ls (r:rs) -> Node t (r:ls) rs Node t ls [] -> Node t [] (reverse ls) hunk ./StackSet.hs 308 findIndex :: Eq a => a -> StackSet i a s -> Maybe i findIndex a s = listToMaybe [ tag w | w <- workspace (current s) : map workspace (visible s) ++ hidden s, has a (stack w) ] - where has _ Empty = False - has x (Node t l r) = x `elem` (t : l ++ r) + where has _ Nothing = False + has x (Just (Node t l r)) = x `elem` (t : l ++ r) -- --------------------------------------------------------------------- -- Modifying the stackset hunk ./StackSet.hs 359 removeWindow o n = foldr ($) s [view o,remove ,until ((Just w ==) . peek) focusLeft,view n] -- actual removal logic, and focus/master logic: - remove = modify Empty $ \c -> case c of - Node _ ls (r:rs) -> Node r ls rs -- try right first - Node _ (l:ls) [] -> Node l ls [] -- else left. - Node _ [] [] -> Empty + remove s' = s' { current = (current s) { workspace = cws { stack = rm (stack cws) }}} + where cws = workspace $ current s' + rm Nothing = Nothing + rm (Just c) = case c of + Node _ ls (r:rs) -> Just (Node r ls rs) -- try right first + Node _ (l:ls) [] -> Just (Node l ls []) -- else left. + Node _ [] [] -> Nothing ------------------------------------------------------------------------ -- Setting the master window hunk ./StackSet.hs 374 -- The old master window is swapped in the tiling order with the focused window. -- Focus stays with the item moved. swapMaster :: StackSet i a s -> StackSet i a s -swapMaster = modify Empty $ \c -> case c of +swapMaster = modifyExisting $ \c -> case c of Node _ [] _ -> c -- already master. Node t ls rs -> Node t [] (ys ++ x : rs) where (x:ys) = reverse ls hunk ./StackSet.hs 398 -- ^^ poor man's state monad :-) +-- TODO: Describe the use of this. This isn't exactly the usual integrate. +integrate :: Stack a -> [a] +integrate Nothing = [] +integrate (Just (Node x l r)) = x : l ++ r + } Context: [Use --resume by default Spencer Janssen **20070523191418] [restart: don't preserve old args Spencer Janssen **20070522060357] [add swapLeft and swapRight bobstopper@bobturf.org**20070522050008] [Wibble Spencer Janssen **20070522043844] [Generalize withDisplay's type Spencer Janssen **20070522043758] [refactor using whenX Don Stewart **20070522043116] [Add preliminary randr support Spencer Janssen **20070522040228] [Update the Catch checking to the new interface for StackSet Neil Mitchell**20070522015422] [Remove the magic '2' Spencer Janssen **20070521234535] [List --resume args first Spencer Janssen **20070521232427] [Move special case 'view' code into 'windows'. Spencer Janssen **20070521215646 This is ugly right now -- I promise to clean it up later. ] [Experimental support for a beefier restart. Spencer Janssen **20070521194653] [Catch the exception rather than explicitly checking the PATH Spencer Janssen **20070521191900] [Put restart in the X monad Spencer Janssen **20070521190749] [Show instances for WorkspaceId and ScreenId Spencer Janssen **20070521190704] [Read instance for StackSet Spencer Janssen **20070521184504] [Remove redundant fromIntegrals Spencer Janssen **20070521165123] [Use Position for dimensions Spencer Janssen **20070521162809] [Make screen info dynamic: first step to supporting randr Spencer Janssen **20070521152759] [modify Don Stewart **20070521115750] [Move xinerama current/visible/hidden workspace logic into StackSet directly. Don Stewart **20070521055253] [s/workspace/windowset/ Jason Creighton **20070521040330] [focusWindow: always view the containing workspace first Jason Creighton **20070521035551] [only hide old workspace on view if the old workspace is not visible (Xinerama) Jason Creighton **20070521031435] [Fix mod-j/k bindings Spencer Janssen **20070521030253] [explicit export list for StackSet Don Stewart **20070521025250] [comment only Don Stewart **20070520090846] [Be explicit about suspicious System.Mem import Spencer Janssen **20070520165741] [HEADS UP: Rewrite StackSet as a Zipper Don Stewart **20070520070053 In order to give a better account of how focus and master interact, and how each operation affects focus, we reimplement the StackSet type as a two level nested 'Zipper'. To quote Oleg: A Zipper is essentially an `updateable' and yet pure functional cursor into a data structure. Zipper is also a delimited continuation reified as a data structure. That is, we use the Zipper as a cursor which encodes the window which is in focus. Thus our data structure tracks focus correctly by construction! We then get simple, obvious semantics for e.g. insert, in terms of how it affects focus/master. Our transient-messes-with-focus bug evaporates. 'swap' becomes trivial. By moving focus directly into the stackset, we can toss some QC properties about focus handling: it is simply impossible now for focus to go wrong. As a benefit, we get a dozen new QC properties for free, governing how master and focus operate. The encoding of focus in the data type also simplifies the focus handling in Operations: several operations affecting focus are now simply wrappers over StackSet. For the full story, please read the StackSet module, and the QC properties. Finally, we save ~40 lines with the simplified logic in Operations.hs For more info, see the blog post on the implementation, http://cgi.cse.unsw.edu.au/~dons/blog/2007/05/17#xmonad_part1b_zipper ] [Read is not needed for StackSet Spencer Janssen **20070516054233] [variable number of windows in master area Jason Creighton **20070516031437] [Use camelCase, please. Spencer Janssen **20070516014454] [beautify tile David Roundy **20070515154011] [put doLayout in the X monad. David Roundy **20070512215301] [setsid() before exec. Intended to fix issue #7 Spencer Janssen **20070514044547] [keep focus stack. David Roundy **20070510131637] [bump LOC limit to 550 Jason Creighton **20070510032731] [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 quickcheck tests friendlier to read. David Roundy **20070505175415] [make Properties.hs exit with failure on test failure Jason Creighton **20070505174357] [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: 5eb1cde04f04ca593f69d26f4272034ed2b746eb