New patches: [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. ] { hunk ./Config.hs 157 - , ((modMask, xK_h ), layoutMsg Shrink) - , ((modMask, xK_l ), layoutMsg Expand) + , ((modMask, xK_h ), sendMessage Shrink) + , ((modMask, xK_l ), sendMessage Expand) hunk ./Operations.hs 19 -import Data.Dynamic ( Typeable, toDyn, fromDynamic ) hunk ./Operations.hs 75 -switchLayout = layout (\(x, xs) -> let xs' = xs ++ [x] - in (head xs', tail xs')) +switchLayout = layout (\(x, xs) -> let xs' = xs ++ [x] in (head xs', tail xs')) hunk ./Operations.hs 77 +-- | Throw an (extensible) message value to the current Layout scheme, +-- possibly modifying how we layout the windows, then refresh. hunk ./Operations.hs 80 --- TODO, using Typeable for extensible stuff is a bit gunky. Check -- --- 'extensible exceptions' paper for other ideas. +-- TODO, this will refresh on Nothing. hunk ./Operations.hs 82 --- Basically this thing specifies the basic operations that vary between --- layouts. --- -data ShrinkOrExpand = Shrink | Expand deriving (Typeable, Eq) - -layoutMsg :: Typeable a => a -> X () -- FIXME: The below shouldn't refresh on Nothing -layoutMsg a = layout $ \x@(l, ls) -> maybe x (flip (,) ls) (modifyLayout l (toDyn a)) +sendMessage :: Message a => a -> X () +sendMessage a = layout $ \x@(l, ls) -> maybe x (flip (,) ls) (modifyLayout l (SomeMessage a)) hunk ./Operations.hs 85 +------------------------------------------------------------------------ hunk ./Operations.hs 87 --- Standard layout algorithms: +-- Builtin layout algorithms: hunk ./Operations.hs 92 +-- +-- The latter algorithms support the following operations: hunk ./Operations.hs 95 -full :: Layout -tall, wide :: Rational -> Rational -> Layout +-- Shrink +-- Expand +-- + +data Resize = Shrink | Expand deriving (Typeable, Show) +instance Message Resize hunk ./Operations.hs 102 -full = Layout { doLayout = \sc ws -> [ (w,sc) | w <- ws ] - , modifyLayout = const Nothing } +full :: Layout +full = Layout { doLayout = \sc ws -> [ (w,sc) | w <- ws ] + , modifyLayout = const Nothing } -- no changes hunk ./Operations.hs 106 +tall, wide :: Rational -> Rational -> Layout hunk ./Operations.hs 110 - , modifyLayout = fmap f . fromDynamic } + , modifyLayout = fmap handler . fromMessage } hunk ./Operations.hs 112 - where f s = tall delta ((op s) frac delta) - op Shrink = (-) ; op Expand = (+) + where handler s = tall delta $ (case s of + Shrink -> (-) + Expand -> (+)) frac delta hunk ./XMonad.hs 20 + Typeable, Message, SomeMessage(..), fromMessage, hunk ./XMonad.hs 32 -import Data.Dynamic ( Dynamic ) +import Data.Typeable hunk ./XMonad.hs 40 - , layouts :: !(M.Map WorkspaceId (Layout, [Layout])) - -- ^ mapping of workspaces - -- to descriptions of their layouts - } + , layouts :: !(M.Map WorkspaceId (Layout, [Layout])) } + -- ^ mapping of workspaces to descriptions of their layouts hunk ./XMonad.hs 54 - , focusedBorder :: !Color -- ^ border color of the focused window - } + , focusedBorder :: !Color } -- ^ border color of the focused window hunk ./XMonad.hs 96 --- 'doLayout', a pure function to layout a Window set --- 'modifyLayout', +-- 'doLayout', a pure function to layout a Window set 'modifyLayout', +-- 'modifyLayout' can be considered a branch of an exception handler. +-- hunk ./XMonad.hs 100 - , modifyLayout :: Dynamic -> Maybe Layout } + , modifyLayout :: SomeMessage -> Maybe Layout } + +-- Based on ideas in /An Extensible Dynamically-Typed Hierarchy of Exceptions/, +-- Simon Marlow, 2006. Use extensible messages to the modifyLayout handler. +-- +-- User-extensible messages must be a member of this class: +-- +class (Typeable a, Show a) => Message a + +-- +-- A wrapped value of some type in the Message class. +-- +data SomeMessage = forall a. Message a => SomeMessage a + +-- +-- And now, unwrap a given, unknown Message type, performing a (dynamic) +-- type check on the result. +-- +fromMessage :: Message m => SomeMessage -> Maybe m +fromMessage (SomeMessage m) = cast m } Context: [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] [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] [check we never generate invalid stack sets Don Stewart **20070430065946] [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] [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". ] [new QC property: opening a window only affects the current screen Don Stewart **20070430050133] [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] [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. ] [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] [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: 28177163852c07f1fc191ac89148c43e45866f30