aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Main.hs167
-rw-r--r--W.hs49
2 files changed, 97 insertions, 119 deletions
diff --git a/Main.hs b/Main.hs
index bf5562c..6fdfbd3 100644
--- a/Main.hs
+++ b/Main.hs
@@ -13,10 +13,7 @@
-- thunk, a minimal window manager for X11
--
-import qualified Data.Map as Map
-import Data.Map (Map)
-
-import Data.Bits
+import Data.Bits hiding (rotate)
import System.IO
import System.Process (runCommand)
@@ -29,56 +26,62 @@ import Control.Monad.State
import W
-------------------------------------------------------------------------
-
--
-- let's get underway
--
main :: IO ()
main = do
dpy <- openDisplay ""
- runW realMain $ WState
- { display = dpy
- , screenWidth = displayWidth dpy (defaultScreen dpy)
- , screenHeight = displayHeight dpy (defaultScreen dpy)
- , windows = []
- }
+ let dflt = defaultScreen dpy
+ initState = WState
+ { display = dpy
+ , screenWidth = displayWidth dpy dflt
+ , screenHeight = displayHeight dpy dflt
+ , windows = [] }
+
+ runW initState $ do
+ root <- io $ rootWindow dpy dflt
+ io $ do selectInput dpy root (substructureRedirectMask .|. substructureNotifyMask)
+ sync dpy False
+ registerKeys dpy root
+ go dpy
+
return ()
+ where
+ -- The main loop
+ go dpy = forever $ do
+ e <- io $ allocaXEvent $ \ev -> nextEvent dpy ev >> getEvent ev
+ handle e
--
--- Grab the display and input, and jump into the input loop
+-- | grabkeys. Register key commands
--
-realMain :: W ()
-realMain = do
- dpy <- getDisplay
- let screen = defaultScreen dpy
- io $ do root <- rootWindow dpy screen
- selectInput dpy root (substructureRedirectMask .|. substructureNotifyMask)
- sync dpy False
- grabkeys
- loop
+registerKeys :: Display -> Window -> W ()
+registerKeys dpy root =
+ forM_ keys $ \(mod, sym, _) -> do
+ kc <- io (keysymToKeycode dpy sym)
+ io $ grabKey dpy kc mod root True grabModeAsync grabModeAsync
---
--- The main event handling loop
---
-loop :: W ()
-loop = do
- dpy <- getDisplay
- forever $ do
- e <- io $ allocaXEvent $ \ev -> nextEvent dpy ev >> getEvent ev
- handler e
+keys :: [(KeyMask, KeySym, W ())]
+keys =
+ [ (mod1Mask .|. shiftMask, xK_Return, spawn "xterm")
+ , (mod1Mask, xK_p, spawn "exe=`dmenu_path | dmenu` && exec $exe")
+ , (controlMask, xK_space, spawn "gmrun")
+ , (mod1Mask, xK_Tab, switch)
+ , (mod1Mask .|. shiftMask, xK_q, io $ exitWith ExitSuccess)
+ ]
--
-- The event handler
--
-handler :: Event -> W ()
-handler (MapRequestEvent {window = w}) = manage w
+handle :: Event -> W ()
+handle (MapRequestEvent {window = w}) = manage w
-handler (DestroyWindowEvent {window = w}) = do
+handle (DestroyWindowEvent {window = w}) = do
modifyWindows (filter (/= w))
refresh
-handler (KeyEvent {event_type = t, state = mod, keycode = code})
+handle (KeyEvent {event_type = t, state = mod, keycode = code})
| t == keyPress = do
dpy <- getDisplay
sym <- io $ keycodeToKeysym dpy code 0
@@ -86,75 +89,57 @@ handler (KeyEvent {event_type = t, state = mod, keycode = code})
[] -> return ()
((_, _, act):_) -> act
-handler _ = return ()
+handle _ = return ()
---
--- switch focus to next window in list.
---
-switch :: W ()
-switch = do
- ws <- getWindows
- case ws of
- [] -> return ()
- (x:xs) -> do
- setWindows (xs++[x]) -- snoc. polish this.
- refresh
+-- ---------------------------------------------------------------------
+-- Managing windows
---
--- | spawn. Launch an external application
---
-spawn :: String -> W ()
-spawn = io_ . runCommand
+-- | Modify the current window list with a pure funtion, and refresh
+withWindows :: (Windows -> Windows) -> W ()
+withWindows f = do
+ modifyWindows f
+ refresh
---
--- | Keys we understand.
---
-keys :: [(KeyMask, KeySym, W ())]
-keys =
- [ (mod1Mask .|. shiftMask, xK_Return, spawn "xterm")
- , (mod1Mask, xK_p, spawn "exe=`dmenu_path | dmenu` && exec $exe")
- , (controlMask, xK_space, spawn "gmrun")
- , (mod1Mask, xK_Tab, switch)
- , (mod1Mask .|. shiftMask, xK_q, io $ exitWith ExitSuccess)
- ]
+-- | Run an action on the currently focused window
+withCurrent :: (Window -> W ()) -> W ()
+withCurrent f = do
+ ws <- getWindows
+ case ws of
+ [] -> return ()
+ (w:_) -> f w
--
--- | grabkeys. Register key commands
+-- | refresh. Refresh the currently focused window. Resizes to full
+-- screen and raises the window.
--
-grabkeys :: W ()
-grabkeys = do
- dpy <- getDisplay
- root <- io $ rootWindow dpy (defaultScreen dpy)
- forM_ keys $ \(mod, sym, _) -> do
- code <- io $ keysymToKeycode dpy sym
- io $ grabKey dpy code mod root True grabModeAsync grabModeAsync
+refresh :: W ()
+refresh = withCurrent $ \w -> do
+ d <- getDisplay
+ sw <- getScreenWidth
+ sh <- getScreenHeight
+ io $ do moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh)
+ raiseWindow d w
--
---
+-- | manage. Add a new window to be managed
--
manage :: Window -> W ()
manage w = do
trace "manage"
- d <- getDisplay
- ws <- getWindows
- when (w `notElem` ws) $ do
- trace "modifying"
- modifyWindows (w :)
- io $ mapWindow d w
- refresh
+ d <- getDisplay
+ withWindows $ \ws -> if w `elem` ws then ws else w:ws -- a set
+ io $ mapWindow d w
+
--
--- refresh the windows
+-- | switch. switch focus to next window in list.
+-- The currently focused window is always the head of the list
--
-refresh :: W ()
-refresh = do
- ws <- getWindows
- case ws of
- [] -> return ()
- (w:_) -> do
- d <- getDisplay
- sw <- getScreenWidth
- sh <- getScreenHeight
- io $ do moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh)
- raiseWindow d w
+switch :: W ()
+switch = withWindows rotate
+--
+-- | spawn. Launch an external application
+--
+spawn :: String -> W ()
+spawn = io_ . runCommand
diff --git a/W.hs b/W.hs
index 5bacfea..deed0e6 100644
--- a/W.hs
+++ b/W.hs
@@ -20,64 +20,42 @@ import System.IO
import Graphics.X11.Xlib
import Control.Monad.State
---
-- | WState, the window manager state.
-- Just the display, width, height and a window list
---
data WState = WState
{ display :: Display
, screenWidth :: !Int
, screenHeight :: !Int
- , windows :: Windows
+ , windows :: !Windows
}
type Windows = [Window]
-- | The W monad, a StateT transformer over IO encapuslating the window
-- manager state
---
-newtype W a = W (StateT WState IO a)
+newtype W a = W { unW :: StateT WState IO a }
deriving (Functor, Monad, MonadIO)
-- | Run the W monad, given a chunk of W monad code, and an initial state
-- Return the result, and final state
---
-runW :: W a -> WState -> IO (a, WState)
-runW (W m) = runStateT m
+runW :: WState -> W a -> IO (a, WState)
+runW st a = runStateT (unW a) st
-withIO :: (forall b. (a -> IO b) -> IO b) -> (a -> W c) -> W c
-withIO f g = do
- s <- W get
- (y, t) <- io (f (flip runW s . g))
- W (put t)
- return y
-
---
-- | Lift an IO action into the W monad
---
io :: IO a -> W a
io = liftIO
---
-- | Lift an IO action into the W monad, discarding any result
---
io_ :: IO a -> W ()
io_ f = liftIO f >> return ()
---
--- | A 'trace' for the W monad
---
+-- | 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
---
--- | Run an action forever
---
-forever :: (Monad m) => m a -> m b
-forever a = a >> forever a
-
-- ---------------------------------------------------------------------
-- Getting at the window manager state
@@ -104,3 +82,18 @@ setWindows x = W (modify (\s -> s {windows = x}))
-- | Modify the current window list
modifyWindows :: (Windows -> Windows) -> W ()
modifyWindows f = W (modify (\s -> s {windows = f (windows s)}))
+
+-- ---------------------------------------------------------------------
+-- Generic utilities
+
+-- | Run an action forever
+forever :: (Monad m) => m a -> m b
+forever a = a >> forever a
+
+-- | Add an element onto the end of a list
+snoc :: [a] -> a -> [a]
+snoc xs x = xs ++ [x]
+
+-- | Rotate a list one element
+rotate [] = []
+rotate (x:xs) = xs `snoc` x