summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Config.hs4
-rw-r--r--Operations.hs44
-rw-r--r--XMonad.hs38
3 files changed, 54 insertions, 32 deletions
diff --git a/Config.hs b/Config.hs
index 841b3ee..196515d 100644
--- a/Config.hs
+++ b/Config.hs
@@ -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
diff --git a/XMonad.hs b/XMonad.hs
index 8293212..b20f3f7 100644
--- a/XMonad.hs
+++ b/XMonad.hs
@@ -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