From 44ffcec3db8f778814d98acbb36f304d8bc6b956 Mon Sep 17 00:00:00 2001
From: Don Stewart <dons@cse.unsw.edu.au>
Date: Sat, 10 Mar 2007 08:01:52 +0100
Subject: XMonad
darcs-hash:20070310070152-9c5c1-f78385326379d5ff19cb3db926c5b02117e433ff.gz
---
Main.hs | 38 +++++++++++++++++-----------------
WMonad.hs | 71 ---------------------------------------------------------------
XMonad.hs | 71 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 90 insertions(+), 90 deletions(-)
delete mode 100644 WMonad.hs
create mode 100644 XMonad.hs
diff --git a/Main.hs b/Main.hs
index d1e50aa..920fcb5 100644
--- a/Main.hs
+++ b/Main.hs
@@ -26,7 +26,7 @@ import Graphics.X11.Xlib.Extras
import Numeric
import Control.Monad.State
-import WMonad
+import XMonad
import qualified StackSet as W
--
@@ -38,7 +38,7 @@ workspaces = 9
--
-- The keys list
--
-keys :: M.Map (KeyMask, KeySym) (W ())
+keys :: M.Map (KeyMask, KeySym) (X ())
keys = M.fromList $
[ ((mod1Mask .|. shiftMask, xK_Return), spawn "xterm")
, ((mod1Mask, xK_p ), spawn "exe=`dmenu_path | dmenu` && exec $exe")
@@ -61,7 +61,7 @@ main :: IO ()
main = do
dpy <- openDisplay ""
let dflt = defaultScreen dpy
- st = WState
+ st = XState
{ display = dpy
, screenWidth = displayWidth dpy dflt
, screenHeight = displayHeight dpy dflt
@@ -80,7 +80,7 @@ main = do
ws <- scan dpy rootw
allocaXEvent $ \e ->
- runW st $ do
+ runX st $ do
mapM_ manage ws
forever $ handle =<< xevent dpy e
where
@@ -89,7 +89,7 @@ main = do
forever a = a >> forever a
-- ---------------------------------------------------------------------
--- IO stuff. Doesn't require any W state
+-- IO stuff. Doesn't require any X state
-- Most of these things run only on startup (bar grabkeys)
-- | scan for any initial windows to manage
@@ -123,18 +123,18 @@ grabKeys dpy rootw = do
-- [Expose] = expose,
-- [PropertyNotify] = propertynotify,
--
--- Todo: seperate IO from W monad stuff. We want to be able to test the
+-- Todo: seperate IO from X monad stuff. We want to be able to test the
-- handler, and client functions, with dummy X interface ops, in QuickCheck
--
--- Will require an abstract interpreter from Event -> W Action, which
--- modifies the internal W state, and then produces an IO action to
+-- Will require an abstract interpreter from Event -> X Action, which
+-- modifies the internal X state, and then produces an IO action to
-- evaluate.
--
-- XCreateWindowEvent(3X11)
-- Window manager clients normally should ignore this window if the
-- override_redirect member is True.
--
-handle :: Event -> W ()
+handle :: Event -> X ()
handle (MapRequestEvent {window = w}) = withDisplay $ \dpy -> do
wa <- io $ getWindowAttributes dpy w
@@ -204,7 +204,7 @@ handle e = trace (eventName e) -- ignoring
-- | refresh. Refresh the currently focused window. Resizes to full
-- screen and raises the window.
-refresh :: W ()
+refresh :: X ()
refresh = do
ws <- gets workspace
whenJust (W.peek ws) $ \w ->
@@ -215,18 +215,18 @@ refresh = do
raiseWindow d w
-- | hide. Hide a list of windows by moving them offscreen.
-hide :: Window -> W ()
+hide :: Window -> X ()
hide w = withDisplay $ \d -> do
sw <- gets screenWidth
sh <- gets screenHeight
io $! moveWindow d w (2*fromIntegral sw) (2*fromIntegral sh)
-- | reveal. Expose a list of windows, moving them on screen
-reveal :: Window -> W ()
+reveal :: Window -> X ()
reveal w = withDisplay $ \d -> io $! moveWindow d w 0 0
-- | windows. Modify the current window list with a pure function, and refresh
-windows :: (WorkSpace -> WorkSpace) -> W ()
+windows :: (WorkSpace -> WorkSpace) -> X ()
windows f = do
modify $ \s -> s { workspace = f (workspace s) }
refresh
@@ -241,7 +241,7 @@ windows f = do
--
-- When we start to manage a window, it gains focus.
--
-manage :: Window -> W ()
+manage :: Window -> X ()
manage w = do
trace ("Managing window: 0x" ++ showHex w (", " ++ show w))
withDisplay $ \d -> io $ do
@@ -252,7 +252,7 @@ manage w = do
-- | unmanage. A window no longer exists, remove it from the window
-- list, on whatever workspace it is.
-unmanage :: Window -> W ()
+unmanage :: Window -> X ()
unmanage w = do
ws <- gets workspace
when (W.member w ws) $ do
@@ -261,11 +261,11 @@ unmanage w = do
-- | raise. focus to window at offset 'n' in list.
-- The currently focused window is always the head of the list
-raise :: Ordering -> W ()
+raise :: Ordering -> X ()
raise = windows . W.rotate
-- | Kill the currently focused client
-kill :: W ()
+kill :: X ()
kill = withDisplay $ \d -> do
ws <- gets workspace
whenJust (W.peek ws) $ \w -> do
@@ -273,7 +273,7 @@ kill = withDisplay $ \d -> do
io (killClient d w) >> return ()
-- | tag. Move a window to a new workspace
-tag :: Int -> W ()
+tag :: Int -> X ()
tag o = do
ws <- gets workspace
let m = W.current ws
@@ -284,7 +284,7 @@ tag o = do
where n = o-1
-- | view. Change the current workspace to workspce at offset 'n-1'.
-view :: Int -> W ()
+view :: Int -> X ()
view o = do
ws <- gets workspace
let m = W.current ws
diff --git a/WMonad.hs b/WMonad.hs
deleted file mode 100644
index 4e622c5..0000000
--- a/WMonad.hs
+++ /dev/null
@@ -1,71 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : WMonad.hs
--- Copyright : (c) Spencer Janssen 2007
--- License : BSD3-style (see LICENSE)
---
--- Maintainer : sjanssen@cse.unl.edu
--- Stability : unstable
--- Portability : not portable, uses cunning newtype deriving
---
------------------------------------------------------------------------------
---
--- The W monad, a state monad transformer over IO, for the window
--- manager state, and support routines.
---
-
-module WMonad (
- W, WorkSpace, WState(..),runW, withDisplay, io, spawn, trace, whenJust
- ) where
-
-import StackSet (StackSet)
-
-import Control.Monad.State
-import System.IO
-import System.Process (runCommand)
-import Graphics.X11.Xlib (Display,Window)
-
--- | WState, the window manager state.
--- Just the display, width, height and a window list
-data WState = WState
- { display :: Display
- , screenWidth :: {-# UNPACK #-} !Int
- , screenHeight :: {-# UNPACK #-} !Int
- , workspace :: {-# UNPACK #-} !WorkSpace -- ^ workspace list
- }
-
-type WorkSpace = StackSet Window
-
--- | The W monad, a StateT transformer over IO encapuslating the window
--- manager state
-newtype W a = W (StateT WState IO a)
- deriving (Functor, Monad, MonadIO, MonadState WState)
-
--- | Run the W monad, given a chunk of W monad code, and an initial state
--- Return the result, and final state
-runW :: WState -> W a -> IO ()
-runW st (W a) = runStateT a st >> return ()
-
--- | Run a monad action with the current display settings
-withDisplay :: (Display -> W ()) -> W ()
-withDisplay f = gets display >>= f
-
-------------------------------------------------------------------------
-
--- | Lift an IO action into the W monad
-io :: IO a -> W a
-io = liftIO
-{-# INLINE io #-}
-
--- | spawn. Launch an external application
-spawn :: String -> W ()
-spawn x = io (runCommand x) >> return ()
-
--- | Run a side effecting action with the current workspace. Like 'when' but
-whenJust :: Maybe a -> (a -> W ()) -> W ()
-whenJust mg f = maybe (return ()) f mg
-
--- | A 'trace' for the W monad. Logs a string to stderr. The result may
--- be found in your .xsession-errors file
-trace :: String -> W ()
-trace msg = io $! do hPutStrLn stderr msg; hFlush stderr
diff --git a/XMonad.hs b/XMonad.hs
new file mode 100644
index 0000000..77c5a2e
--- /dev/null
+++ b/XMonad.hs
@@ -0,0 +1,71 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : XMonad.hs
+-- Copyright : (c) Spencer Janssen 2007
+-- License : BSD3-style (see LICENSE)
+--
+-- Maintainer : sjanssen@cse.unl.edu
+-- Stability : unstable
+-- Portability : not portable, uses cunning newtype deriving
+--
+-----------------------------------------------------------------------------
+--
+-- The X monad, a state monad transformer over IO, for the window
+-- manager state, and support routines.
+--
+
+module XMonad (
+ X, WorkSpace, XState(..),runX, withDisplay, io, spawn, trace, whenJust
+ ) where
+
+import StackSet (StackSet)
+
+import Control.Monad.State
+import System.IO
+import System.Process (runCommand)
+import Graphics.X11.Xlib (Display,Window)
+
+-- | XState, the window manager state.
+-- Just the display, width, height and a window list
+data XState = XState
+ { display :: Display
+ , screenWidth :: {-# UNPACK #-} !Int
+ , screenHeight :: {-# UNPACK #-} !Int
+ , workspace :: {-# UNPACK #-} !WorkSpace -- ^ workspace list
+ }
+
+type WorkSpace = StackSet Window
+
+-- | The X monad, a StateT transformer over IO encapuslating the window
+-- manager state
+newtype X a = X (StateT XState IO a)
+ deriving (Functor, Monad, MonadIO, MonadState XState)
+
+-- | Run the X monad, given a chunk of X monad code, and an initial state
+-- Return the result, and final state
+runX :: XState -> X a -> IO ()
+runX st (X a) = runStateT a st >> return ()
+
+-- | Run a monad action with the current display settings
+withDisplay :: (Display -> X ()) -> X ()
+withDisplay f = gets display >>= f
+
+------------------------------------------------------------------------
+
+-- | Lift an IO action into the X monad
+io :: IO a -> X a
+io = liftIO
+{-# INLINE io #-}
+
+-- | spawn. Launch an external application
+spawn :: String -> X ()
+spawn x = io (runCommand x) >> return ()
+
+-- | Run a side effecting action with the current workspace. Like 'when' but
+whenJust :: Maybe a -> (a -> X ()) -> X ()
+whenJust mg f = maybe (return ()) f mg
+
+-- | A 'trace' for the X monad. Logs a string to stderr. The result may
+-- be found in your .xsession-errors file
+trace :: String -> X ()
+trace msg = io $! do hPutStrLn stderr msg; hFlush stderr
--
cgit v1.2.3