mirror of
https://github.com/xmonad/xmonad.git
synced 2025-05-19 00:20:22 -07:00
161 lines
3.7 KiB
Haskell
161 lines
3.7 KiB
Haskell
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : Main.hs
|
|
-- Copyright : (c) Spencer Janssen 2007
|
|
-- License : BSD3-style (see LICENSE)
|
|
--
|
|
-- Maintainer : sjanssen@cse.unl.edu
|
|
-- Stability : unstable
|
|
-- Portability : not portable, uses mtl, X11, posix
|
|
--
|
|
-----------------------------------------------------------------------------
|
|
--
|
|
-- thunk, a minimal window manager for X11
|
|
--
|
|
|
|
import qualified Data.Map as Map
|
|
import Data.Map (Map)
|
|
|
|
import Data.Bits
|
|
|
|
import System.IO
|
|
import System.Process (runCommand)
|
|
import System.Exit
|
|
|
|
import Graphics.X11.Xlib
|
|
import Graphics.X11.Xlib.Extras
|
|
|
|
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 = []
|
|
}
|
|
return ()
|
|
|
|
--
|
|
-- Grab the display and input, and jump into the input loop
|
|
--
|
|
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
|
|
|
|
--
|
|
-- The main event handling loop
|
|
--
|
|
loop :: W ()
|
|
loop = do
|
|
dpy <- getDisplay
|
|
forever $ do
|
|
e <- io $ allocaXEvent $ \ev -> nextEvent dpy ev >> getEvent ev
|
|
handler e
|
|
|
|
--
|
|
-- The event handler
|
|
--
|
|
handler :: Event -> W ()
|
|
handler (MapRequestEvent {window = w}) = manage w
|
|
|
|
handler (DestroyWindowEvent {window = w}) = do
|
|
modifyWindows (filter (/= w))
|
|
refresh
|
|
|
|
handler (KeyEvent {event_type = t, state = mod, keycode = code})
|
|
| t == keyPress = do
|
|
dpy <- getDisplay
|
|
sym <- io $ keycodeToKeysym dpy code 0
|
|
case filter (\(mod', sym', _) -> mod == mod' && sym == sym') keys of
|
|
[] -> return ()
|
|
((_, _, act):_) -> act
|
|
|
|
handler _ = 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
|
|
|
|
--
|
|
-- | spawn. Launch an external application
|
|
--
|
|
spawn :: String -> W ()
|
|
spawn = io_ . runCommand
|
|
|
|
--
|
|
-- | 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)
|
|
]
|
|
|
|
--
|
|
-- | grabkeys. Register key commands
|
|
--
|
|
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
|
|
|
|
--
|
|
--
|
|
--
|
|
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
|
|
|
|
--
|
|
-- refresh the windows
|
|
--
|
|
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
|
|
|