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 --- Config.lhs | 101 +++++++++++++++++++++++ Main.hs | 256 +--------------------------------------------------------- Operations.hs | 205 ++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 310 insertions(+), 252 deletions(-) create mode 100644 Config.lhs create mode 100644 Operations.hs diff --git a/Config.lhs b/Config.lhs new file mode 100644 index 0000000..95cf8df --- /dev/null +++ b/Config.lhs @@ -0,0 +1,101 @@ +> module Config where + +xmonad places each window into a "workspace." Each workspace can have any +number of windows, which you can cycle though with mod-j and mod-k. Windows are +either displayed full screen, or tiled. You can toggle the layout mode with +mod-space. + +You can switch to workspace N with mod-N. For example, to switch to workspace +5, you would press mod-5. Similarly, you can move the current window to another +workspace with mod-shift-N. + +When running with multiple monitors (Xinerama), each screen has exactly 1 +workspace visible. When xmonad starts, workspace 1 is on screen 1, workspace 2 +is on screen 2, etc. If you switch to a workspace which is currently visible on +another screen, xmonad simply switches focus to that screen. If you switch to a +workspace which is *not* visible, xmonad replaces the workspace on the +*current* screen with the workspace you selected. + +For example, if you have the following configuration: + +Screen 1: Workspace 2 +Screen 2: Workspace 5 (current workspace) + +and you wanted to view workspace 7 on screen 1, you would press: + +mod-2 (to select workspace 2, and make screen 1 the current screen) +mod-7 (to select workspace 7) + +Since switching to the workspace currently visible on a given screen is such a +common operation, shortcuts are provided: mod-{w,e,r} switch to the workspace +currently visible on screens 1, 2, and 3 respectively. Likewise, +shift-mod-{w,e,r} moves the current window to the workspace on that screen. +Using these keys, the above example would become mod-w mod-7. + +Some imports we need: + +> import Data.Ratio +> import Data.Bits +> import qualified Data.Map as M +> import System.Exit +> import Graphics.X11.Xlib +> import XMonad +> import Operations + +The number of workspaces: + +> workspaces :: Int +> workspaces = 9 + +modMask lets you easily change which modkey you use. The default is mod1Mask. +("alt") + +> modMask :: KeyMask +> modMask = mod1Mask + +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 + +The keys list. + +> keys :: M.Map (KeyMask, KeySym) (X ()) +> keys = M.fromList $ +> [ ((modMask .|. shiftMask, xK_Return), spawn "xterm") +> , ((modMask, xK_p ), spawn "exe=`emenu_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) +> ] ++ + +Keybindings to each workspace: + +> [((m .|. modMask, xK_0 + fromIntegral i), f i) +> | i <- [1 .. workspaces] +> , (f, m) <- [(view, 0), (tag, shiftMask)]] + +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)]] 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 diff --git a/Operations.hs b/Operations.hs new file mode 100644 index 0000000..393c25b --- /dev/null +++ b/Operations.hs @@ -0,0 +1,205 @@ +module Operations where + +import Data.List +import Data.Maybe +import Data.Bits +import qualified Data.Map as M + +import Control.Monad.State + +import System.Posix.Process +import System.Environment + +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +import XMonad + +import qualified StackSet as W + +-- --------------------------------------------------------------------- +-- 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 + +-- | 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 -- cgit v1.2.3