From 10fd9ba251610144fc1a95611a8c003171c60117 Mon Sep 17 00:00:00 2001 From: Don Stewart Date: Sat, 10 Mar 2007 08:01:52 +0100 Subject: XMonad darcs-hash:20070310070152-9c5c1-f78385326379d5ff19cb3db926c5b02117e433ff --- 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