From d9660d6134b3f95c80edd8fcce1e3ee4e0d5acbf Mon Sep 17 00:00:00 2001 From: Jason Creighton Date: Mon, 26 Mar 2007 07:13:41 +0200 Subject: added Config.lhs and moved most things in Main.hs into Operations.hs to enable this darcs-hash:20070326051341-b9aa7-c7743c45bfea2341d5dd98428996195fac96d67c.gz --- Main.hs | 256 +--------------------------------------------------------------- 1 file changed, 4 insertions(+), 252 deletions(-) (limited to 'Main.hs') diff --git a/Main.hs b/Main.hs index cd906cd..e2f5296 100644 --- a/Main.hs +++ b/Main.hs @@ -13,82 +13,20 @@ -- xmonad, a minimal window manager for X11 -- -import Data.List -import Data.Maybe -import Data.Ratio -import Data.Bits hiding (rotate) +import Data.Bits import qualified Data.Map as M -import System.IO -import System.Exit - import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras import Graphics.X11.Xinerama import Control.Monad.State -import System.Posix.Process -import System.Environment - -import XMonad import qualified StackSet as W --- --- The number of workspaces: --- -workspaces :: Int -workspaces = 9 - --- --- modMask lets you easily change which modkey you use. --- -modMask :: KeyMask -modMask = mod1Mask - --- --- The keys list --- -keys :: M.Map (KeyMask, KeySym) (X ()) -keys = M.fromList $ - [ ((modMask .|. shiftMask, xK_Return), spawn "xterm") - , ((modMask, xK_p ), spawn "exe=`dmenu_path | dmenu` && exec $exe") - , ((controlMask, xK_space ), spawn "gmrun") - , ((modMask, xK_Tab ), raise GT) - , ((modMask, xK_j ), raise GT) - , ((modMask, xK_k ), raise LT) - , ((modMask, xK_h ), changeWidth (negate defaultDelta)) - , ((modMask, xK_l ), changeWidth defaultDelta) - , ((modMask .|. shiftMask, xK_c ), kill) - , ((modMask .|. shiftMask, xK_q ), io $ exitWith ExitSuccess) - , ((modMask .|. shiftMask, xK_F12 ), io restart) - , ((modMask, xK_space ), switchLayout) - , ((modMask, xK_Return), promote) - ] ++ - -- generate keybindings to each workspace: - [((m .|. modMask, xK_0 + fromIntegral i), f i) - | i <- [1 .. workspaces] - , (f, m) <- [(view, 0), (tag, shiftMask)]] - -- generate keybindings to each screen: - ++ - [((m .|. modMask, key), screenWS sc >>= f) - | (key, sc) <- zip [xK_w, xK_e, xK_r] [1..] - , (f, m) <- [(view, 0), (tag, shiftMask)]] - - --- The default size for the left pane -defaultLeftWidth :: Rational -defaultLeftWidth = 1%2 - --- How much to change the size of the windows on the left by default -defaultDelta :: Rational -defaultDelta = 3%100 - --- --- The mask for the numlock key. You may need to change this on some systems. --- -numlockMask :: KeySym -numlockMask = lockMask +import XMonad +import Operations +import Config -- -- The main entry point @@ -160,13 +98,6 @@ grabKeys dpy rootw = do where grab kc m = grabKey dpy kc m rootw True grabModeAsync grabModeAsync --- | Restart xmonad by exec()'ing self. This doesn't save state and xmonad has --- to be in PATH for this to work. -restart :: IO () -restart = do prog <- getProgName - args <- getArgs - executeFile prog True args Nothing - -- --------------------------------------------------------------------- -- Event handler -- @@ -252,182 +183,3 @@ handle e@(ConfigureRequestEvent {window = w}) = do handle e = trace (eventName e) -- ignoring --- --------------------------------------------------------------------- --- Managing windows - --- | refresh. Refresh the currently focused window. Resizes to full --- screen and raises the window. -refresh :: X () -refresh = do - ws <- gets workspace - ws2sc <- gets wsOnScreen - xinesc <- gets xineScreens - d <- gets display - l <- gets layout - ratio <- gets leftWidth - let move w a b c e = io $ moveResizeWindow d w a b c e - flip mapM_ (M.assocs ws2sc) $ \(n, scn) -> do - let sc = xinesc !! scn - sx = rect_x sc - sy = rect_y sc - sw = rect_width sc - sh = rect_height sc - case l of - Full -> whenJust (W.peekStack n ws) $ \w -> do - move w sx sy sw sh - io $ raiseWindow d w - Tile -> case W.index n ws of - [] -> return () - [w] -> do move w sx sy sw sh; io $ raiseWindow d w - (w:s) -> do - let lw = floor $ fromIntegral sw * ratio - rw = sw - fromIntegral lw - rh = fromIntegral sh `div` fromIntegral (length s) - move w sx sy (fromIntegral lw) sh - zipWithM_ (\i a -> move a (sx + lw) (sy + i * rh) rw (fromIntegral rh)) [0..] s - whenJust (W.peek ws) (io . raiseWindow d) -- this is always Just - whenJust (W.peek ws) setFocus - --- | switchLayout. Switch to another layout scheme. -switchLayout :: X () -switchLayout = do - modify (\s -> s {layout = case layout s of - Full -> Tile - Tile -> Full }) - refresh - --- | changeWidth. Change the width of the main window in tiling mode. -changeWidth :: Rational -> X () -changeWidth delta = do - modify (\s -> s {leftWidth = leftWidth s + delta}) - refresh - --- | windows. Modify the current window list with a pure function, and refresh -windows :: (WorkSpace -> WorkSpace) -> X () -windows f = do - modify $ \s -> s { workspace = f (workspace s) } - refresh - ws <- gets workspace - trace (show ws) -- log state changes to stderr - --- | hide. Hide a window by moving it offscreen. -hide :: Window -> X () -hide w = withDisplay $ \d -> do - (sw,sh) <- gets dimensions - io $ moveWindow d w (2*fromIntegral sw) (2*fromIntegral sh) - --- --------------------------------------------------------------------- --- Window operations - --- | manage. Add a new window to be managed in the current workspace. Bring it into focus. --- If the window is already under management, it is just raised. --- --- When we start to manage a window, it gains focus. --- -manage :: Window -> X () -manage w = do - withDisplay $ \d -> io $ do - selectInput d w $ structureNotifyMask .|. enterWindowMask .|. propertyChangeMask - mapWindow d w - setFocus w - windows $ W.push w - --- | unmanage. A window no longer exists, remove it from the window --- list, on whatever workspace it is. -unmanage :: Window -> X () -unmanage w = do - windows $ W.delete w - withServerX $ do - setTopFocus - withDisplay $ \d -> io (sync d False) - -- TODO, everything operates on the current display, so wrap it up. - --- | Grab the X server (lock it) from the X monad -withServerX :: X () -> X () -withServerX f = withDisplay $ \dpy -> do - io $ grabServer dpy - f - io $ ungrabServer dpy - --- | Explicitly set the keyboard focus to the given window -setFocus :: Window -> X () -setFocus w = withDisplay $ \d -> io $ setInputFocus d w revertToPointerRoot 0 - --- | Set the focus to the window on top of the stack, or root -setTopFocus :: X () -setTopFocus = do - ws <- gets workspace - case W.peek ws of - Just new -> setFocus new - Nothing -> gets theRoot >>= setFocus - --- | raise. focus to window at offset 'n' in list. --- The currently focused window is always the head of the list -raise :: Ordering -> X () -raise = windows . W.rotate - --- | promote. Make the focused window the master window in its workspace -promote :: X () -promote = windows (\w -> maybe w (\k -> W.promote k w) (W.peek w)) - --- | Kill the currently focused client -kill :: X () -kill = withDisplay $ \d -> do - ws <- gets workspace - whenJust (W.peek ws) $ \w -> do - protocols <- io $ getWMProtocols d w - wmdelt <- gets wmdelete - wmprot <- gets wmprotocols - if wmdelt `elem` protocols - then io $ allocaXEvent $ \ev -> do - setEventType ev clientMessage - setClientMessageEvent ev w wmprot 32 wmdelt 0 - sendEvent d w False noEventMask ev - else io (killClient d w) >> return () - --- | tag. Move a window to a new workspace -tag :: Int -> X () -tag o = do - ws <- gets workspace - let m = W.current ws - when (n /= m) $ - whenJust (W.peek ws) $ \w -> do - hide w - windows $ W.shift n - where n = o-1 - --- | view. Change the current workspace to workspce at offset 'n-1'. -view :: Int -> X () -view o = do - ws <- gets workspace - ws2sc <- gets wsOnScreen - let m = W.current ws - -- is the workspace we want to switch to currently visible? - if M.member n ws2sc - then windows $ W.view n - else do - sc <- case M.lookup m ws2sc of - Nothing -> do - trace "Current workspace isn't visible! This should never happen!" - -- we don't know what screen to use, just use the first one. - return 0 - Just sc -> return sc - modify $ \s -> s { wsOnScreen = M.insert n sc (M.filter (/=sc) ws2sc) } - gets wsOnScreen >>= trace . show - windows $ W.view n - mapM_ hide (W.index m ws) - setTopFocus - where n = o-1 - --- | True if window is under management by us -isClient :: Window -> X Bool -isClient w = liftM (W.member w) (gets workspace) - --- | screenWS. Returns the workspace currently visible on screen n -screenWS :: Int -> X Int -screenWS n = do - ws2sc <- gets wsOnScreen - -- FIXME: It's ugly to have to query this way. We need a different way to - -- keep track of screen <-> workspace mappings. - let ws = fmap fst $ find (\(_, scn) -> scn == (n-1)) (M.assocs ws2sc) - return $ (fromMaybe 0 ws) + 1 -- cgit v1.2.3