diff options
| -rw-r--r-- | Config.hs | 4 | ||||
| -rw-r--r-- | Operations.hs | 44 | ||||
| -rw-r--r-- | XMonad.hs | 38 |
3 files changed, 54 insertions, 32 deletions
@@ -154,8 +154,8 @@ keys = M.fromList $ , ((modMask, xK_j ), raise GT) , ((modMask, xK_k ), raise LT) - , ((modMask, xK_h ), layoutMsg Shrink) - , ((modMask, xK_l ), layoutMsg Expand) + , ((modMask, xK_h ), sendMessage Shrink) + , ((modMask, xK_l ), sendMessage Expand) , ((modMask .|. shiftMask, xK_c ), kill) diff --git a/Operations.hs b/Operations.hs index 73e3c1d..c90ff09 100644 --- a/Operations.hs +++ b/Operations.hs @@ -16,7 +16,6 @@ module Operations where import Data.List import Data.Maybe import Data.Bits -import Data.Dynamic ( Typeable, toDyn, fromDynamic ) import qualified Data.Map as M import Control.Monad.State @@ -73,41 +72,46 @@ clearEnterEvents = do -- uppermost. -- switchLayout :: X () -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')) +-- | Throw an (extensible) message value to the current Layout scheme, +-- possibly modifying how we layout the windows, then refresh. -- --- TODO, using Typeable for extensible stuff is a bit gunky. Check -- --- 'extensible exceptions' paper for other ideas. +-- TODO, this will refresh on Nothing. -- --- 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)) +------------------------------------------------------------------------ -- --- Standard layout algorithms: +-- Builtin layout algorithms: -- -- fullscreen mode -- tall mode -- wide mode +-- +-- The latter algorithms support the following operations: +-- +-- Shrink +-- Expand -- -full :: Layout -tall, wide :: Rational -> Rational -> Layout -full = Layout { doLayout = \sc ws -> [ (w,sc) | w <- ws ] - , modifyLayout = const Nothing } +data Resize = Shrink | Expand deriving (Typeable, Show) +instance Message Resize +full :: Layout +full = Layout { doLayout = \sc ws -> [ (w,sc) | w <- ws ] + , modifyLayout = const Nothing } -- no changes + +tall, wide :: Rational -> Rational -> Layout wide delta frac = mirrorLayout (tall delta frac) tall delta frac = Layout { doLayout = tile frac - , modifyLayout = fmap f . fromDynamic } + , modifyLayout = fmap handler . fromMessage } - 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 -- | Mirror a rectangle mirrorRect :: Rectangle -> Rectangle @@ -17,6 +17,7 @@ module XMonad ( X, WindowSet, WorkspaceId(..), ScreenId(..), XState(..), XConf(..), Layout(..), + Typeable, Message, SomeMessage(..), fromMessage, runX, io, withDisplay, isRoot, spawn, trace, whenJust ) where @@ -28,7 +29,7 @@ import System.IO import System.Posix.Process (executeFile, forkProcess, getProcessStatus) import System.Exit import Graphics.X11.Xlib -import Data.Dynamic ( Dynamic ) +import Data.Typeable import qualified Data.Map as M @@ -36,10 +37,8 @@ import qualified Data.Map as M -- Just the display, width, height and a window list data XState = XState { workspace :: !WindowSet -- ^ workspace list - , 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 data XConf = XConf { display :: Display -- ^ the X11 display @@ -52,8 +51,7 @@ data XConf = XConf , xineScreens :: ![Rectangle] -- ^ dimensions of each screen , normalBorder :: !Color -- ^ border color of unfocused windows - , focusedBorder :: !Color -- ^ border color of the focused window - } + , focusedBorder :: !Color } -- ^ border color of the focused window type WindowSet = StackSet WorkspaceId ScreenId Window @@ -95,10 +93,30 @@ isRoot w = liftM (w==) (asks theRoot) -- Layout handling -- | The different layout modes --- '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. +-- data Layout = Layout { doLayout :: Rectangle -> [Window] -> [(Window, Rectangle)] - , 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 -- --------------------------------------------------------------------- -- Utilities |