xmonad 0.4.1 → 0.5
raw patch · 23 files changed
+2832/−2078 lines, 23 filesdep +containersdep +directorydep +processdep ~X11dep ~basedep ~mtl
Dependencies added: containers, directory, process
Dependency ranges changed: X11, base, mtl, unix
Files
- CONFIG +82/−0
- Config.hs +0/−259
- Config.hs-boot +0/−10
- Main.hs +26/−239
- Operations.hs +0/−656
- README +98/−52
- STYLE +21/−0
- StackSet.hs +0/−565
- TODO +10/−5
- XMonad.hs +36/−265
- XMonad/Config.hs +252/−0
- XMonad/Core.hs +370/−0
- XMonad/Layout.hs +175/−0
- XMonad/Main.hs +279/−0
- XMonad/ManageHook.hs +78/−0
- XMonad/Operations.hs +504/−0
- XMonad/StackSet.hs +574/−0
- man/xmonad.1 +1/−1
- man/xmonad.hs +276/−0
- man/xmonad.html +4/−4
- tests/Properties.hs +7/−8
- util/GenerateManpage.hs +1/−1
- xmonad.cabal +38/−13
+ CONFIG view
@@ -0,0 +1,82 @@+== Configuring xmonad ==++xmonad is configured by creating and editing the file:++ ~/.xmonad/xmonad.hs++xmonad then uses settings from this file as arguments to the window manager,+on startup. For a complete example of possible settings, see the file:++ man/xmonad.hs++Further examples are on the website, wiki and extension documentation.++ http://haskell.org/haskellwiki/Xmonad++== A simple example ==++Here is a basic example, which overrides the default border width,+default terminal, and some colours. This text goes in the file+$HOME/.xmonad/xmonad.hs :++ import XMonad++ main = xmonad $ defaultConfig+ { borderWidth = 2+ , terminal = "urxvt"+ , normalBorderColor = "#cccccc"+ , focusedBorderColor = "#cd8b00" }++You can find the defaults in the file:++ XMonad/Config.hs++== Checking your xmonad.hs is correct ==++Place this text in ~/.xmonad/xmonad.hs, and then check that it is+syntactically and type correct by loading it in the Haskell+interpreter:++ $ ghci ~/.xmonad/xmonad.hs+ GHCi, version 6.8.1: http://www.haskell.org/ghc/ :? for help+ Loading package base ... linking ... done.+ Ok, modules loaded: Main.++ Prelude Main> :t main+ main :: IO ()++Ok, looks good.++== Loading your configuration ==++To have xmonad start using your settings, type 'mod-q'. xmonad will+then load this new file, and run it. If it is unable to, the defaults+are used. ++To load succesfully, both 'xmonad' and 'ghc' must be in your $PATH+environment variable. If GHC isn't in your path, for some reason, you+can compile the xmonad.hs file yourself:++ $ cd ~/.xmonad+ $ ghc --make xmonad.hs+ $ ls+ xmonad xmonad.hi xmonad.hs xmonad.o++When you hit mod-q, this newly compiled xmonad will be used.++== Where are the defaults? ==++The default configuration values are defined in the source file:++ XMonad/Config.hs++the XConfig data structure itself is defined in:++ XMonad/Core.hs++== Extensions ==++Since the xmonad.hs file is just another Haskell module, you may import+and use any Haskell code or libraries you wish. For example, you can use+things from the xmonad-contrib library, or other code you write+yourself.
− Config.hs
@@ -1,259 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Config.hs--- Copyright : (c) Spencer Janssen 2007--- License : BSD3-style (see LICENSE)------ Maintainer : dons@galois.com--- Stability : stable--- Portability : portable------ This module specifies configurable defaults for xmonad. If you change--- values here, be sure to recompile and restart (mod-q) xmonad,--- for the changes to take effect.------------------------------------------------------------------------------module Config where------- Useful imports----import XMonad-import Operations-import qualified StackSet as W-import Data.Ratio-import Data.Bits ((.|.))-import qualified Data.Map as M-import System.Exit-import Graphics.X11.Xlib---- % Extension-provided imports---- | The default number of workspaces (virtual screens) and their names.--- By default we use numeric strings, but any string may be used as a--- workspace name. The number of workspaces is determined by the length--- of this list.------ A tagging example:------ > workspaces = ["web", "irc", "code" ] ++ map show [4..9]----workspaces :: [WorkspaceId]-workspaces = map show [1 .. 9 :: Int]---- | modMask lets you specify which modkey you want to use. The default--- is mod1Mask ("left alt"). You may also consider using mod3Mask--- ("right alt"), which does not conflict with emacs keybindings. The--- "windows key" is usually mod4Mask.----modMask :: KeyMask-modMask = mod1Mask---- | The mask for the numlock key. Numlock status is "masked" from the--- current modifier status, so the keybindings will work with numlock on or--- off. You may need to change this on some systems.------ You can find the numlock modifier by running "xmodmap" and looking for a--- modifier with Num_Lock bound to it:------ > $ xmodmap | grep Num--- > mod2 Num_Lock (0x4d)------ Set numlockMask = 0 if you don't have a numlock key, or want to treat--- numlock status separately.----numlockMask :: KeyMask-numlockMask = mod2Mask---- | Width of the window border in pixels.----borderWidth :: Dimension-borderWidth = 1---- | Border colors for unfocused and focused windows, respectively.----normalBorderColor, focusedBorderColor :: String-normalBorderColor = "#dddddd"-focusedBorderColor = "#ff0000"---- | Default offset of drawable screen boundaries from each physical--- screen. Anything non-zero here will leave a gap of that many pixels--- on the given edge, on the that screen. A useful gap at top of screen--- for a menu bar (e.g. 15)------ An example, to set a top gap on monitor 1, and a gap on the bottom of--- monitor 2, you'd use a list of geometries like so:------ > defaultGaps = [(18,0,0,0),(0,18,0,0)] -- 2 gaps on 2 monitors------ Fields are: top, bottom, left, right.----defaultGaps :: [(Int,Int,Int,Int)]-defaultGaps = [(0,0,0,0)] -- 15 for default dzen font----------------------------------------------------------------------------- Window rules---- | Execute arbitrary actions and WindowSet manipulations when managing--- a new window. You can use this to, for example, always float a--- particular program, or have a client always appear on a particular--- workspace.----manageHook :: Window -- ^ the new window to manage- -> String -- ^ window title- -> String -- ^ window resource name- -> String -- ^ window resource class- -> X (WindowSet -> WindowSet)---- Always float various programs:-manageHook w _ _ c | c `elem` floats = fmap (W.float w . snd) (floatLocation w)- where floats = ["MPlayer", "Gimp"]---- Desktop panels and dock apps should be ignored by xmonad:-manageHook w _ n _ | n `elem` ignore = reveal w >> return (W.delete w)- where ignore = ["gnome-panel", "desktop_window", "kicker", "kdesktop"]---- Automatically send Firefox windows to the "web" workspace:--- If a workspace named "web" doesn't exist, the window will appear on the--- current workspace.-manageHook _ _ "Gecko" _ = return $ W.shift "web"---- The default rule: return the WindowSet unmodified. You typically do not--- want to modify this line.-manageHook _ _ _ _ = return id----------------------------------------------------------------------------- Extensible layouts---- | The list of possible layouts. Add your custom layouts to this list.-layouts :: [Layout Window]-layouts = [ Layout tiled- , Layout $ Mirror tiled- , Layout Full- -- Add extra layouts you want to use here:- -- % Extension-provided layouts- ]- where- -- default tiling algorithm partitions the screen into two panes- tiled = Tall nmaster delta ratio-- -- The default number of windows in the master pane- nmaster = 1-- -- Default proportion of screen occupied by master pane- ratio = 1%2-- -- Percent of screen to increment by when resizing panes- delta = 3%100---- | The top level layout switcher. Most users will not need to modify this binding.------ By default, we simply switch between the layouts listed in `layouts'--- above, but you may program your own selection behaviour here. Layout--- transformers, for example, would be hooked in here.----layoutHook :: Layout Window-layoutHook = Layout $ Select layouts---- | Register with xmonad a list of layouts whose state we can preserve over restarts.--- There is typically no need to modify this list, the defaults are fine.----serialisedLayouts :: [Layout Window]-serialisedLayouts = layoutHook : layouts----------------------------------------------------------------------------- Logging---- | Perform an arbitrary action on each internal state change or X event.--- Examples include:--- * do nothing--- * log the state to stdout------ See the 'DynamicLog' extension for examples.----logHook :: X ()-logHook = return ()----------------------------------------------------------------------------- Key bindings:---- | The xmonad key bindings. Add, modify or remove key bindings here.------ (The comment formatting character is used when generating the manpage)----keys :: M.Map (KeyMask, KeySym) (X ())-keys = M.fromList $- -- launching and killing programs- [ ((modMask .|. shiftMask, xK_Return), spawn "xterm") -- %! Launch an xterm- , ((modMask, xK_p ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu- , ((modMask .|. shiftMask, xK_p ), spawn "gmrun") -- %! Launch gmrun- , ((modMask .|. shiftMask, xK_c ), kill) -- %! Close the focused window-- , ((modMask, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms- , ((modMask .|. shiftMask, xK_space ), setLayout layoutHook) -- %! Reset the layouts on the current workspace to default-- , ((modMask, xK_n ), refresh) -- %! Resize viewed windows to the correct size-- -- move focus up or down the window stack- , ((modMask, xK_Tab ), windows W.focusDown) -- %! Move focus to the next window- , ((modMask, xK_j ), windows W.focusDown) -- %! Move focus to the next window- , ((modMask, xK_k ), windows W.focusUp ) -- %! Move focus to the previous window- , ((modMask, xK_m ), windows W.focusMaster ) -- %! Move focus to the master window-- -- modifying the window order- , ((modMask, xK_Return), windows W.swapMaster) -- %! Swap the focused window and the master window- , ((modMask .|. shiftMask, xK_j ), windows W.swapDown ) -- %! Swap the focused window with the next window- , ((modMask .|. shiftMask, xK_k ), windows W.swapUp ) -- %! Swap the focused window with the previous window-- -- resizing the master/slave ratio- , ((modMask, xK_h ), sendMessage Shrink) -- %! Shrink the master area- , ((modMask, xK_l ), sendMessage Expand) -- %! Expand the master area-- -- floating layer support- , ((modMask, xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling-- -- increase or decrease number of windows in the master area- , ((modMask , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area- , ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area-- -- toggle the status bar gap- , ((modMask , xK_b ), modifyGap (\i n -> let x = (defaultGaps ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap-- -- quit, or restart- , ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit xmonad- , ((modMask , xK_q ), broadcastMessage ReleaseResources >> restart Nothing True) -- %! Restart xmonad-- -- % Extension-provided key bindings- ]- ++- -- mod-[1..9] %! Switch to workspace N- -- mod-shift-[1..9] %! Move client to workspace N- [((m .|. modMask, k), windows $ f i)- | (i, k) <- zip workspaces [xK_1 .. xK_9]- , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]- ++- -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3- -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3- [((m .|. modMask, key), screenWorkspace sc >>= flip whenJust (windows . f))- | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]- , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]-- -- % Extension-provided key bindings lists---- | Mouse bindings: default actions bound to mouse events----mouseBindings :: M.Map (KeyMask, Button) (Window -> X ())-mouseBindings = M.fromList $- -- mod-button1 %! Set the window to floating mode and move by dragging- [ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w))- -- mod-button2 %! Raise the window to the top of the stack- , ((modMask, button2), (\w -> focus w >> windows W.swapMaster))- -- mod-button3 %! Set the window to floating mode and resize by dragging- , ((modMask, button3), (\w -> focus w >> mouseResizeWindow w))- -- you may also bind events to the mouse scroll wheel (button4 and button5)-- -- % Extension-provided mouse bindings- ]---- % Extension-provided definitions
− Config.hs-boot
@@ -1,10 +0,0 @@-module Config where-import Graphics.X11.Xlib.Types (Dimension)-import Graphics.X11.Xlib (KeyMask,Window)-import XMonad-borderWidth :: Dimension-numlockMask :: KeyMask-workspaces :: [WorkspaceId]-logHook :: X ()-manageHook :: Window -> String -> String -> String -> X (WindowSet -> WindowSet)-serialisedLayouts :: [Layout Window]
Main.hs view
@@ -12,251 +12,38 @@ -- ----------------------------------------------------------------------------- -module Main where--import Data.Bits-import qualified Data.Map as M-import qualified Data.Set as S-import Control.Monad.Reader-import Control.Monad.State-import Data.Maybe (fromMaybe)--import System.Environment (getArgs)--import Graphics.X11.Xlib hiding (refreshKeyboardMapping)-import Graphics.X11.Xlib.Extras-import Graphics.X11.Xinerama (getScreenInfo)+module Main (main) where -import XMonad-import Config-import StackSet (new, floating, member)-import qualified StackSet as W-import Operations+import XMonad.Main+import XMonad.Config+import XMonad.Core (getXMonadDir, recompile) +import Control.Exception (handle) import System.IO+import System.Environment+import System.Posix.Process (executeFile) --- |--- The main entry point---+-- | The entry point into xmonad. Attempts to compile any custom main+-- for xmonad, and if it doesn't find one, just launches the default. main :: IO () main = do- dpy <- openDisplay ""- let dflt = defaultScreen dpy+ handle (hPrint stderr) buildLaunch+ xmonad defaultConfig -- if buildLaunch returns, execute the trusted core - rootw <- rootWindow dpy dflt- xinesc <- getScreenInfo dpy- nbc <- initColor dpy normalBorderColor- fbc <- initColor dpy focusedBorderColor- hSetBuffering stdout NoBuffering+-- | Build "~/.xmonad/xmonad.hs" with ghc, then execute it. If there are no+-- errors, this function does not return. An exception is raised in any of+-- these cases:+-- * ghc missing+-- * ~/.xmonad/xmonad.hs missing+-- * xmonad.hs fails to compile+-- ** wrong ghc in path (fails to compile)+-- ** type error, syntax error, ..+-- * Missing xmonad/XMonadContrib modules due to ghc upgrade+--+buildLaunch :: IO ()+buildLaunch = do+ recompile False+ dir <- getXMonadDir args <- getArgs-- let initialWinset = new layoutHook workspaces $ zipWith SD xinesc gaps-- maybeRead s = case reads s of- [(x, "")] -> Just x- _ -> Nothing-- winset = fromMaybe initialWinset $ do- ("--resume" : s : _) <- return args- ws <- maybeRead s- return . W.ensureTags layoutHook workspaces- $ W.mapLayout (fromMaybe layoutHook . maybeRead) ws-- gaps = take (length xinesc) $ defaultGaps ++ repeat (0,0,0,0)-- cf = XConf- { display = dpy- , theRoot = rootw- , normalBorder = nbc- , focusedBorder = fbc }- st = XState- { windowset = initialWinset- , mapped = S.empty- , waitingUnmap = M.empty- , dragging = Nothing }-- xSetErrorHandler -- in C, I'm too lazy to write the binding: dons-- -- setup initial X environment- sync dpy False- selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask- .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask-- allocaXEvent $ \e ->- runX cf st $ do-- grabKeys- grabButtons-- io $ sync dpy False-- -- bootstrap the windowset, Operations.windows will identify all- -- the windows in winset as new and set initial properties for- -- those windows- windows (const winset)-- -- scan for all top-level windows, add the unmanaged ones to the- -- windowset- ws <- io $ scan dpy rootw- mapM_ manage ws-- -- main loop, for all you HOF/recursion fans out there.- forever_ $ handle =<< io (nextEvent dpy e >> getEvent e)-+ executeFile (dir ++ "/xmonad") False args Nothing return ()- where forever_ a = a >> forever_ a---- ------------------------------------------------------------------------ IO stuff. Doesn't require any X state--- Most of these things run only on startup (bar grabkeys)---- | scan for any new windows to manage. If they're already managed,--- this should be idempotent.-scan :: Display -> Window -> IO [Window]-scan dpy rootw = do- (_, _, ws) <- queryTree dpy rootw- filterM ok ws- -- TODO: scan for windows that are either 'IsViewable' or where WM_STATE ==- -- Iconic- where ok w = do wa <- getWindowAttributes dpy w- a <- internAtom dpy "WM_STATE" False- p <- getWindowProperty32 dpy a w- let ic = case p of- Just (3:_) -> True -- 3 for iconified- _ -> False- return $ not (wa_override_redirect wa)- && (wa_map_state wa == waIsViewable || ic)---- | Grab the keys back-grabKeys :: X ()-grabKeys = do- XConf { display = dpy, theRoot = rootw } <- ask- let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync- io $ ungrabKey dpy anyKey anyModifier rootw- forM_ (M.keys keys) $ \(mask,sym) -> do- kc <- io $ keysymToKeycode dpy sym- -- "If the specified KeySym is not defined for any KeyCode,- -- XKeysymToKeycode() returns zero."- when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) extraModifiers---- | XXX comment me-grabButtons :: X ()-grabButtons = do- XConf { display = dpy, theRoot = rootw } <- ask- let grab button mask = io $ grabButton dpy button mask rootw False buttonPressMask- grabModeAsync grabModeSync none none- io $ ungrabButton dpy anyButton anyModifier rootw- mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) extraModifiers) (M.keys mouseBindings)---- ------------------------------------------------------------------------ | Event handler. Map X events onto calls into Operations.hs, which--- modify our internal model of the window manager state.------ Events dwm handles that we don't:------ [ButtonPress] = buttonpress,--- [Expose] = expose,--- [PropertyNotify] = propertynotify,-----handle :: Event -> X ()---- run window manager command-handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})- | t == keyPress = withDisplay $ \dpy -> do- s <- io $ keycodeToKeysym dpy code 0- userCode $ whenJust (M.lookup (cleanMask m,s) keys) id---- manage a new window-handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do- wa <- io $ getWindowAttributes dpy w -- ignore override windows- -- need to ignore mapping requests by managed windows not on the current workspace- managed <- isClient w- when (not (wa_override_redirect wa) && not managed) $ do manage w---- window destroyed, unmanage it--- window gone, unmanage it-handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ unmanage w---- We track expected unmap events in waitingUnmap. We ignore this event unless--- it is synthetic or we are not expecting an unmap notification from a window.-handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do- e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)- if (synthetic || e == 0)- then unmanage w- else modify (\s -> s { waitingUnmap = M.adjust pred w (waitingUnmap s) })---- set keyboard mapping-handle e@(MappingNotifyEvent {}) = do- io $ refreshKeyboardMapping e- when (ev_request e == mappingKeyboard) grabKeys---- handle button release, which may finish dragging.-handle e@(ButtonEvent {ev_event_type = t})- | t == buttonRelease = do- drag <- gets dragging- case drag of- -- we're done dragging and have released the mouse:- Just (_,f) -> modify (\s -> s { dragging = Nothing }) >> f- Nothing -> broadcastMessage e---- handle motionNotify event, which may mean we are dragging.-handle e@(MotionEvent {ev_event_type = _t, ev_x = x, ev_y = y}) = do- drag <- gets dragging- case drag of- Just (d,_) -> d (fromIntegral x) (fromIntegral y) -- we're dragging- Nothing -> broadcastMessage e---- click on an unfocused window, makes it focused on this workspace-handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })- | t == buttonPress = do- -- If it's the root window, then it's something we- -- grabbed in grabButtons. Otherwise, it's click-to-focus.- isr <- isRoot w- if isr then userCode $ whenJust (M.lookup (cleanMask (ev_state e), b) mouseBindings) ($ ev_subwindow e)- else focus w- sendMessage e -- Always send button events.---- entered a normal window, makes this focused.-handle e@(CrossingEvent {ev_window = w, ev_event_type = t})- | t == enterNotify && ev_mode e == notifyNormal- && ev_detail e /= notifyInferior = focus w---- left a window, check if we need to focus root-handle e@(CrossingEvent {ev_event_type = t})- | t == leaveNotify- = do rootw <- asks theRoot- when (ev_window e == rootw && not (ev_same_screen e)) $ setFocusX rootw---- configure a window-handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do- ws <- gets windowset- wa <- io $ getWindowAttributes dpy w-- if M.member w (floating ws)- || not (member w ws)- then do io $ configureWindow dpy w (ev_value_mask e) $ WindowChanges- { wc_x = ev_x e- , wc_y = ev_y e- , wc_width = ev_width e- , wc_height = ev_height e- , wc_border_width = fromIntegral borderWidth- , wc_sibling = ev_above e- , wc_stack_mode = ev_detail e }- when (member w ws) (float w)- else io $ allocaXEvent $ \ev -> do- setEventType ev configureNotify- setConfigureEvent ev w w- (wa_x wa) (wa_y wa) (wa_width wa)- (wa_height wa) (ev_border_width e) none (wa_override_redirect wa)- sendEvent dpy w False 0 ev- io $ sync dpy False---- configuration changes in the root may mean display settings have changed-handle (ConfigureEvent {ev_window = w}) = whenX (isRoot w) rescreen---- property notify-handle PropertyEvent { ev_event_type = t, ev_atom = a }- | t == propertyNotify && a == wM_NAME = userCode logHook--handle e = broadcastMessage e -- trace (eventName e) -- ignoring
− Operations.hs
@@ -1,656 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}---- ----------------------------------------------------------------------------- |--- Module : Operations.hs--- Copyright : (c) Spencer Janssen 2007--- License : BSD3-style (see LICENSE)------ Maintainer : dons@cse.unsw.edu.au--- Stability : unstable--- Portability : not portable, Typeable deriving, mtl, posix------ Operations.-----------------------------------------------------------------------------------module Operations where--import XMonad-import qualified StackSet as W-import {-# SOURCE #-} Config (borderWidth,logHook,manageHook,numlockMask,serialisedLayouts)--import Data.Maybe-import Data.List (nub, (\\), find, partition)-import Data.Bits ((.|.), (.&.), complement)-import Data.Ratio-import qualified Data.Map as M-import qualified Data.Set as S--import Control.Monad.State-import Control.Monad.Reader-import Control.Arrow ((***), second)--import System.IO-import Graphics.X11.Xlib-import Graphics.X11.Xinerama (getScreenInfo)-import Graphics.X11.Xlib.Extras---- ------------------------------------------------------------------------ |--- Window manager operations--- manage. Add a new window to be managed in the current workspace.--- Bring it into focus.------ Whether the window is already managed, or not, it is mapped, has its--- border set, and its event mask set.----manage :: Window -> X ()-manage w = whenX (fmap not $ isClient w) $ withDisplay $ \d -> do- sh <- io $ getWMNormalHints d w-- let isFixedSize = sh_min_size sh /= Nothing && sh_min_size sh == sh_max_size sh- isTransient <- isJust `liftM` io (getTransientForHint d w)-- (sc, rr) <- floatLocation w- -- ensure that float windows don't go over the edge of the screen- let adjust (W.RationalRect x y wid h) | x + wid > 1 || y + h > 1 || x < 0 || y < 0- = W.RationalRect (0.5 - wid/2) (0.5 - h/2) wid h- adjust r = r-- f ws | isFixedSize || isTransient = W.float w (adjust rr) . W.insertUp w . W.view i $ ws- | otherwise = W.insertUp w ws- where i = fromMaybe (W.tag . W.workspace . W.current $ ws) $ W.lookupWorkspace sc ws-- n <- fmap (fromMaybe "") $ io $ fetchName d w- (ClassHint rn rc) <- io $ getClassHint d w- g <- manageHook w n rn rc `catchX` return id- windows (g . f)---- | unmanage. A window no longer exists, remove it from the window--- list, on whatever workspace it is.------ should also unmap?----unmanage :: Window -> X ()-unmanage w = do- windows (W.delete w)- setWMState w 0 {-withdrawn-}- modify (\s -> s {mapped = S.delete w (mapped s), waitingUnmap = M.delete w (waitingUnmap s)})---- | Modify the size of the status gap at the top of the current screen--- Taking a function giving the current screen, and current geometry.-modifyGap :: (Int -> (Int,Int,Int,Int) -> (Int,Int,Int,Int)) -> X ()-modifyGap f = do- windows $ \ws@(W.StackSet { W.current = c@(W.Screen { W.screenDetail = sd }) }) ->- let n = fromIntegral . W.screen $ c- g = f n . statusGap $ sd- in ws { W.current = c { W.screenDetail = sd { statusGap = g } } }---- | Kill the currently focused client. If we do kill it, we'll get a--- delete notify back from X.------ There are two ways to delete a window. Either just kill it, or if it--- supports the delete protocol, send a delete event (e.g. firefox)----kill :: X ()-kill = withDisplay $ \d -> withFocused $ \w -> do- wmdelt <- atom_WM_DELETE_WINDOW ; wmprot <- atom_WM_PROTOCOLS-- protocols <- io $ getWMProtocols d w- io $ if wmdelt `elem` protocols- then allocaXEvent $ \ev -> do- setEventType ev clientMessage- setClientMessageEvent ev w wmprot 32 wmdelt 0- sendEvent d w False noEventMask ev- else killClient d w >> return ()---- ------------------------------------------------------------------------ Managing windows--data LayoutMessages = Hide | ReleaseResources deriving ( Typeable, Eq )--instance Message LayoutMessages---- | windows. Modify the current window list with a pure function, and refresh-windows :: (WindowSet -> WindowSet) -> X ()-windows f = do- XState { windowset = old } <- get- let oldvisible = concatMap (W.integrate' . W.stack . W.workspace) $ W.current old : W.visible old- ws = f old- XConf { display = d , normalBorder = nbc, focusedBorder = fbc } <- ask- mapM_ setInitialProperties (W.allWindows ws \\ W.allWindows old)- whenJust (W.peek old) $ \otherw -> io $ setWindowBorder d otherw nbc- modify (\s -> s { windowset = ws })-- -- notify non visibility- let tags_oldvisible = map (W.tag . W.workspace) $ W.current old : W.visible old- gottenhidden = filter (`elem` tags_oldvisible) $ map W.tag $ W.hidden ws- sendMessageToWorkspaces Hide gottenhidden-- -- for each workspace, layout the currently visible workspaces- let allscreens = W.screens ws- summed_visible = scanl (++) [] $ map (W.integrate' . W.stack . W.workspace) allscreens- visible <- fmap concat $ forM (zip allscreens summed_visible) $ \ (w, vis) -> do- let n = W.tag (W.workspace w)- this = W.view n ws- l = W.layout (W.workspace w)- flt = filter (flip M.member (W.floating ws)) (W.index this)- tiled = (W.stack . W.workspace . W.current $ this)- >>= W.filter (not . flip M.member (W.floating ws))- >>= W.filter (not . (`elem` vis))- (SD (Rectangle sx sy sw sh)- (gt,gb,gl,gr)) = W.screenDetail w- viewrect = Rectangle (sx + fromIntegral gl) (sy + fromIntegral gt)- (sw - fromIntegral (gl + gr)) (sh - fromIntegral (gt + gb))-- -- just the tiled windows:- -- now tile the windows on this workspace, modified by the gap- (rs, ml') <- runLayout l viewrect tiled `catchX` runLayout (Layout Full) viewrect tiled- mapM_ (uncurry tileWindow) rs- whenJust ml' $ \l' -> runOnWorkspaces (\ww -> if W.tag ww == n- then return $ ww { W.layout = l'}- else return ww)-- -- now the floating windows:- -- move/resize the floating windows, if there are any- forM_ flt $ \fw -> whenJust (M.lookup fw (W.floating ws)) $- \(W.RationalRect rx ry rw rh) -> do- tileWindow fw $ Rectangle- (sx + floor (toRational sw*rx)) (sy + floor (toRational sh*ry))- (floor (toRational sw*rw)) (floor (toRational sh*rh))-- let vs = flt ++ map fst rs- io $ restackWindows d vs- -- return the visible windows for this workspace:- return vs-- whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc- setTopFocus- userCode logHook- -- io performGC -- really helps, but seems to trigger GC bugs?-- -- hide every window that was potentially visible before, but is not- -- given a position by a layout now.- mapM_ hide (nub oldvisible \\ visible)-- clearEvents enterWindowMask---- | setWMState. set the WM_STATE property-setWMState :: Window -> Int -> X ()-setWMState w v = withDisplay $ \dpy -> do- a <- atom_WM_STATE- io $ changeProperty32 dpy w a a propModeReplace [fromIntegral v, fromIntegral none]---- | hide. Hide a window by unmapping it, and setting Iconified.-hide :: Window -> X ()-hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do- io $ do selectInput d w (clientMask .&. complement structureNotifyMask)- unmapWindow d w- selectInput d w clientMask- setWMState w 3 --iconic- -- this part is key: we increment the waitingUnmap counter to distinguish- -- between client and xmonad initiated unmaps.- modify (\s -> s { waitingUnmap = M.insertWith (+) w 1 (waitingUnmap s)- , mapped = S.delete w (mapped s) })---- | reveal. Show a window by mapping it and setting Normal--- this is harmless if the window was already visible-reveal :: Window -> X ()-reveal w = withDisplay $ \d -> do- setWMState w 1 --normal- io $ mapWindow d w- modify (\s -> s { mapped = S.insert w (mapped s) })---- | The client events that xmonad is interested in-clientMask :: EventMask-clientMask = structureNotifyMask .|. enterWindowMask .|. propertyChangeMask---- | Set some properties when we initially gain control of a window-setInitialProperties :: Window -> X ()-setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> io $ do- selectInput d w $ clientMask- setWindowBorderWidth d w borderWidth- -- we must initially set the color of new windows, to maintain invariants- -- required by the border setting in 'windows'- setWindowBorder d w nb---- | refresh. Render the currently visible workspaces, as determined by--- the StackSet. Also, set focus to the focused window.------ This is our 'view' operation (MVC), in that it pretty prints our model--- with X calls.----refresh :: X ()-refresh = windows id---- | clearEvents. Remove all events of a given type from the event queue.-clearEvents :: EventMask -> X ()-clearEvents mask = withDisplay $ \d -> io $ do- sync d False- allocaXEvent $ \p -> fix $ \again -> do- more <- checkMaskEvent d mask p- when more again -- beautiful---- | tileWindow. Moves and resizes w such that it fits inside the given--- rectangle, including its border.-tileWindow :: Window -> Rectangle -> X ()-tileWindow w r = withDisplay $ \d -> do- bw <- (fromIntegral . wa_border_width) `liftM` io (getWindowAttributes d w)- -- give all windows at least 1x1 pixels- let least x | x <= bw*2 = 1- | otherwise = x - bw*2- io $ moveResizeWindow d w (rect_x r) (rect_y r)- (least $ rect_width r) (least $ rect_height r)- reveal w---- ------------------------------------------------------------------------- | rescreen. The screen configuration may have changed (due to--- xrandr), update the state and refresh the screen, and reset the gap.-rescreen :: X ()-rescreen = do- xinesc <- withDisplay (io . getScreenInfo)-- windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->- let (xs, ys) = splitAt (length xinesc) $ map W.workspace (v:vs) ++ hs- (a:as) = zipWith3 W.Screen xs [0..] $ zipWith SD xinesc gs- sgs = map (statusGap . W.screenDetail) (v:vs)- gs = take (length xinesc) (sgs ++ repeat (0,0,0,0))- in ws { W.current = a- , W.visible = as- , W.hidden = ys }---- ------------------------------------------------------------------------- | setButtonGrab. Tell whether or not to intercept clicks on a given window-setButtonGrab :: Bool -> Window -> X ()-setButtonGrab grab w = withDisplay $ \d -> io $- if grab- then forM_ [button1, button2, button3] $ \b ->- grabButton d b anyModifier w False buttonPressMask- grabModeAsync grabModeSync none none- else ungrabButton d anyButton anyModifier w---- ------------------------------------------------------------------------ Setting keyboard focus---- | Set the focus to the window on top of the stack, or root-setTopFocus :: X ()-setTopFocus = withWindowSet $ maybe (setFocusX =<< asks theRoot) setFocusX . W.peek---- | Set focus explicitly to window 'w' if it is managed by us, or root.--- This happens if X notices we've moved the mouse (and perhaps moved--- the mouse to a new screen).-focus :: Window -> X ()-focus w = withWindowSet $ \s -> do- if W.member w s then when (W.peek s /= Just w) $ windows (W.focusWindow w)- else whenX (isRoot w) $ setFocusX w---- | Call X to set the keyboard focus details.-setFocusX :: Window -> X ()-setFocusX w = withWindowSet $ \ws -> do- dpy <- asks display-- -- clear mouse button grab and border on other windows- forM_ (W.current ws : W.visible ws) $ \wk -> do- forM_ (W.index (W.view (W.tag (W.workspace wk)) ws)) $ \otherw -> do- setButtonGrab True otherw-- -- If we ungrab buttons on the root window, we lose our mouse bindings.- whenX (not `liftM` isRoot w) $ setButtonGrab False w- io $ do setInputFocus dpy w revertToPointerRoot 0- -- raiseWindow dpy w----------------------------------------------------------------------------- Message handling---- | Throw a message to the current LayoutClass possibly modifying how we--- layout the windows, then refresh.-sendMessage :: Message a => a -> X ()-sendMessage a = do- w <- (W.workspace . W.current) `fmap` gets windowset- ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing- whenJust ml' $ \l' -> do- windows $ \ws -> ws { W.current = (W.current ws)- { W.workspace = (W.workspace $ W.current ws)- { W.layout = l' }}}---- | Send a message to a list of workspaces' layouts, without necessarily refreshing.-sendMessageToWorkspaces :: Message a => a -> [WorkspaceId] -> X ()-sendMessageToWorkspaces a l = runOnWorkspaces $ \w ->- if W.tag w `elem` l- then do ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing- return $ w { W.layout = maybe (W.layout w) id ml' }- else return w---- | Send a message to all visible layouts, without necessarily refreshing.--- This is how we implement the hooks, such as UnDoLayout.-broadcastMessage :: Message a => a -> X ()-broadcastMessage a = runOnWorkspaces $ \w -> do- ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing- return $ w { W.layout = maybe (W.layout w) id ml' }---- | This is basically a map function, running a function in the X monad on--- each workspace with the output of that function being the modified workspace.-runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X ()-runOnWorkspaces job =do- ws <- gets windowset- h <- mapM job $ W.hidden ws- c:v <- mapM (\s -> fmap (\w -> s { W.workspace = w}) $ job (W.workspace s))- $ W.current ws : W.visible ws- modify $ \s -> s { windowset = ws { W.current = c, W.visible = v, W.hidden = h } }---- | Set the layout of the currently viewed workspace-setLayout :: Layout Window -> X ()-setLayout l = do- ss@(W.StackSet { W.current = c@(W.Screen { W.workspace = ws })}) <- gets windowset- handleMessage (W.layout ws) (SomeMessage ReleaseResources)- windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = l } } }---- | X Events are valid Messages-instance Message Event----------------------------------------------------------------------------- LayoutClass selection manager---- | A layout that allows users to switch between various layout options.--- This layout accepts three Messages:------ > NextLayout--- > PrevLayout--- > JumpToLayout.----data ChangeLayout = NextLayout | PrevLayout | JumpToLayout String- deriving (Eq, Show, Typeable)--instance Message ChangeLayout--instance ReadableLayout Window where- readTypes = Layout (Select []) :- Layout Full : Layout (Tall 1 0.1 0.5) :- Layout (Mirror $ Tall 1 0.1 0.5) :- serialisedLayouts--data Select a = Select [Layout a] deriving (Show, Read)--instance ReadableLayout a => LayoutClass Select a where- doLayout (Select (l:ls)) r s =- second (fmap (Select . (:ls))) `fmap` doLayout l r s- doLayout (Select []) r s =- second (const Nothing) `fmap` doLayout Full r s-- -- respond to messages only when there's an actual choice:- handleMessage (Select (l:ls@(_:_))) m- | Just NextLayout <- fromMessage m = switchl rls- | Just PrevLayout <- fromMessage m = switchl rls'- | Just (JumpToLayout x) <- fromMessage m = switchl (j x)- | Just ReleaseResources <- fromMessage m = do -- each branch has a different type- mlls' <- mapM (flip handleMessage m) (l:ls)- let lls' = zipWith (flip maybe id) (l:ls) mlls'- return (Just (Select lls'))-- where rls [] = []- rls (x:xs) = xs ++ [x]- rls' = reverse . rls . reverse-- j s zs = case partition ((s ==) . description) zs of (xs,ys) -> xs++ys-- switchl f = do ml' <- handleMessage l (SomeMessage Hide)- return $ Just (Select $ f $ fromMaybe l ml':ls)-- -- otherwise, or if we don't understand the message, pass it along to the real layout:- handleMessage (Select (l:ls)) m =- fmap (Select . (:ls)) `fmap` handleMessage l m-- -- Unless there is no layout...- handleMessage (Select []) _ = return Nothing-- description (Select (x:_)) = description x- description _ = "default"------- | Builtin layout algorithms:------ > fullscreen mode--- > tall mode------ The latter algorithms support the following operations:------ > Shrink--- > Expand----data Resize = Shrink | Expand deriving Typeable---- | You can also increase the number of clients in the master pane-data IncMasterN = IncMasterN Int deriving Typeable--instance Message Resize-instance Message IncMasterN---- | Simple fullscreen mode, just render all windows fullscreen.-data Full a = Full deriving (Show, Read)--instance LayoutClass Full a---- | The inbuilt tiling mode of xmonad, and its operations.-data Tall a = Tall Int Rational Rational deriving (Show, Read)--instance LayoutClass Tall a where- doLayout (Tall nmaster _ frac) r =- return . (flip (,) Nothing) .- ap zip (tile frac r nmaster . length) . W.integrate-- pureMessage (Tall nmaster delta frac) m = msum [fmap resize (fromMessage m)- ,fmap incmastern (fromMessage m)]- where resize Shrink = Tall nmaster delta (max 0 $ frac-delta)- resize Expand = Tall nmaster delta (min 1 $ frac+delta)- incmastern (IncMasterN d) = Tall (max 0 (nmaster+d)) delta frac- description _ = "Tall"---- | Mirror a rectangle-mirrorRect :: Rectangle -> Rectangle-mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw)---- | Mirror a layout, compute its 90 degree rotated form.-data Mirror l a = Mirror (l a) deriving (Show, Read)--instance LayoutClass l a => LayoutClass (Mirror l) a where- doLayout (Mirror l) r s = (map (second mirrorRect) *** fmap Mirror)- `fmap` doLayout l (mirrorRect r) s- handleMessage (Mirror l) = fmap (fmap Mirror) . handleMessage l- description (Mirror l) = "Mirror "++ description l---- | tile. Compute the positions for windows using the default 2 pane tiling algorithm.------ The screen is divided (currently) into two panes. all clients are--- then partioned between these two panes. one pane, the `master', by--- convention has the least number of windows in it (by default, 1).--- the variable `nmaster' controls how many windows are rendered in the--- master pane.------ `delta' specifies the ratio of the screen to resize by.------ 'frac' specifies what proportion of the screen to devote to the--- master area.----tile :: Rational -> Rectangle -> Int -> Int -> [Rectangle]-tile f r nmaster n = if n <= nmaster || nmaster == 0- then splitVertically n r- else splitVertically nmaster r1 ++ splitVertically (n-nmaster) r2 -- two columns- where (r1,r2) = splitHorizontallyBy f r------- Divide the screen vertically into n subrectangles----splitVertically, splitHorizontally :: Int -> Rectangle -> [Rectangle]-splitVertically n r | n < 2 = [r]-splitVertically n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh :- splitVertically (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh))- where smallh = sh `div` fromIntegral n --hmm, this is a fold or map.--splitHorizontally n = map mirrorRect . splitVertically n . mirrorRect---- Divide the screen into two rectangles, using a rational to specify the ratio-splitHorizontallyBy, splitVerticallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)-splitHorizontallyBy f (Rectangle sx sy sw sh) =- ( Rectangle sx sy leftw sh- , Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh)- where leftw = floor $ fromIntegral sw * f---- | XXX comment me-splitVerticallyBy f = (mirrorRect *** mirrorRect) . splitHorizontallyBy f . mirrorRect----------------------------------------------------------------------------- Utilities---- | Return workspace visible on screen 'sc', or Nothing.-screenWorkspace :: ScreenId -> X (Maybe WorkspaceId)-screenWorkspace sc = withWindowSet $ return . W.lookupWorkspace sc---- | Apply an X operation to the currently focused window, if there is one.-withFocused :: (Window -> X ()) -> X ()-withFocused f = withWindowSet $ \w -> whenJust (W.peek w) f---- | True if window is under management by us-isClient :: Window -> X Bool-isClient w = withWindowSet $ return . W.member w---- | Combinations of extra modifier masks we need to grab keys\/buttons for.--- (numlock and capslock)-extraModifiers :: [KeyMask]-extraModifiers = [0, numlockMask, lockMask, numlockMask .|. lockMask ]---- | Strip numlock\/capslock from a mask-cleanMask :: KeyMask -> KeyMask-cleanMask = (complement (numlockMask .|. lockMask) .&.)---- | Get the Pixel value for a named color-initColor :: Display -> String -> IO Pixel-initColor dpy c = (color_pixel . fst) `liftM` allocNamedColor dpy colormap c- where colormap = defaultColormap dpy (defaultScreen dpy)----------------------------------------------------------------------------- | Floating layer support---- | Given a window, find the screen it is located on, and compute--- the geometry of that window wrt. that screen.-floatLocation :: Window -> X (ScreenId, W.RationalRect)-floatLocation w = withDisplay $ \d -> do- ws <- gets windowset- wa <- io $ getWindowAttributes d w-- -- XXX horrible- let sc = fromMaybe (W.current ws) $ find (pointWithin (fi $ wa_x wa) (fi $ wa_y wa) . screenRect . W.screenDetail) $ W.screens ws- sr = screenRect . W.screenDetail $ sc- bw = fi . wa_border_width $ wa- rr = W.RationalRect ((fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr))- ((fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr))- (fi (wa_width wa + bw*2) % fi (rect_width sr))- (fi (wa_height wa + bw*2) % fi (rect_height sr))-- return (W.screen $ sc, rr)- where fi x = fromIntegral x- pointWithin :: Integer -> Integer -> Rectangle -> Bool- pointWithin x y r = x >= fi (rect_x r) &&- x < fi (rect_x r) + fi (rect_width r) &&- y >= fi (rect_y r) &&- y < fi (rect_y r) + fi (rect_height r)---- | Make a tiled window floating, using its suggested rectangle-float :: Window -> X ()-float w = do- (sc, rr) <- floatLocation w- windows $ \ws -> W.float w rr . fromMaybe ws $ do- i <- W.findIndex w ws- guard $ i `elem` map (W.tag . W.workspace) (W.screens ws)- f <- W.peek ws- sw <- W.lookupWorkspace sc ws- return (W.focusWindow f . W.shiftWin sw w $ ws)---- ------------------------------------------------------------------------ Mouse handling---- | Accumulate mouse motion events-mouseDrag :: (Position -> Position -> X ()) -> X () -> X ()-mouseDrag f done = do- drag <- gets dragging- case drag of- Just _ -> return () -- error case? we're already dragging- Nothing -> do- XConf { theRoot = root, display = d } <- ask- io $ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask)- grabModeAsync grabModeAsync none none currentTime- modify $ \s -> s { dragging = Just (motion, cleanup) }- where- cleanup = do- withDisplay $ io . flip ungrabPointer currentTime- modify $ \s -> s { dragging = Nothing }- done- motion x y = do z <- f x y- clearEvents pointerMotionMask- return z---- | XXX comment me-mouseMoveWindow :: Window -> X ()-mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do- io $ raiseWindow d w- wa <- io $ getWindowAttributes d w- (_, _, _, ox', oy', _, _, _) <- io $ queryPointer d w- let ox = fromIntegral ox'- oy = fromIntegral oy'- mouseDrag (\ex ey -> io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))- (fromIntegral (fromIntegral (wa_y wa) + (ey - oy))))- (float w)---- | XXX comment me-mouseResizeWindow :: Window -> X ()-mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do- io $ raiseWindow d w- wa <- io $ getWindowAttributes d w- sh <- io $ getWMNormalHints d w- io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))- mouseDrag (\ex ey -> do- io $ resizeWindow d w `uncurry`- applySizeHints sh (ex - fromIntegral (wa_x wa),- ey - fromIntegral (wa_y wa)))- (float w)---- ------------------------------------------------------------------------ | Support for window size hints--type D = (Dimension, Dimension)---- | Reduce the dimensions if needed to comply to the given SizeHints.-applySizeHints :: Integral a => SizeHints -> (a,a) -> D-applySizeHints sh (w,h) = applySizeHints' sh (fromIntegral $ max 1 w,- fromIntegral $ max 1 h)---- | XXX comment me-applySizeHints' :: SizeHints -> D -> D-applySizeHints' sh =- maybe id applyMaxSizeHint (sh_max_size sh)- . maybe id (\(bw, bh) (w, h) -> (w+bw, h+bh)) (sh_base_size sh)- . maybe id applyResizeIncHint (sh_resize_inc sh)- . maybe id applyAspectHint (sh_aspect sh)- . maybe id (\(bw,bh) (w,h) -> (w-bw, h-bh)) (sh_base_size sh)---- | Reduce the dimensions so their aspect ratio falls between the two given aspect ratios.-applyAspectHint :: (D, D) -> D -> D-applyAspectHint ((minx, miny), (maxx, maxy)) x@(w,h)- | or [minx < 1, miny < 1, maxx < 1, maxy < 1] = x- | w * maxy > h * maxx = (h * maxx `div` maxy, h)- | w * miny < h * minx = (w, w * miny `div` minx)- | otherwise = x---- | Reduce the dimensions so they are a multiple of the size increments.-applyResizeIncHint :: D -> D -> D-applyResizeIncHint (iw,ih) x@(w,h) =- if iw > 0 && ih > 0 then (w - w `mod` iw, h - h `mod` ih) else x---- | Reduce the dimensions if they exceed the given maximum dimensions.-applyMaxSizeHint :: D -> D -> D-applyMaxSizeHint (mw,mh) x@(w,h) =- if mw > 0 && mh > 0 then (min w mw,min h mh) else x
README view
@@ -1,66 +1,105 @@- xmonad : a lightweight X11 window manager.+ xmonad : a tiling window manager http://xmonad.org -------------------------------------------------------------------------+ xmonad is a tiling window manager for X. Windows are arranged+ automatically to tile the screen without gaps or overlap, maximising+ screen use. Window manager features are accessible from the+ keyboard: a mouse is optional. xmonad is written, configured and+ extensible in Haskell. Custom layout algorithms, key bindings and+ other extensions may be written by the user in config files. Layouts+ are applied dynamically, and different layouts may be used on each+ workspace. Xinerama is fully supported, allowing windows to be tiled+ on several physical screens. -About:+Building: - Xmonad is a tiling window manager for X. Windows are managed using- automatic tiling algorithms, which can be dynamically configured.- Windows are arranged so as to tile the screen without gaps, maximising- screen use. All features of the window manager are accessible - from the keyboard: a mouse is strictly optional. Xmonad is written- and extensible in Haskell, and custom layout algorithms may be- implemented by the user in config files. A guiding principle of the- user interface is <i>predictability</i>: users should know in- advance precisely the window arrangement that will result from any- action, leading to an intuitive user interface.+ Building is quite straightforward, and requries a basic Haskell toolchain.+ On many systems xmonad is available as a binary package in your+ package system (e.g. on debian or gentoo). If at all possible, use this+ in preference to a source build, as the dependency resolution will be+ simpler. - Xmonad provides three tiling algorithms by default: tall, wide and- fullscreen. In tall or wide mode, all windows are visible and tiled- to fill the plane without gaps. In fullscreen mode only the focused- window is visible, filling the screen. Alternative tiling- algorithms are provided as extensions. Sets of windows are grouped- together on virtual workspaces and each workspace retains its own- layout. Multiple physical monitors are supported via Xinerama,- allowing simultaneous display of several workspaces.+ We'll now walk through the complete list of toolchain dependencies. - Adhering to a minimalist philosophy of doing one job, and doing it- well, the entire code base remains tiny, and is written to be simple- to understand and modify. By using Haskell as a configuration- language arbitrarily complex extensions may be implemented by the- user using a powerful `scripting' language, without needing to- modify the window manager directly. For example, users may write- their own tiling algorithms.+ * GHC: the Glasgow Haskell Compiler+ + You first need a Haskell compiler. Your distribution's package+ system will have binaries of GHC (the Glasgow Haskell Compiler), the + compiler we use, so install that first. If your operating system's+ package system doesn't provide a binary version of GHC, you can find+ them here: -------------------------------------------------------------------------+ http://haskell.org/ghc -Building:+ For example, in Debian you would install GHC with: -Get the dependencies+ apt-get install ghc6 - Firstly, you'll need the C X11 library headers. On many platforms,- these come pre-installed. For others, such as Debian, you can get - them from your package manager:+ It shouldn't be necessary to compile GHC from source -- every common + system has a pre-build binary version. + * X11 libraries:++ Since you're building an X application, you'll need the C X11+ library headers. On many platforms, these come pre-installed. For+ others, such as Debian, you can get them from your package manager:+ apt-get install libx11-dev - It is likely that you already have some of these dependencies. To check- whether you've got a package run 'ghc-pkg list some_package_name'+ Typically you need: libXinerama libXext libX11 + * Cabal+ + xmonad requires a recent version of Cabal, >= 1.2.0. If you're using+ GHC 6.8, then it comes bundled with the right version. If you're+ using GHC 6.6.x, you'll need to build and install Cabal from hackage+ first:++ http://hackage.haskell.org/cgi-bin/hackage-scripts/package/Cabal++ You can check which version you have with the command:++ $ ghc-pkg list Cabal+ Cabal-1.2.2.0++ * Haskell libraries: mtl, unix, X11++ Finally, you need the Haskell libraries xmonad depends on. Since+ you've a working GHC installation now, most of these will be+ provided. To check whether you've got a package run 'ghc-pkg list+ some_package_name'. You will need the following packages:+ mtl http://hackage.haskell.org/cgi-bin/hackage-scripts/package/mtl-1.0 unix http://hackage.haskell.org/cgi-bin/hackage-scripts/package/unix-2.0 X11 http://hackage.haskell.org/cgi-bin/hackage-scripts/package/X11-1.3.0 -And then build with Cabal:+ * Build xmonad: - runhaskell Setup.lhs configure --prefix=$HOME- runhaskell Setup.lhs build- runhaskell Setup.lhs install --user+ Once you've got all the dependencies in place (which should be+ straightforward), build xmonad: + runhaskell Setup.lhs configure --user --prefix=$HOME+ runhaskell Setup.lhs build+ runhaskell Setup.lhs install --user++ And you're done!+ ------------------------------------------------------------------------ +Notes for using the darcs version++ If you're building the darcs version of xmonad, be sure to also+ use the darcs version of the X11 library, which is developed+ concurrently with xmonad.++ darcs get http://darcs.haskell.org/X11++ Not using X11 from darcs is the most common reason for the+ darcs version of xmonad to fail to build.++------------------------------------------------------------------------+ Running xmonad: Add:@@ -71,33 +110,40 @@ ------------------------------------------------------------------------ +Configuring:++ See the CONFIG document++------------------------------------------------------------------------+ XMonadContrib - There are various contributed modules that can be used with xmonad.- Examples include an ion3-like tabbed layout, a prompt/program launcher,- and various other useful modules. XMonadContrib is available at:+ There are many extensions to xmonad available in the XMonadContrib+ (xmc) library. Examples include an ion3-like tabbed layout, a+ prompt/program launcher, and various other useful modules.+ XMonadContrib is available at: - 0.4 release: http://www.xmonad.org/XMonadContrib-0.4.tar.gz+ 0.5 release: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmonad-contrib-0.5 - darcs version: darcs get http://code.haskell.org/XMonadContrib+ darcs version: darcs get http://code.haskell.org/XMonadContrib ------------------------------------------------------------------------ Other useful programs: - For a program dispatch menu:+ A nicer xterm replacment, that supports resizing better: - dmenu http://www.suckless.org/download/- or- gmrun (in your package system)+ urxvt http://software.schmorp.de/pkg/rxvt-unicode.html For custom status bars: - dzen http://gotmor.googlepages.com/dzen+ dzen http://gotmor.googlepages.com/dzen+ xmobar http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmobar - A nicer xterm replacment, that supports resizing better:+ For a program dispatch menu: - urxvt http://software.schmorp.de/pkg/rxvt-unicode.html+ dmenu http://www.suckless.org/download/+ gmrun (in your package system) Authors:
+ STYLE view
@@ -0,0 +1,21 @@++== Coding guidelines for contributing to+== xmonad and the xmonad contributed extensions++* Comment every top level function (particularly exported funtions), and + provide a type signature; use Haddock syntax in the comments.++* Follow the coding style of the other modules.++* Code should be compilable with -Wall -Werror. There should be no warnings.++* Partial functions should be avoided: the window manager should not+ crash, so do not call `error` or `undefined`++* Tabs are illegal. Use 4 spaces for indenting.++* Any pure function added to the core should have QuickCheck properties+ precisely defining its behaviour.++* New modules should identify the author, and be submitted under+ the same license as xmonad (BSD3 license or freer).
− StackSet.hs
@@ -1,565 +0,0 @@-{-# LANGUAGE PatternGuards #-}---------------------------------------------------------------------------------- |--- Module : StackSet--- Copyright : (c) Don Stewart 2007--- License : BSD3-style (see LICENSE)------ Maintainer : dons@galois.com--- Stability : experimental--- Portability : portable, Haskell 98-----module StackSet (- -- * Introduction- -- $intro- StackSet(..), Workspace(..), Screen(..), StackOrNot, Stack(..), RationalRect(..),- -- * Construction- -- $construction- new, view, greedyView,- -- * Xinerama operations- -- $xinerama- lookupWorkspace,- screens, workspaces, allWindows,- -- * Operations on the current stack- -- $stackOperations- peek, index, integrate, integrate', differentiate,- focusUp, focusDown, focusMaster, focusWindow,- tagMember, renameTag, ensureTags, member, findIndex, mapWorkspace, mapLayout,- -- * Modifying the stackset- -- $modifyStackset- insertUp, delete, delete', filter,- -- * Setting the master window- -- $settingMW- swapUp, swapDown, swapMaster, modify, modify', float, sink, -- needed by users- -- * Composite operations- -- $composite- shift, shiftWin,-- -- for testing- abort- ) where--import Prelude hiding (filter)-import Data.Maybe (listToMaybe,fromJust)-import qualified Data.List as L (deleteBy,find,splitAt,filter,nub)-import Data.List ( (\\) )-import qualified Data.Map as M (Map,insert,delete,empty)---- $intro------ The 'StackSet' data type encodes a window manager abstraction. The--- window manager is a set of virtual workspaces. On each workspace is a--- stack of windows. A given workspace is always current, and a given--- window on each workspace has focus. The focused window on the current--- workspace is the one which will take user input. It can be visualised--- as follows:------ > Workspace { 0*} { 1 } { 2 } { 3 } { 4 }--- >--- > Windows [1 [] [3* [6*] []--- > ,2*] ,4--- > ,5]------ Note that workspaces are indexed from 0, windows are numbered--- uniquely. A '*' indicates the window on each workspace that has--- focus, and which workspace is current.------ Zipper------ We encode all the focus tracking directly in the data structure, with a 'zipper':------ A Zipper is essentially an `updateable' and yet pure functional--- cursor into a data structure. Zipper is also a delimited--- continuation reified as a data structure.------ The Zipper lets us replace an item deep in a complex data--- structure, e.g., a tree or a term, without an mutation. The--- resulting data structure will share as much of its components with--- the old structure as possible.------ Oleg Kiselyov, 27 Apr 2005, haskell\@, "Zipper as a delimited continuation"------ We use the zipper to keep track of the focused workspace and the--- focused window on each workspace, allowing us to have correct focus--- by construction. We closely follow Huet's original implementation:------ G. Huet, /Functional Pearl: The Zipper/,--- 1997, J. Functional Programming 75(5):549-554.--- and:--- R. Hinze and J. Jeuring, /Functional Pearl: The Web/.------ and Conor McBride's zipper differentiation paper.--- Another good reference is:------ The Zipper, Haskell wikibook------ Xinerama support:------ Xinerama in X11 lets us view multiple virtual workspaces--- simultaneously. While only one will ever be in focus (i.e. will--- receive keyboard events), other workspaces may be passively viewable.--- We thus need to track which virtual workspaces are associated--- (viewed) on which physical screens. We use a simple Map Workspace--- Screen for this.------ Master and Focus------ Each stack tracks a focused item, and for tiling purposes also tracks--- a 'master' position. The connection between 'master' and 'focus'--- needs to be well defined. Particular in relation to 'insert' and--- 'delete'.------- |--- API changes from xmonad 0.1:--- StackSet constructor arguments changed. StackSet workspace window screen------ * new, -- was: empty------ * view,------ * index,------ * peek, -- was: peek\/peekStack------ * focusUp, focusDown, -- was: rotate------ * swapUp, swapDown------ * focus -- was: raiseFocus------ * insertUp, -- was: insert\/push------ * delete,------ * swapMaster, -- was: promote\/swap------ * member,------ * shift,------ * lookupWorkspace, -- was: workspace------ * visibleWorkspaces -- gone.------------------------------------------------------------------------------- |--- A cursor into a non-empty list of workspaces.------ We puncture the workspace list, producing a hole in the structure--- used to track the currently focused workspace. The two other lists--- that are produced are used to track those workspaces visible as--- Xinerama screens, and those workspaces not visible anywhere.--data StackSet i l a sid sd =- StackSet { current :: !(Screen i l a sid sd) -- ^ currently focused workspace- , visible :: [Screen i l a sid sd] -- ^ non-focused workspaces, visible in xinerama- , hidden :: [Workspace i l a] -- ^ workspaces not visible anywhere- , floating :: M.Map a RationalRect -- ^ floating windows- } deriving (Show, Read, Eq)---- | Visible workspaces, and their Xinerama screens.-data Screen i l a sid sd = Screen { workspace :: !(Workspace i l a)- , screen :: !sid- , screenDetail :: !sd }- deriving (Show, Read, Eq)---- |--- A workspace is just a tag - its index - and a stack----data Workspace i l a = Workspace { tag :: !i, layout :: l, stack :: StackOrNot a }- deriving (Show, Read, Eq)---- | A structure for window geometries-data RationalRect = RationalRect Rational Rational Rational Rational- deriving (Show, Read, Eq)---- |--- A stack is a cursor onto a (possibly empty) window list.--- The data structure tracks focus by construction, and--- the master window is by convention the top-most item.--- Focus operations will not reorder the list that results from--- flattening the cursor. The structure can be envisaged as:------ > +-- master: < '7' >--- > up | [ '2' ]--- > +--------- [ '3' ]--- > focus: < '4' >--- > dn +----------- [ '8' ]------ A 'Stack' can be viewed as a list with a hole punched in it to make--- the focused position. Under the zipper\/calculus view of such--- structures, it is the differentiation of a [a], and integrating it--- back has a natural implementation used in 'index'.----type StackOrNot a = Maybe (Stack a)--data Stack a = Stack { focus :: !a -- focused thing in this set- , up :: [a] -- clowns to the left- , down :: [a] } -- jokers to the right- deriving (Show, Read, Eq)----- | this function indicates to catch that an error is expected-abort :: String -> a-abort x = error $ "xmonad: StackSet: " ++ x---- ------------------------------------------------------------------------ $construction---- | /O(n)/. Create a new stackset, of empty stacks, with given tags, with--- 'm' physical screens. 'm' should be less than or equal to the number of--- workspace tags. The first workspace in the list will be current.------ Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.----new :: (Integral s) => l -> [i] -> [sd] -> StackSet i l a s sd-new l wids m | not (null wids) && length m <= length wids = StackSet cur visi unseen M.empty- where (seen,unseen) = L.splitAt (length m) $ map (\i -> Workspace i l Nothing) wids- (cur:visi) = [ Screen i s sd | (i, s, sd) <- zip3 seen [0..] m ]- -- now zip up visibles with their screen id-new _ _ _ = abort "non-positive argument to StackSet.new"---- |--- /O(w)/. Set focus to the workspace with index \'i\'.--- If the index is out of range, return the original StackSet.------ Xinerama: If the workspace is not visible on any Xinerama screen, it--- becomes the current screen. If it is in the visible list, it becomes--- current.--view :: (Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd-view i s- | not (i `tagMember` s)- || i == tag (workspace (current s)) = s -- out of bounds or current-- | Just x <- L.find ((i==).tag.workspace) (visible s)- -- if it is visible, it is just raised- = s { current = x, visible = current s : L.deleteBy (equating screen) x (visible s) }-- | Just x <- L.find ((i==).tag) (hidden s) -- must be hidden then- -- if it was hidden, it is raised on the xine screen currently used- = s { current = (current s) { workspace = x }- , hidden = workspace (current s) : L.deleteBy (equating tag) x (hidden s) }-- | otherwise = s -- can't happen: all workspaces are either invalid, current, visible, or hidden-- where equating f = \x y -> f x == f y-- -- 'Catch'ing this might be hard. Relies on monotonically increasing- -- workspace tags defined in 'new'- --- -- and now tags are not monotonic, what happens here?---- |--- Set focus to the given workspace. If that workspace does not exist--- in the stackset, the original workspace is returned. If that workspace is--- 'hidden', then display that workspace on the current screen, and move the--- current workspace to 'hidden'. If that workspace is 'visible' on another--- screen, the workspaces of the current screen and the other screen are--- swapped.--greedyView :: (Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd-greedyView w ws- | any wTag (hidden ws) = view w ws- | (Just s) <- L.find (wTag . workspace) (visible ws)- = ws { current = (current ws) { workspace = workspace s }- , visible = s { workspace = workspace (current ws) }- : L.filter (not . wTag . workspace) (visible ws) }- | otherwise = ws- where wTag = (w == ) . tag---- ------------------------------------------------------------------------ $xinerama---- | Find the tag of the workspace visible on Xinerama screen 'sc'.--- Nothing if screen is out of bounds.-lookupWorkspace :: Eq s => s -> StackSet i l a s sd -> Maybe i-lookupWorkspace sc w = listToMaybe [ tag i | Screen i s _ <- current w : visible w, s == sc ]---- ------------------------------------------------------------------------ $stackOperations---- |--- The 'with' function takes a default value, a function, and a--- StackSet. If the current stack is Nothing, 'with' returns the--- default value. Otherwise, it applies the function to the stack,--- returning the result. It is like 'maybe' for the focused workspace.----with :: b -> (Stack a -> b) -> StackSet i l a s sd -> b-with dflt f = maybe dflt f . stack . workspace . current---- |--- Apply a function, and a default value for Nothing, to modify the current stack.----modify :: StackOrNot a -> (Stack a -> StackOrNot a) -> StackSet i l a s sd -> StackSet i l a s sd-modify d f s = s { current = (current s)- { workspace = (workspace (current s)) { stack = with d f s }}}---- |--- Apply a function to modify the current stack if it isn't empty, and we don't--- want to empty it.----modify' :: (Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd-modify' f = modify Nothing (Just . f)---- |--- /O(1)/. Extract the focused element of the current stack.--- Return Just that element, or Nothing for an empty stack.----peek :: StackSet i l a s sd -> Maybe a-peek = with Nothing (return . focus)---- |--- /O(n)/. Flatten a Stack into a list.----integrate :: Stack a -> [a]-integrate (Stack x l r) = reverse l ++ x : r---- |--- /O(n)/ Flatten a possibly empty stack into a list.-integrate' :: StackOrNot a -> [a]-integrate' = maybe [] integrate---- |--- /O(n)/. Texture a list.----differentiate :: [a] -> StackOrNot a-differentiate [] = Nothing-differentiate (x:xs) = Just $ Stack x [] xs---- |--- /O(n)/. 'filter p s' returns the elements of 's' such that 'p' evaluates to--- True. Order is preserved, and focus moves as described for 'delete'.----filter :: (a -> Bool) -> Stack a -> StackOrNot a-filter p (Stack f ls rs) = case L.filter p (f:rs) of- f':rs' -> Just $ Stack f' (L.filter p ls) rs' -- maybe move focus down- [] -> case L.filter p ls of -- filter back up- f':ls' -> Just $ Stack f' ls' [] -- else up- [] -> Nothing---- |--- /O(s)/. Extract the stack on the current workspace, as a list.--- The order of the stack is determined by the master window -- it will be--- the head of the list. The implementation is given by the natural--- integration of a one-hole list cursor, back to a list.----index :: StackSet i l a s sd -> [a]-index = with [] integrate---- let is = t : r ++ reverse l in take (length is) (dropWhile (/= m) (cycle is))---- |--- /O(1), O(w) on the wrapping case/.------ focusUp, focusDown. Move the window focus up or down the stack,--- wrapping if we reach the end. The wrapping should model a 'cycle'--- on the current stack. The 'master' window, and window order,--- are unaffected by movement of focus.------ swapUp, swapDown, swap the neighbour in the stack ordering, wrapping--- if we reach the end. Again the wrapping model should 'cycle' on--- the current stack.----focusUp, focusDown, swapUp, swapDown :: StackSet i l a s sd -> StackSet i l a s sd-focusUp = modify' focusUp'-focusDown = modify' (reverseStack . focusUp' . reverseStack)--swapUp = modify' swapUp'-swapDown = modify' (reverseStack . swapUp' . reverseStack)--focusUp', swapUp' :: Stack a -> Stack a-focusUp' (Stack t (l:ls) rs) = Stack l ls (t:rs)-focusUp' (Stack t [] rs) = Stack x xs [] where (x:xs) = reverse (t:rs)--swapUp' (Stack t (l:ls) rs) = Stack t ls (l:rs)-swapUp' (Stack t [] rs) = Stack t (reverse rs) []---- | reverse a stack: up becomes down and down becomes up.-reverseStack :: Stack a -> Stack a-reverseStack (Stack t ls rs) = Stack t rs ls------- | /O(1) on current window, O(n) in general/. Focus the window 'w',--- and set its workspace as current.----focusWindow :: (Eq s, Eq a, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd-focusWindow w s | Just w == peek s = s- | otherwise = maybe s id $ do- n <- findIndex w s- return $ until ((Just w ==) . peek) focusUp (view n s)---- | Get a list of all screens in the StackSet.-screens :: StackSet i l a s sd -> [Screen i l a s sd]-screens s = current s : visible s---- | Get a list of all workspaces in the StackSet.-workspaces :: StackSet i l a s sd -> [Workspace i l a]-workspaces s = workspace (current s) : map workspace (visible s) ++ hidden s---- | Get a list of all windows in the StackSet in no particular order-allWindows :: Eq a => StackSet i l a s sd -> [a]-allWindows = L.nub . concatMap (integrate' . stack) . workspaces---- | Is the given tag present in the StackSet?-tagMember :: Eq i => i -> StackSet i l a s sd -> Bool-tagMember t = elem t . map tag . workspaces---- | Rename a given tag if present in the StackSet.-renameTag :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd-renameTag o n = mapWorkspace rename- where rename w = if tag w == o then w { tag = n } else w---- | Ensure that a given set of tags is present.-ensureTags :: Eq i => l -> [i] -> StackSet i l a s sd -> StackSet i l a s sd-ensureTags l allt st = et allt (map tag (workspaces st) \\ allt) st- where et [] _ s = s- et (i:is) rn s | i `tagMember` s = et is rn s- et (i:is) [] s = et is [] (s { hidden = Workspace i l Nothing : hidden s })- et (i:is) (r:rs) s = et is rs $ renameTag r i s---- | Map a function on all the workspaces in the StackSet.-mapWorkspace :: (Workspace i l a -> Workspace i l a) -> StackSet i l a s sd -> StackSet i l a s sd-mapWorkspace f s = s { current = updScr (current s)- , visible = map updScr (visible s)- , hidden = map f (hidden s) }- where updScr scr = scr { workspace = f (workspace scr) }---- | Map a function on all the layouts in the StackSet.-mapLayout :: (l -> l') -> StackSet i l a s sd -> StackSet i l' a s sd-mapLayout f (StackSet v vs hs m) = StackSet (fScreen v) (map fScreen vs) (map fWorkspace hs) m- where- fScreen (Screen ws s sd) = Screen (fWorkspace ws) s sd- fWorkspace (Workspace t l s) = Workspace t (f l) s---- | /O(n)/. Is a window in the StackSet.-member :: Eq a => a -> StackSet i l a s sd -> Bool-member a s = maybe False (const True) (findIndex a s)---- | /O(1) on current window, O(n) in general/.--- Return Just the workspace index of the given window, or Nothing--- if the window is not in the StackSet.-findIndex :: Eq a => a -> StackSet i l a s sd -> Maybe i-findIndex a s = listToMaybe- [ tag w | w <- workspaces s, has a (stack w) ]- where has _ Nothing = False- has x (Just (Stack t l r)) = x `elem` (t : l ++ r)---- ------------------------------------------------------------------------ $modifyStackset---- |--- /O(n)/. (Complexity due to duplicate check). Insert a new element into--- the stack, above the currently focused element.------ The new element is given focus, and is set as the master window.--- The previously focused element is moved down. The previously--- 'master' element is forgotten. (Thus, 'insert' will cause a retiling).------ If the element is already in the stackset, the original stackset is--- returned unmodified.------ Semantics in Huet's paper is that insert doesn't move the cursor.--- However, we choose to insert above, and move the focus.----insertUp :: Eq a => a -> StackSet i l a s sd -> StackSet i l a s sd-insertUp a s = if member a s then s else insert- where insert = modify (Just $ Stack a [] []) (\(Stack t l r) -> Just $ Stack a l (t:r)) s---- insertDown :: a -> StackSet i l a s sd -> StackSet i l a s sd--- insertDown a = modify (Stack a [] []) $ \(Stack t l r) -> Stack a (t:l) r--- Old semantics, from Huet.--- > w { down = a : down w }---- |--- /O(1) on current window, O(n) in general/. Delete window 'w' if it exists.--- There are 4 cases to consider:------ * delete on an Nothing workspace leaves it Nothing--- * otherwise, try to move focus to the down--- * otherwise, try to move focus to the up--- * otherwise, you've got an empty workspace, becomes Nothing------ Behaviour with respect to the master:------ * deleting the master window resets it to the newly focused window--- * otherwise, delete doesn't affect the master.----delete :: (Ord a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd-delete w = sink w . delete' w---- | Only temporarily remove the window from the stack, thereby not destroying special--- information saved in the Stackset-delete' :: (Eq a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd-delete' w s = s { current = removeFromScreen (current s)- , visible = map removeFromScreen (visible s)- , hidden = map removeFromWorkspace (hidden s) }- where removeFromWorkspace ws = ws { stack = stack ws >>= filter (/=w) }- removeFromScreen scr = scr { workspace = removeFromWorkspace (workspace scr) }------------------------------------------------------------------------------ | Given a window, and its preferred rectangle, set it as floating--- A floating window should already be managed by the StackSet.-float :: Ord a => a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd-float w r s = s { floating = M.insert w r (floating s) }---- | Clear the floating status of a window-sink :: Ord a => a -> StackSet i l a s sd -> StackSet i l a s sd-sink w s = s { floating = M.delete w (floating s) }----------------------------------------------------------------------------- $settingMW---- | /O(s)/. Set the master window to the focused window.--- The old master window is swapped in the tiling order with the focused window.--- Focus stays with the item moved.-swapMaster :: StackSet i l a s sd -> StackSet i l a s sd-swapMaster = modify' $ \c -> case c of- Stack _ [] _ -> c -- already master.- Stack t ls rs -> Stack t [] (xs ++ x : rs) where (x:xs) = reverse ls---- natural! keep focus, move current to the top, move top to current.---- | /O(s)/. Set focus to the master window.-focusMaster :: StackSet i l a s sd -> StackSet i l a s sd-focusMaster = modify' $ \c -> case c of- Stack _ [] _ -> c- Stack t ls rs -> Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls------- ------------------------------------------------------------------------ $composite---- | /O(w)/. shift. Move the focused element of the current stack to stack--- 'n', leaving it as the focused element on that stack. The item is--- inserted above the currently focused element on that workspace.--- The actual focused workspace doesn't change. If there is no--- element on the current stack, the original stackSet is returned.----shift :: (Ord a, Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd-shift n s | n `tagMember` s && n /= curtag = maybe s go (peek s)- | otherwise = s- where go w = view curtag . insertUp w . view n . delete' w $ s- curtag = tag (workspace (current s))---- | /O(n)/. shiftWin. Searches for the specified window 'w' on all workspaces--- of the stackSet and moves it to stack 'n', leaving it as the focused--- element on that stack. The item is inserted above the currently--- focused element on that workspace.--- The actual focused workspace doesn't change. If the window is not--- found in the stackSet, the original stackSet is returned.--- TODO how does this duplicate 'shift's behaviour?-shiftWin :: (Ord a, Eq a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd-shiftWin n w s | from == Nothing = s -- not found- | n `tagMember` s && (Just n) /= from = go- | otherwise = s- where from = findIndex w s-- go = on n (insertUp w) . on (fromJust from) (delete' w) $ s- curtag = tag (workspace (current s))- on i f = view curtag . f . view i-
TODO view
@@ -1,15 +1,20 @@ - Write down invariants for the window life cycle, especially: - When are borders set? Prove that the current handling is sufficient. + - current floating layer handling is unoptimal. FocusUp should raise,+ for example++ - Issues still with stacking order.+ = Release management = -* build and typecheck all XMC+* configuration documentation+ * generate haddocks for core and XMC, upload to xmonad.org * generate manpage, generate html manpage-* document, with photos, any new layouts * double check README build instructions * test core with 6.6 and 6.8-* upload X11/X11-extras/xmonad to hacakge-* check examples/text in use-facing Config.hs+* bump xmonad.cabal version and X11 version+* upload X11 and xmonad to hackage+* check examples/text in user-facing Config.hs * check tour.html and intro.html are up to date, and mention all core bindings-* bump xmonad.cabal version
XMonad.hs view
@@ -1,276 +1,47 @@-{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}-------------------------------------------------------------------------------+-------------------------------------------------------------------- -- |--- Module : XMonad.hs--- Copyright : (c) Spencer Janssen 2007--- License : BSD3-style (see LICENSE)+-- Module : XMonad+-- Copyright : (c) Don Stewart+-- License : BSD3 ----- Maintainer : sjanssen@cse.unl.edu--- Stability : unstable--- Portability : not portable, uses cunning newtype deriving+-- Maintainer: Don Stewart <dons@galois.com>+-- Stability : provisional+-- Portability: ----- The X monad, a state monad transformer over IO, for the window--- manager state, and support routines.+-------------------------------------------------------------------- --------------------------------------------------------------------------------+-- Useful exports for configuration files. module XMonad (- X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), LayoutClass(..), Layout(..), ReadableLayout(..),- Typeable, Message, SomeMessage(..), fromMessage, runLayout,- runX, catchX, userCode, io, catchIO, withDisplay, withWindowSet, isRoot, getAtom, spawn, restart, trace, whenJust, whenX,- atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW- ) where -import StackSet--import Prelude hiding ( catch )-import Control.Exception (catch, throw, Exception(ExitException))-import Control.Monad.State-import Control.Monad.Reader-import Control.Arrow (first)-import System.IO-import System.Posix.Process (executeFile, forkProcess, getProcessStatus, createSession)-import System.Exit-import System.Environment-import Graphics.X11.Xlib--- for Read instance-import Graphics.X11.Xlib.Extras ()-import Data.Typeable--import qualified Data.Map as M-import qualified Data.Set as S---- | XState, the window manager state.--- Just the display, width, height and a window list-data XState = XState- { windowset :: !WindowSet -- ^ workspace list- , mapped :: !(S.Set Window) -- ^ the Set of mapped windows- , waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents- , dragging :: !(Maybe (Position -> Position -> X (), X ())) }-data XConf = XConf- { display :: Display -- ^ the X11 display- , theRoot :: !Window -- ^ the root window- , normalBorder :: !Pixel -- ^ border color of unfocused windows- , focusedBorder :: !Pixel } -- ^ border color of the focused window--type WindowSet = StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail-type WindowSpace = Workspace WorkspaceId (Layout Window) Window---- | Virtual workspace indicies-type WorkspaceId = String---- | Physical screen indicies-newtype ScreenId = S Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)---- | TODO Comment me-data ScreenDetail = SD { screenRect :: !Rectangle- , statusGap :: !(Int,Int,Int,Int) -- ^ width of status bar on the screen- } deriving (Eq,Show, Read)------------------------------------------------------------------------------ | The X monad, a StateT transformer over IO encapsulating the window--- manager state------ Dynamic components may be retrieved with 'get', static components--- with 'ask'. With newtype deriving we get readers and state monads--- instantiated on XConf and XState automatically.----newtype X a = X (ReaderT XConf (StateT XState IO) a)- deriving (Functor, Monad, MonadIO, MonadState XState, MonadReader XConf)---- | Run the X monad, given a chunk of X monad code, and an initial state--- Return the result, and final state-runX :: XConf -> XState -> X a -> IO (a, XState)-runX c st (X a) = runStateT (runReaderT a c) st---- | Run in the X monad, and in case of exception, and catch it and log it--- to stderr, and run the error case.-catchX :: X a -> X a -> X a-catchX job errcase = do- st <- get- c <- ask- (a, s') <- io $ runX c st job `catch`- \e -> case e of- ExitException {} -> throw e- _ -> do hPrint stderr e; runX c st errcase- put s'- return a---- | Execute the argument, catching all exceptions. Either this function or--- catchX should be used at all callsites of user customized code.-userCode :: X () -> X ()-userCode a = catchX (a >> return ()) (return ())---- ------------------------------------------------------------------------ Convenient wrappers to state---- | Run a monad action with the current display settings-withDisplay :: (Display -> X a) -> X a-withDisplay f = asks display >>= f---- | Run a monadic action with the current stack set-withWindowSet :: (WindowSet -> X a) -> X a-withWindowSet f = gets windowset >>= f---- | True if the given window is the root window-isRoot :: Window -> X Bool-isRoot w = liftM (w==) (asks theRoot)---- | Wrapper for the common case of atom internment-getAtom :: String -> X Atom-getAtom str = withDisplay $ \dpy -> io $ internAtom dpy str False---- | Common non-predefined atoms-atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_STATE :: X Atom-atom_WM_PROTOCOLS = getAtom "WM_PROTOCOLS"-atom_WM_DELETE_WINDOW = getAtom "WM_DELETE_WINDOW"-atom_WM_STATE = getAtom "WM_STATE"----------------------------------------------------------------------------- | LayoutClass handling. See particular instances in Operations.hs---- | An existential type that can hold any object that is in the LayoutClass.-data Layout a = forall l. LayoutClass l a => Layout (l a)----- | This class defines a set of layout types (held in Layout--- objects) that are used when trying to read an existentially wrapped Layout.-class ReadableLayout a where- readTypes :: [Layout a]---- | The different layout modes------ 'doLayout': given a Rectangle and a Stack, layout the stack elements--- inside the given Rectangle. If an element is not given a Rectangle--- by 'doLayout', then it is not shown on screen. Windows are restacked--- according to the order they are returned by 'doLayout'.----class (Show (layout a), Read (layout a)) => LayoutClass layout a where-- -- | Given a Rectangle in which to place the windows, and a Stack of- -- windows, return a list of windows and their corresponding Rectangles.- -- The order of windows in this list should be the desired stacking order.- -- Also return a modified layout, if this layout needs to be modified- -- (e.g. if we keep track of the windows we have displayed).- doLayout :: layout a -> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (layout a))- doLayout l r s = return (pureLayout l r s, Nothing)-- -- | This is a pure version of doLayout, for cases where we don't need- -- access to the X monad to determine how to layou out the windows, and- -- we don't need to modify our layout itself.- pureLayout :: layout a -> Rectangle -> Stack a -> [(a, Rectangle)]- pureLayout _ r s = [(focus s, r)]-- -- | 'handleMessage' performs message handling for that layout. If- -- 'handleMessage' returns Nothing, then the layout did not respond to- -- that message and the screen is not refreshed. Otherwise, 'handleMessage'- -- returns an updated 'LayoutClass' and the screen is refreshed.- --- handleMessage :: layout a -> SomeMessage -> X (Maybe (layout a))- handleMessage l = return . pureMessage l-- -- | Respond to a message by (possibly) changing our layout, but taking- -- no other action. If the layout changes, the screen will be refreshed.- pureMessage :: layout a -> SomeMessage -> Maybe (layout a)- pureMessage _ _ = Nothing-- -- | This should be a human-readable string that is used when selecting- -- layouts by name.- description :: layout a -> String- description = show---- Here's the magic for parsing serialised state of existentially--- wrapped layouts: attempt to parse using the Read instance from each--- type in our list of types, if any suceed, take the first one.-instance ReadableLayout a => Read (Layout a) where-- -- We take the first parse only, because multiple matches indicate a bad parse.- readsPrec _ s = take 1 $ concatMap readLayout readTypes- where- readLayout (Layout x) = map (first Layout) $ readAsType x-- -- the type indicates which Read instance to dispatch to.- -- That is, read asTypeOf the argument from the readTypes.- readAsType :: LayoutClass l a => l a -> [(l a, String)]- readAsType _ = reads s--instance ReadableLayout a => LayoutClass Layout a where- doLayout (Layout l) r s = fmap (fmap Layout) `liftM` doLayout l r s- handleMessage (Layout l) = fmap (fmap Layout) . handleMessage l- description (Layout l) = description l--instance Show (Layout a) where show (Layout l) = show l---- | This calls doLayout if there are any windows to be laid out.-runLayout :: LayoutClass l a => l a -> Rectangle -> StackOrNot a -> X ([(a, Rectangle)], Maybe (l a))-runLayout l r = maybe (return ([], Nothing)) (doLayout l r)---- | Based on ideas in /An Extensible Dynamically-Typed Hierarchy of Exceptions/,--- Simon Marlow, 2006. Use extensible messages to the handleMessage handler.------ User-extensible messages must be a member of this class.----class Typeable a => Message a---- |--- A wrapped value of some type in the Message class.----data SomeMessage = forall a. Message a => SomeMessage a---- |--- And now, unwrap a given, unknown Message type, performing a (dynamic)--- type check on the result.----fromMessage :: Message m => SomeMessage -> Maybe m-fromMessage (SomeMessage m) = cast m---- ------------------------------------------------------------------------ | General utilities------ Lift an IO action into the X monad-io :: IO a -> X a-io = liftIO---- | Lift an IO action into the X monad. If the action results in an IO--- exception, log the exception to stderr and continue normal execution.-catchIO :: IO () -> X ()-catchIO f = liftIO (f `catch` \e -> hPrint stderr e >> hFlush stderr)---- | spawn. Launch an external application-spawn :: String -> X ()-spawn x = io $ do- pid <- forkProcess $ do- forkProcess (createSession >> executeFile "/bin/sh" False ["-c", x] Nothing)- exitWith ExitSuccess- getProcessStatus True False pid- return ()+ module XMonad.Main,+ module XMonad.Core,+ module XMonad.Config,+ module XMonad.Layout,+ module XMonad.ManageHook,+ module XMonad.Operations,+ module Graphics.X11,+ module Graphics.X11.Xlib.Extras,+ (.|.),+ MonadState(..), gets, modify,+ MonadReader(..), asks,+ MonadIO(..) --- | Restart xmonad via exec().------ If the first parameter is 'Just name', restart will attempt to execute the--- program corresponding to 'name'. Otherwise, xmonad will attempt to execute--- the name of the current program.------ When the second parameter is 'True', xmonad will attempt to resume with the--- current window state.-restart :: Maybe String -> Bool -> X ()-restart mprog resume = do- prog <- maybe (io getProgName) return mprog- args <- if resume then gets (("--resume":) . return . showWs . windowset) else return []- catchIO (executeFile prog True args Nothing)- where showWs = show . mapLayout show+ ) where --- | 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+-- core modules+import XMonad.Main+import XMonad.Core+import XMonad.Config+import XMonad.Layout+import XMonad.ManageHook+import XMonad.Operations+-- import XMonad.StackSet -- conflicts with 'workspaces' defined in XMonad.hs --- | Conditionally run an action, using a X event to decide-whenX :: X Bool -> X () -> X ()-whenX a f = a >>= \b -> when b f+-- modules needed to get basic configuration working+import Data.Bits+import Graphics.X11 hiding (refreshKeyboardMapping)+import Graphics.X11.Xlib.Extras --- | 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+import Control.Monad.State+import Control.Monad.Reader
+ XMonad/Config.hs view
@@ -0,0 +1,252 @@+{-# OPTIONS -fno-warn-missing-signatures #-}+-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Config+-- Copyright : (c) Spencer Janssen 2007+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : dons@galois.com+-- Stability : stable+-- Portability : portable+--+-- This module specifies the default configuration values for xmonad.+-- Users should not modify this file. Rather, they should provide their+-- own @~\/.xmonad\/xmonad.hs@ that overrides specific fields in defaultConfig.+--+------------------------------------------------------------------------++module XMonad.Config (defaultConfig) where++--+-- Useful imports+--+import XMonad.Core as XMonad hiding+ (workspaces,manageHook,numlockMask,keys,logHook,borderWidth,mouseBindings+ ,defaultGaps,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor)+import qualified XMonad.Core as XMonad+ (workspaces,manageHook,numlockMask,keys,logHook,borderWidth,mouseBindings+ ,defaultGaps,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor)++import XMonad.Layout+import XMonad.Operations+import XMonad.ManageHook+import qualified XMonad.StackSet as W+import Data.Bits ((.|.))+import qualified Data.Map as M+import System.Exit+import Graphics.X11.Xlib++-- | The default number of workspaces (virtual screens) and their names.+-- By default we use numeric strings, but any string may be used as a+-- workspace name. The number of workspaces is determined by the length+-- of this list.+--+-- A tagging example:+--+-- > workspaces = ["web", "irc", "code" ] ++ map show [4..9]+--+workspaces :: [WorkspaceId]+workspaces = map show [1 .. 9 :: Int]++-- | modMask lets you specify which modkey you want to use. The default+-- is mod1Mask ("left alt"). You may also consider using mod3Mask+-- ("right alt"), which does not conflict with emacs keybindings. The+-- "windows key" is usually mod4Mask.+--+defaultModMask :: KeyMask+defaultModMask = mod1Mask++-- | The mask for the numlock key. Numlock status is "masked" from the+-- current modifier status, so the keybindings will work with numlock on or+-- off. You may need to change this on some systems.+--+-- You can find the numlock modifier by running "xmodmap" and looking for a+-- modifier with Num_Lock bound to it:+--+-- > $ xmodmap | grep Num+-- > mod2 Num_Lock (0x4d)+--+-- Set numlockMask = 0 if you don't have a numlock key, or want to treat+-- numlock status separately.+--+numlockMask :: KeyMask+numlockMask = mod2Mask++-- | Width of the window border in pixels.+--+borderWidth :: Dimension+borderWidth = 1++-- | Border colors for unfocused and focused windows, respectively.+--+normalBorderColor, focusedBorderColor :: String+normalBorderColor = "#dddddd"+focusedBorderColor = "#ff0000"++-- | Default offset of drawable screen boundaries from each physical+-- screen. Anything non-zero here will leave a gap of that many pixels+-- on the given edge, on the that screen. A useful gap at top of screen+-- for a menu bar (e.g. 15)+--+-- An example, to set a top gap on monitor 1, and a gap on the bottom of+-- monitor 2, you'd use a list of geometries like so:+--+-- > defaultGaps = [(18,0,0,0),(0,18,0,0)] -- 2 gaps on 2 monitors+--+-- Fields are: top, bottom, left, right.+--+defaultGaps :: [(Int,Int,Int,Int)]+defaultGaps = [(0,0,0,0)] -- 15 for default dzen font++------------------------------------------------------------------------+-- Window rules++-- | Execute arbitrary actions and WindowSet manipulations when managing+-- a new window. You can use this to, for example, always float a+-- particular program, or have a client always appear on a particular+-- workspace.+--+-- To find the property name associated with a program, use+-- xprop | grep WM_CLASS+-- and click on the client you're interested in.+--+manageHook :: ManageHook+manageHook = composeAll+ [ className =? "MPlayer" --> doFloat+ , className =? "Gimp" --> doFloat+ , resource =? "desktop_window" --> doIgnore+ , resource =? "kdesktop" --> doIgnore ]++------------------------------------------------------------------------+-- Logging++-- | Perform an arbitrary action on each internal state change or X event.+-- Examples include:+-- * do nothing+-- * log the state to stdout+--+-- See the 'DynamicLog' extension for examples.+--+logHook :: X ()+logHook = return ()++------------------------------------------------------------------------+-- Extensible layouts+--+-- You can specify and transform your layouts by modifying these values.+-- If you change layout bindings be sure to use 'mod-shift-space' after+-- restarting (with 'mod-q') to reset your layout state to the new+-- defaults, as xmonad preserves your old layout settings by default.+--++-- | The available layouts. Note that each layout is separated by |||, which+-- denotes layout choice.+layout = tiled ||| Mirror tiled ||| Full+ where+ -- default tiling algorithm partitions the screen into two panes+ tiled = Tall nmaster delta ratio++ -- The default number of windows in the master pane+ nmaster = 1++ -- Default proportion of screen occupied by master pane+ ratio = 1/2++ -- Percent of screen to increment by when resizing panes+ delta = 3/100++------------------------------------------------------------------------+-- Key bindings:++-- | The preferred terminal program, which is used in a binding below and by+-- certain contrib modules.+terminal :: String+terminal = "xterm"++-- | The xmonad key bindings. Add, modify or remove key bindings here.+--+-- (The comment formatting character is used when generating the manpage)+--+keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())+keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $+ -- launching and killing programs+ [ ((modMask .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal+ , ((modMask, xK_p ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu+ , ((modMask .|. shiftMask, xK_p ), spawn "gmrun") -- %! Launch gmrun+ , ((modMask .|. shiftMask, xK_c ), kill) -- %! Close the focused window++ , ((modMask, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms+ , ((modMask .|. shiftMask, xK_space ), setLayout $ XMonad.layoutHook conf) -- %! Reset the layouts on the current workspace to default++ , ((modMask, xK_n ), refresh) -- %! Resize viewed windows to the correct size++ -- move focus up or down the window stack+ , ((modMask, xK_Tab ), windows W.focusDown) -- %! Move focus to the next window+ , ((modMask, xK_j ), windows W.focusDown) -- %! Move focus to the next window+ , ((modMask, xK_k ), windows W.focusUp ) -- %! Move focus to the previous window+ , ((modMask, xK_m ), windows W.focusMaster ) -- %! Move focus to the master window++ -- modifying the window order+ , ((modMask, xK_Return), windows W.swapMaster) -- %! Swap the focused window and the master window+ , ((modMask .|. shiftMask, xK_j ), windows W.swapDown ) -- %! Swap the focused window with the next window+ , ((modMask .|. shiftMask, xK_k ), windows W.swapUp ) -- %! Swap the focused window with the previous window++ -- resizing the master/slave ratio+ , ((modMask, xK_h ), sendMessage Shrink) -- %! Shrink the master area+ , ((modMask, xK_l ), sendMessage Expand) -- %! Expand the master area++ -- floating layer support+ , ((modMask, xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling++ -- increase or decrease number of windows in the master area+ , ((modMask , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area+ , ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area++ -- toggle the status bar gap+ , ((modMask , xK_b ), modifyGap (\i n -> let x = (XMonad.defaultGaps conf ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap++ -- quit, or restart+ , ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit xmonad+ , ((modMask , xK_q ), broadcastMessage ReleaseResources >> restart (Just "xmonad") True) -- %! Restart xmonad+ ]+ +++ -- mod-[1..9] %! Switch to workspace N+ -- mod-shift-[1..9] %! Move client to workspace N+ [((m .|. modMask, k), windows $ f i)+ | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]+ , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]+ +++ -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3+ -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3+ [((m .|. modMask, key), screenWorkspace sc >>= flip whenJust (windows . f))+ | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]+ , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]++-- | Mouse bindings: default actions bound to mouse events+--+mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())+mouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList $+ -- mod-button1 %! Set the window to floating mode and move by dragging+ [ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w))+ -- mod-button2 %! Raise the window to the top of the stack+ , ((modMask, button2), (\w -> focus w >> windows W.swapMaster))+ -- mod-button3 %! Set the window to floating mode and resize by dragging+ , ((modMask, button3), (\w -> focus w >> mouseResizeWindow w))+ -- you may also bind events to the mouse scroll wheel (button4 and button5)+ ]++-- | And, finally, the default set of configuration values itself+defaultConfig = XConfig+ { XMonad.borderWidth = borderWidth+ , XMonad.workspaces = workspaces+ , XMonad.defaultGaps = defaultGaps+ , XMonad.layoutHook = layout+ , XMonad.terminal = terminal+ , XMonad.normalBorderColor = normalBorderColor+ , XMonad.focusedBorderColor = focusedBorderColor+ , XMonad.numlockMask = numlockMask+ , XMonad.modMask = defaultModMask+ , XMonad.keys = keys+ , XMonad.logHook = logHook+ , XMonad.mouseBindings = mouseBindings+ , XMonad.manageHook = manageHook }
+ XMonad/Core.hs view
@@ -0,0 +1,370 @@+{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving,+ MultiParamTypeClasses, TypeSynonymInstances #-}+-- required for deriving Typeable+{-# OPTIONS_GHC -fglasgow-exts #-}++-----------------------------------------------------------------------------+-- |+-- Module : XMonad/Core.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.Core (+ X, WindowSet, WindowSpace, WorkspaceId,+ ScreenId(..), ScreenDetail(..), XState(..),+ XConf(..), XConfig(..), LayoutClass(..),+ Layout(..), readsLayout, Typeable, Message,+ SomeMessage(..), fromMessage, runLayout, LayoutMessages(..),+ runX, catchX, userCode, io, catchIO,+ withDisplay, withWindowSet, isRoot,+ getAtom, spawn, restart, getXMonadDir, recompile, trace, whenJust, whenX,+ atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, ManageHook, Query(..), runManageHook+ ) where++import XMonad.StackSet++import Prelude hiding ( catch )+import Control.Exception (catch, bracket, throw, Exception(ExitException))+import Control.Applicative+import Control.Monad.State+import Control.Monad.Reader+import System.IO+import System.Posix.Process (executeFile, forkProcess, getProcessStatus, createSession)+import System.Process+import System.Directory+import System.Exit+import System.Environment+import Graphics.X11.Xlib+import Graphics.X11.Xlib.Extras (Event)+import Data.Typeable+import Data.Monoid++import qualified Data.Map as M+import qualified Data.Set as S++-- | XState, the window manager state.+-- Just the display, width, height and a window list+data XState = XState+ { windowset :: !WindowSet -- ^ workspace list+ , mapped :: !(S.Set Window) -- ^ the Set of mapped windows+ , waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents+ , dragging :: !(Maybe (Position -> Position -> X (), X ())) }++data XConf = XConf+ { display :: Display -- ^ the X11 display+ , config :: !(XConfig Layout) -- ^ initial user configuration+ , theRoot :: !Window -- ^ the root window+ , normalBorder :: !Pixel -- ^ border color of unfocused windows+ , focusedBorder :: !Pixel -- ^ border color of the focused window+ , keyActions :: !(M.Map (KeyMask, KeySym) (X ()))+ -- ^ a mapping of key presses to actions+ , buttonActions :: !(M.Map (KeyMask, Button) (Window -> X ()))+ -- ^ a mapping of button presses to actions+ }++-- todo, better name+data XConfig l = XConfig+ { normalBorderColor :: !String -- ^ Non focused windows border color. Default: \"#dddddd\"+ , focusedBorderColor :: !String -- ^ Focused windows border color. Default: \"#ff0000\"+ , terminal :: !String -- ^ The preferred terminal application. Default: \"xterm\"+ , layoutHook :: !(l Window) -- ^ The avaiable layouts+ , manageHook :: !ManageHook+ -- ^ The action to run when a new window is opened+ , workspaces :: [String] -- ^ The list of workspaces' names+ , defaultGaps :: [(Int,Int,Int,Int)] -- ^ The list of gaps, per screen+ , numlockMask :: !KeyMask -- ^ The numlock modifier+ , modMask :: !KeyMask -- ^ the mod modifier+ , keys :: XConfig Layout -> M.Map (ButtonMask,KeySym) (X ())+ -- ^ The key binding: a map from key presses and actions+ , mouseBindings :: XConfig Layout -> M.Map (ButtonMask, Button) (Window -> X ())+ -- ^ The mouse bindings+ , borderWidth :: !Dimension -- ^ The border width+ , logHook :: X () -- ^ The action to perform when the windows set is changed+ }+++type WindowSet = StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail+type WindowSpace = Workspace WorkspaceId (Layout Window) Window++-- | Virtual workspace indicies+type WorkspaceId = String++-- | Physical screen indicies+newtype ScreenId = S Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)++-- | The 'Rectangle' with screen dimensions and the list of gaps+data ScreenDetail = SD { screenRect :: !Rectangle+ , statusGap :: !(Int,Int,Int,Int) -- ^ width of status bar on the screen+ } deriving (Eq,Show, Read)++------------------------------------------------------------------------++-- | The X monad, a StateT transformer over IO encapsulating the window+-- manager state+--+-- Dynamic components may be retrieved with 'get', static components+-- with 'ask'. With newtype deriving we get readers and state monads+-- instantiated on XConf and XState automatically.+--+newtype X a = X (ReaderT XConf (StateT XState IO) a)+#ifndef __HADDOCK__+ deriving (Functor, Monad, MonadIO, MonadState XState, MonadReader XConf)+#endif++instance (Monoid a) => Monoid (X a) where+ mempty = return mempty+ mappend = liftM2 mappend++type ManageHook = Query (Endo WindowSet)+newtype Query a = Query (ReaderT Window X a)+#ifndef __HADDOCK__+ deriving (Functor, Monad, MonadReader Window, MonadIO)+#endif++runManageHook :: ManageHook -> Window -> X (WindowSet -> WindowSet)+runManageHook (Query m) w = appEndo <$> runReaderT m w++instance Monoid a => Monoid (Query a) where+ mempty = return mempty+ mappend = liftM2 mappend++-- | Run the X monad, given a chunk of X monad code, and an initial state+-- Return the result, and final state+runX :: XConf -> XState -> X a -> IO (a, XState)+runX c st (X a) = runStateT (runReaderT a c) st++-- | Run in the X monad, and in case of exception, and catch it and log it+-- to stderr, and run the error case.+catchX :: X a -> X a -> X a+catchX job errcase = do+ st <- get+ c <- ask+ (a, s') <- io $ runX c st job `catch` \e -> case e of+ ExitException {} -> throw e+ _ -> do hPrint stderr e; runX c st errcase+ put s'+ return a++-- | Execute the argument, catching all exceptions. Either this function or+-- catchX should be used at all callsites of user customized code.+userCode :: X () -> X ()+userCode a = catchX (a >> return ()) (return ())++-- ---------------------------------------------------------------------+-- Convenient wrappers to state++-- | Run a monad action with the current display settings+withDisplay :: (Display -> X a) -> X a+withDisplay f = asks display >>= f++-- | Run a monadic action with the current stack set+withWindowSet :: (WindowSet -> X a) -> X a+withWindowSet f = gets windowset >>= f++-- | True if the given window is the root window+isRoot :: Window -> X Bool+isRoot w = (w==) <$> asks theRoot++-- | Wrapper for the common case of atom internment+getAtom :: String -> X Atom+getAtom str = withDisplay $ \dpy -> io $ internAtom dpy str False++-- | Common non-predefined atoms+atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_STATE :: X Atom+atom_WM_PROTOCOLS = getAtom "WM_PROTOCOLS"+atom_WM_DELETE_WINDOW = getAtom "WM_DELETE_WINDOW"+atom_WM_STATE = getAtom "WM_STATE"++------------------------------------------------------------------------+-- | LayoutClass handling. See particular instances in Operations.hs++-- | An existential type that can hold any object that is in Read and LayoutClass.+data Layout a = forall l. (LayoutClass l a, Read (l a)) => Layout (l a)++-- | Using the 'Layout' as a witness, parse existentially wrapped windows+-- from a 'String'+readsLayout :: Layout a -> String -> [(Layout a, String)]+readsLayout (Layout l) s = [(Layout (asTypeOf x l), rs) | (x, rs) <- reads s]++-- | The different layout modes+--+-- 'doLayout': given a Rectangle and a Stack, layout the stack elements+-- inside the given Rectangle. If an element is not given a Rectangle+-- by 'doLayout', then it is not shown on screen. Windows are restacked+-- according to the order they are returned by 'doLayout'.+--+class Show (layout a) => LayoutClass layout a where++ -- | Given a Rectangle in which to place the windows, and a Stack of+ -- windows, return a list of windows and their corresponding Rectangles.+ -- The order of windows in this list should be the desired stacking order.+ -- Also return a modified layout, if this layout needs to be modified+ -- (e.g. if we keep track of the windows we have displayed).+ doLayout :: layout a -> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (layout a))+ doLayout l r s = return (pureLayout l r s, Nothing)++ -- | This is a pure version of doLayout, for cases where we don't need+ -- access to the X monad to determine how to layout the windows, and+ -- we don't need to modify our layout itself.+ pureLayout :: layout a -> Rectangle -> Stack a -> [(a, Rectangle)]+ pureLayout _ r s = [(focus s, r)]++ -- | 'handleMessage' performs message handling for that layout. If+ -- 'handleMessage' returns Nothing, then the layout did not respond to+ -- that message and the screen is not refreshed. Otherwise, 'handleMessage'+ -- returns an updated 'Layout' and the screen is refreshed.+ --+ handleMessage :: layout a -> SomeMessage -> X (Maybe (layout a))+ handleMessage l = return . pureMessage l++ -- | Respond to a message by (possibly) changing our layout, but taking+ -- no other action. If the layout changes, the screen will be refreshed.+ pureMessage :: layout a -> SomeMessage -> Maybe (layout a)+ pureMessage _ _ = Nothing++ -- | This should be a human-readable string that is used when selecting+ -- layouts by name.+ description :: layout a -> String+ description = show++instance LayoutClass Layout Window where+ doLayout (Layout l) r s = fmap (fmap Layout) `fmap` doLayout l r s+ handleMessage (Layout l) = fmap (fmap Layout) . handleMessage l+ description (Layout l) = description l++instance Show (Layout a) where show (Layout l) = show l++-- | This calls doLayout if there are any windows to be laid out.+runLayout :: LayoutClass l a => l a -> Rectangle -> Maybe (Stack a) -> X ([(a, Rectangle)], Maybe (l a))+runLayout l r = maybe (return ([], Nothing)) (doLayout l r)++-- | Based on ideas in /An Extensible Dynamically-Typed Hierarchy of Exceptions/,+-- Simon Marlow, 2006. Use extensible messages to the handleMessage handler.+--+-- User-extensible messages must be a member of this class.+--+class Typeable a => Message a++-- |+-- A wrapped value of some type in the Message class.+--+data SomeMessage = forall a. Message a => SomeMessage a++-- |+-- And now, unwrap a given, unknown Message type, performing a (dynamic)+-- type check on the result.+--+fromMessage :: Message m => SomeMessage -> Maybe m+fromMessage (SomeMessage m) = cast m++-- | X Events are valid Messages+instance Message Event++-- | LayoutMessages are core messages that all layouts (especially stateful+-- layouts) should consider handling.+data LayoutMessages = Hide -- ^ sent when a layout becomes non-visible+ | ReleaseResources -- ^ sent when xmonad is exiting or restarting+ deriving (Typeable, Eq)++instance Message LayoutMessages++-- ---------------------------------------------------------------------+-- | General utilities+--+-- Lift an IO action into the X monad+io :: MonadIO m => IO a -> m a+io = liftIO++-- | Lift an IO action into the X monad. If the action results in an IO+-- exception, log the exception to stderr and continue normal execution.+catchIO :: IO () -> X ()+catchIO f = io (f `catch` \e -> hPrint stderr e >> hFlush stderr)++-- | spawn. Launch an external application+spawn :: MonadIO m => String -> m ()+spawn x = doubleFork $ executeFile "/bin/sh" False ["-c", x] Nothing++-- | Double fork and execute an IO action (usually one of the exec family of+-- functions)+doubleFork :: MonadIO m => IO () -> m ()+doubleFork m = io $ do+ pid <- forkProcess $ do+ forkProcess (createSession >> m)+ exitWith ExitSuccess+ getProcessStatus True False pid+ return ()++-- | Restart xmonad via exec().+--+-- If the first parameter is 'Just name', restart will attempt to execute the+-- program corresponding to 'name'. Otherwise, xmonad will attempt to execute+-- the name of the current program.+--+-- When the second parameter is 'True', xmonad will attempt to resume with the+-- current window state.+restart :: Maybe String -> Bool -> X ()+restart mprog resume = do+ prog <- maybe (io getProgName) return mprog+ args <- if resume then gets (("--resume":) . return . showWs . windowset) else return []+ catchIO (executeFile prog True args Nothing)+ where showWs = show . mapLayout show++-- | Return the path to @~\/.xmonad@.+getXMonadDir :: MonadIO m => m String+getXMonadDir = io $ getAppUserDataDirectory "xmonad"++-- | 'recompile force', recompile ~\/.xmonad\/xmonad.hs when any of the+-- following apply:+-- * force is True+-- * the xmonad executable does not exist+-- * the xmonad executable is older than xmonad.hs+--+-- The -i flag is used to restrict recompilation to the xmonad.hs file only.+--+-- Compilation errors (if any) are logged to ~\/.xmonad\/xmonad.errors. If+-- GHC indicates failure with a non-zero exit code, an xmessage containing+-- GHC's is spawned.+--+recompile :: MonadIO m => Bool -> m ()+recompile force = io $ do+ dir <- getXMonadDir+ let bin = dir ++ "/" ++ "xmonad"+ err = bin ++ ".errors"+ src = bin ++ ".hs"+ srcT <- getModTime src+ binT <- getModTime bin+ when (force || srcT > binT) $ do+ status <- bracket (openFile err WriteMode) hClose $ \h -> do+ waitForProcess =<< runProcess "ghc" ["--make", "xmonad.hs", "-i", "-no-recomp", "-v0"] (Just dir)+ Nothing Nothing Nothing (Just h)++ -- now, if it fails, run xmessage to let the user know:+ when (status /= ExitSuccess) $ do+ ghcErr <- readFile err+ let msg = unlines $+ ["Error detected while loading xmonad configuration file: " ++ src]+ ++ lines ghcErr ++ ["","Please check the file for errors."]+ doubleFork $ executeFile "xmessage" True [msg] Nothing+ where getModTime f = catch (Just <$> getModificationTime f) (const $ return Nothing)++-- | Run a side effecting action with the current workspace. Like 'when' but+whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()+whenJust mg f = maybe (return ()) f mg++-- | Conditionally run an action, using a X event to decide+whenX :: X Bool -> X () -> X ()+whenX a f = a >>= \b -> when b f++-- | A 'trace' for the X monad. Logs a string to stderr. The result may+-- be found in your .xsession-errors file+trace :: MonadIO m => String -> m ()+trace = io . hPutStrLn stderr
+ XMonad/Layout.hs view
@@ -0,0 +1,175 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}++-- --------------------------------------------------------------------------+-- |+-- Module : Layouts.hs+-- Copyright : (c) Spencer Janssen 2007+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : sjanssen@cse.unl.edu+-- Stability : unstable+-- Portability : not portable, Typeable deriving, mtl, posix+--+-- The collection of core layouts.+--+-----------------------------------------------------------------------------++module XMonad.Layout (ChangeLayout(..), Choose, (|||), Resize(..), IncMasterN(..),+ Full(..), Tall(..), Mirror(..), mirrorRect, splitVertically,+ splitHorizontally, splitHorizontallyBy, splitVerticallyBy) where++import XMonad.Core++import Graphics.X11 (Rectangle(..))+import qualified XMonad.StackSet as W+import Control.Arrow ((***), second)+import Control.Monad+import Data.Maybe (fromMaybe)+++------------------------------------------------------------------------+-- LayoutClass selection manager++-- | A layout that allows users to switch between various layout options.++-- | Messages to change the current layout.+data ChangeLayout = FirstLayout | NextLayout deriving (Eq, Show, Typeable)++instance Message ChangeLayout++-- | The layout choice combinator+(|||) :: (LayoutClass l a, LayoutClass r a) => l a -> r a -> Choose l r a+(|||) = flip SLeft+infixr 5 |||++data Choose l r a = SLeft (r a) (l a)+ | SRight (l a) (r a) deriving (Read, Show)++data NextNoWrap = NextNoWrap deriving (Eq, Show, Typeable)+instance Message NextNoWrap++-- This has lots of pseudo duplicated code, we must find a better way+instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where+ doLayout (SLeft r l) = (fmap (second . fmap $ SLeft r) .) . doLayout l+ doLayout (SRight l r) = (fmap (second . fmap $ SRight l) .) . doLayout r++ description (SLeft _ l) = description l+ description (SRight _ r) = description r++ handleMessage lr m | Just FirstLayout <- fromMessage m = case lr of+ SLeft {} -> return Nothing+ SRight l r -> fmap (Just . flip SLeft l . fromMaybe r)+ $ handleMessage r (SomeMessage Hide)++ handleMessage lr m | Just NextLayout <- fromMessage m = do+ mlr <- handleMessage lr $ SomeMessage NextNoWrap+ maybe (handleMessage lr $ SomeMessage FirstLayout) (return . Just) mlr++ handleMessage (SLeft r l) m | Just NextNoWrap <- fromMessage m = do+ handleMessage l (SomeMessage Hide)+ mr <- handleMessage r (SomeMessage FirstLayout)+ return . Just . SRight l $ fromMaybe r mr++ handleMessage lr m | Just ReleaseResources <- fromMessage m =+ liftM2 ((Just .) . cons)+ (fmap (fromMaybe l) $ handleMessage l m)+ (fmap (fromMaybe r) $ handleMessage r m)+ where (cons, l, r) = case lr of+ (SLeft r' l') -> (flip SLeft, l', r')+ (SRight l' r') -> (SRight, l', r')++ -- The default cases for left and right:+ handleMessage (SLeft r l) m = fmap (fmap $ SLeft r) $ handleMessage l m+ handleMessage (SRight l r) m = fmap (fmap $ SRight l) $ handleMessage r m++--+-- | Builtin layout algorithms:+--+-- > fullscreen mode+-- > tall mode+--+-- The latter algorithms support the following operations:+--+-- > Shrink+-- > Expand+--+data Resize = Shrink | Expand deriving Typeable++-- | You can also increase the number of clients in the master pane+data IncMasterN = IncMasterN Int deriving Typeable++instance Message Resize+instance Message IncMasterN++-- | Simple fullscreen mode, just render all windows fullscreen.+data Full a = Full deriving (Show, Read)++instance LayoutClass Full a++-- | The inbuilt tiling mode of xmonad, and its operations.+data Tall a = Tall Int Rational Rational deriving (Show, Read)++instance LayoutClass Tall a where+ pureLayout (Tall nmaster _ frac) r s = zip ws rs+ where ws = W.integrate s+ rs = tile frac r nmaster (length ws)++ pureMessage (Tall nmaster delta frac) m = msum [fmap resize (fromMessage m)+ ,fmap incmastern (fromMessage m)]+ where resize Shrink = Tall nmaster delta (max 0 $ frac-delta)+ resize Expand = Tall nmaster delta (min 1 $ frac+delta)+ incmastern (IncMasterN d) = Tall (max 0 (nmaster+d)) delta frac+ description _ = "Tall"++-- | Mirror a rectangle+mirrorRect :: Rectangle -> Rectangle+mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw)++-- | Mirror a layout, compute its 90 degree rotated form.+data Mirror l a = Mirror (l a) deriving (Show, Read)++instance LayoutClass l a => LayoutClass (Mirror l) a where+ doLayout (Mirror l) r s = (map (second mirrorRect) *** fmap Mirror)+ `fmap` doLayout l (mirrorRect r) s+ handleMessage (Mirror l) = fmap (fmap Mirror) . handleMessage l+ description (Mirror l) = "Mirror "++ description l++-- | tile. Compute the positions for windows using the default 2 pane tiling algorithm.+--+-- The screen is divided (currently) into two panes. all clients are+-- then partioned between these two panes. one pane, the `master', by+-- convention has the least number of windows in it (by default, 1).+-- the variable `nmaster' controls how many windows are rendered in the+-- master pane.+--+-- `delta' specifies the ratio of the screen to resize by.+--+-- 'frac' specifies what proportion of the screen to devote to the+-- master area.+--+tile :: Rational -> Rectangle -> Int -> Int -> [Rectangle]+tile f r nmaster n = if n <= nmaster || nmaster == 0+ then splitVertically n r+ else splitVertically nmaster r1 ++ splitVertically (n-nmaster) r2 -- two columns+ where (r1,r2) = splitHorizontallyBy f r++--+-- Divide the screen vertically into n subrectangles+--+splitVertically, splitHorizontally :: Int -> Rectangle -> [Rectangle]+splitVertically n r | n < 2 = [r]+splitVertically n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh :+ splitVertically (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh))+ where smallh = sh `div` fromIntegral n --hmm, this is a fold or map.++splitHorizontally n = map mirrorRect . splitVertically n . mirrorRect++-- Divide the screen into two rectangles, using a rational to specify the ratio+splitHorizontallyBy, splitVerticallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)+splitHorizontallyBy f (Rectangle sx sy sw sh) =+ ( Rectangle sx sy leftw sh+ , Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh)+ where leftw = floor $ fromIntegral sw * f++splitVerticallyBy f = (mirrorRect *** mirrorRect) . splitHorizontallyBy f . mirrorRect
+ XMonad/Main.hs view
@@ -0,0 +1,279 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}+----------------------------------------------------------------------------+-- |+-- Module : Core.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+--+-- xmonad, a minimalist, tiling window manager for X11+--+-----------------------------------------------------------------------------++module XMonad.Main (xmonad) where++import Data.Bits+import qualified Data.Map as M+import qualified Data.Set as S+import Control.Monad.Reader+import Control.Monad.State+import Data.Maybe (fromMaybe)++import System.Environment (getArgs)++import Graphics.X11.Xlib hiding (refreshKeyboardMapping)+import Graphics.X11.Xlib.Extras+import Graphics.X11.Xinerama (getScreenInfo)++import XMonad.Core+import XMonad.StackSet (new, floating, member)+import qualified XMonad.StackSet as W+import XMonad.Operations++import System.IO++-- |+-- The main entry point+--+xmonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()+xmonad initxmc = do+ -- First, wrap the layout in an existential, to keep things pretty:+ let xmc = initxmc { layoutHook = Layout $ layoutHook initxmc }+ dpy <- openDisplay ""+ let dflt = defaultScreen dpy++ rootw <- rootWindow dpy dflt+ xinesc <- getScreenInfo dpy+ nbc <- initColor dpy $ normalBorderColor xmc+ fbc <- initColor dpy $ focusedBorderColor xmc+ hSetBuffering stdout NoBuffering+ args <- getArgs++ let layout = layoutHook xmc+ lreads = readsLayout layout+ initialWinset = new layout (workspaces xmc) $ zipWith SD xinesc gaps++ maybeRead reads' s = case reads' s of+ [(x, "")] -> Just x+ _ -> Nothing++ winset = fromMaybe initialWinset $ do+ ("--resume" : s : _) <- return args+ ws <- maybeRead reads s+ return . W.ensureTags layout (workspaces xmc)+ $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws++ gaps = take (length xinesc) $ defaultGaps xmc ++ repeat (0,0,0,0)++ cf = XConf+ { display = dpy+ , config = xmc+ , theRoot = rootw+ , normalBorder = nbc+ , focusedBorder = fbc+ , keyActions = keys xmc xmc+ , buttonActions = mouseBindings xmc xmc }+ st = XState+ { windowset = initialWinset+ , mapped = S.empty+ , waitingUnmap = M.empty+ , dragging = Nothing }++ xSetErrorHandler -- in C, I'm too lazy to write the binding: dons++ -- setup initial X environment+ sync dpy False+ selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask+ .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask++ allocaXEvent $ \e ->+ runX cf st $ do++ grabKeys+ grabButtons++ io $ sync dpy False++ -- bootstrap the windowset, Operations.windows will identify all+ -- the windows in winset as new and set initial properties for+ -- those windows+ windows (const winset)++ -- scan for all top-level windows, add the unmanaged ones to the+ -- windowset+ ws <- io $ scan dpy rootw+ mapM_ manage ws++ -- main loop, for all you HOF/recursion fans out there.+ forever_ $ handle =<< io (nextEvent dpy e >> getEvent e)++ return ()+ where forever_ a = a >> forever_ a+++-- ---------------------------------------------------------------------+-- | Event handler. Map X events onto calls into Operations.hs, which+-- modify our internal model of the window manager state.+--+-- Events dwm handles that we don't:+--+-- [ButtonPress] = buttonpress,+-- [Expose] = expose,+-- [PropertyNotify] = propertynotify,+--+handle :: Event -> X ()++-- run window manager command+handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})+ | t == keyPress = withDisplay $ \dpy -> do+ s <- io $ keycodeToKeysym dpy code 0+ mClean <- cleanMask m+ ks <- asks keyActions+ userCode $ whenJust (M.lookup (mClean, s) ks) id++-- manage a new window+handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do+ wa <- io $ getWindowAttributes dpy w -- ignore override windows+ -- need to ignore mapping requests by managed windows not on the current workspace+ managed <- isClient w+ when (not (wa_override_redirect wa) && not managed) $ do manage w++-- window destroyed, unmanage it+-- window gone, unmanage it+handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ unmanage w++-- We track expected unmap events in waitingUnmap. We ignore this event unless+-- it is synthetic or we are not expecting an unmap notification from a window.+handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do+ e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)+ if (synthetic || e == 0)+ then unmanage w+ else modify (\s -> s { waitingUnmap = M.adjust pred w (waitingUnmap s) })++-- set keyboard mapping+handle e@(MappingNotifyEvent {}) = do+ io $ refreshKeyboardMapping e+ when (ev_request e == mappingKeyboard) grabKeys++-- handle button release, which may finish dragging.+handle e@(ButtonEvent {ev_event_type = t})+ | t == buttonRelease = do+ drag <- gets dragging+ case drag of+ -- we're done dragging and have released the mouse:+ Just (_,f) -> modify (\s -> s { dragging = Nothing }) >> f+ Nothing -> broadcastMessage e++-- handle motionNotify event, which may mean we are dragging.+handle e@(MotionEvent {ev_event_type = _t, ev_x = x, ev_y = y}) = do+ drag <- gets dragging+ case drag of+ Just (d,_) -> d (fromIntegral x) (fromIntegral y) -- we're dragging+ Nothing -> broadcastMessage e++-- click on an unfocused window, makes it focused on this workspace+handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })+ | t == buttonPress = do+ -- If it's the root window, then it's something we+ -- grabbed in grabButtons. Otherwise, it's click-to-focus.+ isr <- isRoot w+ m <- cleanMask $ ev_state e+ ba <- asks buttonActions+ if isr then userCode $ whenJust (M.lookup (m, b) ba) ($ ev_subwindow e)+ else focus w+ sendMessage e -- Always send button events.++-- entered a normal window, makes this focused.+handle e@(CrossingEvent {ev_window = w, ev_event_type = t})+ | t == enterNotify && ev_mode e == notifyNormal+ && ev_detail e /= notifyInferior = focus w++-- left a window, check if we need to focus root+handle e@(CrossingEvent {ev_event_type = t})+ | t == leaveNotify+ = do rootw <- asks theRoot+ when (ev_window e == rootw && not (ev_same_screen e)) $ setFocusX rootw++-- configure a window+handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do+ ws <- gets windowset+ wa <- io $ getWindowAttributes dpy w++ bw <- asks (borderWidth . config)++ if M.member w (floating ws)+ || not (member w ws)+ then do io $ configureWindow dpy w (ev_value_mask e) $ WindowChanges+ { wc_x = ev_x e+ , wc_y = ev_y e+ , wc_width = ev_width e+ , wc_height = ev_height e+ , wc_border_width = fromIntegral bw+ , wc_sibling = ev_above e+ , wc_stack_mode = ev_detail e }+ when (member w ws) (float w)+ else io $ allocaXEvent $ \ev -> do+ setEventType ev configureNotify+ setConfigureEvent ev w w+ (wa_x wa) (wa_y wa) (wa_width wa)+ (wa_height wa) (ev_border_width e) none (wa_override_redirect wa)+ sendEvent dpy w False 0 ev+ io $ sync dpy False++-- configuration changes in the root may mean display settings have changed+handle (ConfigureEvent {ev_window = w}) = whenX (isRoot w) rescreen++-- property notify+handle PropertyEvent { ev_event_type = t, ev_atom = a }+ | t == propertyNotify && a == wM_NAME = userCode =<< asks (logHook . config)++handle e = broadcastMessage e -- trace (eventName e) -- ignoring+++-- ---------------------------------------------------------------------+-- IO stuff. Doesn't require any X state+-- Most of these things run only on startup (bar grabkeys)++-- | scan for any new windows to manage. If they're already managed,+-- this should be idempotent.+scan :: Display -> Window -> IO [Window]+scan dpy rootw = do+ (_, _, ws) <- queryTree dpy rootw+ filterM ok ws+ -- TODO: scan for windows that are either 'IsViewable' or where WM_STATE ==+ -- Iconic+ where ok w = do wa <- getWindowAttributes dpy w+ a <- internAtom dpy "WM_STATE" False+ p <- getWindowProperty32 dpy a w+ let ic = case p of+ Just (3:_) -> True -- 3 for iconified+ _ -> False+ return $ not (wa_override_redirect wa)+ && (wa_map_state wa == waIsViewable || ic)++-- | Grab the keys back+grabKeys :: X ()+grabKeys = do+ XConf { display = dpy, theRoot = rootw } <- ask+ let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync+ io $ ungrabKey dpy anyKey anyModifier rootw+ ks <- asks keyActions+ forM_ (M.keys ks) $ \(mask,sym) -> do+ kc <- io $ keysymToKeycode dpy sym+ -- "If the specified KeySym is not defined for any KeyCode,+ -- XKeysymToKeycode() returns zero."+ when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) =<< extraModifiers++-- | XXX comment me+grabButtons :: X ()+grabButtons = do+ XConf { display = dpy, theRoot = rootw } <- ask+ let grab button mask = io $ grabButton dpy button mask rootw False buttonPressMask+ grabModeAsync grabModeSync none none+ io $ ungrabButton dpy anyButton anyModifier rootw+ ems <- extraModifiers+ ba <- asks buttonActions+ mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ ba)
+ XMonad/ManageHook.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-----------------------------------------------------------------------------+-- |+-- Module : XMonad/ManageHook.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+--+-- An EDSL for ManageHooks+--+-----------------------------------------------------------------------------++-- XXX examples required++module XMonad.ManageHook where++import XMonad.Core+import Graphics.X11.Xlib.Extras+import Control.Monad.Reader+import Data.Maybe+import Data.Monoid+import qualified XMonad.StackSet as W+import XMonad.Operations (floatLocation, reveal)++liftX :: X a -> Query a+liftX = Query . lift++-- | The identity hook that returns the WindowSet unchanged.+idHook :: ManageHook+idHook = doF id++-- | Compose two 'ManageHook's+(<+>) :: ManageHook -> ManageHook -> ManageHook+(<+>) = mappend++-- | Compose the list of 'ManageHook's+composeAll :: [ManageHook] -> ManageHook+composeAll = mconcat++-- | 'p --> x'. If 'p' returns 'True', execute the 'ManageHook'.+(-->) :: Query Bool -> ManageHook -> ManageHook+p --> f = p >>= \b -> if b then f else mempty++-- | 'q =? x'. if the result of 'q' equals 'x', return 'True'.+(=?) :: Eq a => Query a -> a -> Query Bool+q =? x = fmap (== x) q++infixr 3 <&&>, <||>++-- | 'p <&&> q'. '&&' lifted to a Monad.+(<&&>) :: Monad m => m Bool -> m Bool -> m Bool+(<&&>) = liftM2 (&&)++-- | 'p <||> q'. '||' lifted to a Monad.+(<||>) :: Monad m => m Bool -> m Bool -> m Bool+(<||>) = liftM2 (||)++-- | Queries that return the window title, resource, or class.+title, resource, className :: Query String+title = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap (fromMaybe "") $ io $ fetchName d w)+resource = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resName $ io $ getClassHint d w)+className = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resClass $ io $ getClassHint d w)++-- | Modify the 'WindowSet' with a pure function.+doF :: (WindowSet -> WindowSet) -> ManageHook+doF = return . Endo++-- | Move the window to the floating layer.+doFloat :: ManageHook+doFloat = ask >>= \w -> doF . W.float w . snd =<< liftX (floatLocation w)++-- | Map the window and remove it from the 'WindowSet'.+doIgnore :: ManageHook+doIgnore = ask >>= \w -> liftX (reveal w) >> doF (W.delete w)
+ XMonad/Operations.hs view
@@ -0,0 +1,504 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}++-- --------------------------------------------------------------------------+-- |+-- Module : Operations.hs+-- Copyright : (c) Spencer Janssen 2007+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : dons@cse.unsw.edu.au+-- Stability : unstable+-- Portability : not portable, Typeable deriving, mtl, posix+--+-- Operations.+--+-----------------------------------------------------------------------------++module XMonad.Operations where++import XMonad.Core+import XMonad.Layout (Full(..))+import qualified XMonad.StackSet as W++import Data.Maybe+import Data.List (nub, (\\), find)+import Data.Bits ((.|.), (.&.), complement)+import Data.Ratio+import qualified Data.Map as M+import qualified Data.Set as S++import Control.Applicative+import Control.Monad.State+import Control.Monad.Reader++import System.IO+import Graphics.X11.Xlib+import Graphics.X11.Xinerama (getScreenInfo)+import Graphics.X11.Xlib.Extras++-- ---------------------------------------------------------------------+-- |+-- Window manager operations+-- manage. Add a new window to be managed in the current workspace.+-- Bring it into focus.+--+-- Whether the window is already managed, or not, it is mapped, has its+-- border set, and its event mask set.+--+manage :: Window -> X ()+manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do+ sh <- io $ getWMNormalHints d w++ let isFixedSize = sh_min_size sh /= Nothing && sh_min_size sh == sh_max_size sh+ isTransient <- isJust <$> io (getTransientForHint d w)++ (sc, rr) <- floatLocation w+ -- ensure that float windows don't go over the edge of the screen+ let adjust (W.RationalRect x y wid h) | x + wid > 1 || y + h > 1 || x < 0 || y < 0+ = W.RationalRect (0.5 - wid/2) (0.5 - h/2) wid h+ adjust r = r++ f ws | isFixedSize || isTransient = W.float w (adjust rr) . W.insertUp w . W.view i $ ws+ | otherwise = W.insertUp w ws+ where i = fromMaybe (W.tag . W.workspace . W.current $ ws) $ W.lookupWorkspace sc ws++ mh <- asks (manageHook . config)+ g <- runManageHook mh w `catchX` return id+ windows (g . f)++-- | unmanage. A window no longer exists, remove it from the window+-- list, on whatever workspace it is.+--+-- should also unmap?+--+unmanage :: Window -> X ()+unmanage w = do+ windows (W.delete w)+ setWMState w withdrawnState+ modify (\s -> s {mapped = S.delete w (mapped s), waitingUnmap = M.delete w (waitingUnmap s)})++-- | Modify the size of the status gap at the top of the current screen+-- Taking a function giving the current screen, and current geometry.+modifyGap :: (Int -> (Int,Int,Int,Int) -> (Int,Int,Int,Int)) -> X ()+modifyGap f = do+ windows $ \ws@(W.StackSet { W.current = c@(W.Screen { W.screenDetail = sd }) }) ->+ let n = fromIntegral . W.screen $ c+ g = f n . statusGap $ sd+ in ws { W.current = c { W.screenDetail = sd { statusGap = g } } }++-- | Kill the currently focused client. If we do kill it, we'll get a+-- delete notify back from X.+--+-- There are two ways to delete a window. Either just kill it, or if it+-- supports the delete protocol, send a delete event (e.g. firefox)+--+kill :: X ()+kill = withDisplay $ \d -> withFocused $ \w -> do+ wmdelt <- atom_WM_DELETE_WINDOW ; wmprot <- atom_WM_PROTOCOLS++ protocols <- io $ getWMProtocols d w+ io $ if wmdelt `elem` protocols+ then allocaXEvent $ \ev -> do+ setEventType ev clientMessage+ setClientMessageEvent ev w wmprot 32 wmdelt 0+ sendEvent d w False noEventMask ev+ else killClient d w >> return ()++-- ---------------------------------------------------------------------+-- Managing windows++-- | windows. Modify the current window list with a pure function, and refresh+windows :: (WindowSet -> WindowSet) -> X ()+windows f = do+ XState { windowset = old } <- get+ let oldvisible = concatMap (W.integrate' . W.stack . W.workspace) $ W.current old : W.visible old+ ws = f old+ XConf { display = d , normalBorder = nbc, focusedBorder = fbc } <- ask+ mapM_ setInitialProperties (W.allWindows ws \\ W.allWindows old)+ whenJust (W.peek old) $ \otherw -> io $ setWindowBorder d otherw nbc+ modify (\s -> s { windowset = ws })++ -- notify non visibility+ let tags_oldvisible = map (W.tag . W.workspace) $ W.current old : W.visible old+ gottenhidden = filter (`elem` tags_oldvisible) $ map W.tag $ W.hidden ws+ sendMessageToWorkspaces Hide gottenhidden++ -- for each workspace, layout the currently visible workspaces+ let allscreens = W.screens ws+ summed_visible = scanl (++) [] $ map (W.integrate' . W.stack . W.workspace) allscreens+ visible <- fmap concat $ forM (zip allscreens summed_visible) $ \ (w, vis) -> do+ let n = W.tag (W.workspace w)+ this = W.view n ws+ l = W.layout (W.workspace w)+ flt = filter (flip M.member (W.floating ws)) (W.index this)+ tiled = (W.stack . W.workspace . W.current $ this)+ >>= W.filter (`M.notMember` W.floating ws)+ >>= W.filter (`notElem` vis)+ (SD (Rectangle sx sy sw sh)+ (gt,gb,gl,gr)) = W.screenDetail w+ viewrect = Rectangle (sx + fromIntegral gl) (sy + fromIntegral gt)+ (sw - fromIntegral (gl + gr)) (sh - fromIntegral (gt + gb))++ -- just the tiled windows:+ -- now tile the windows on this workspace, modified by the gap+ (rs, ml') <- runLayout l viewrect tiled `catchX` runLayout (Layout Full) viewrect tiled+ mapM_ (uncurry tileWindow) rs+ whenJust ml' $ \l' -> runOnWorkspaces (\ww -> if W.tag ww == n+ then return $ ww { W.layout = l'}+ else return ww)++ -- now the floating windows:+ -- move/resize the floating windows, if there are any+ forM_ flt $ \fw -> whenJust (M.lookup fw (W.floating ws)) $+ \(W.RationalRect rx ry rw rh) -> do+ tileWindow fw $ Rectangle+ (sx + floor (toRational sw*rx)) (sy + floor (toRational sh*ry))+ (floor (toRational sw*rw)) (floor (toRational sh*rh))++ let vs = flt ++ map fst rs+ io $ restackWindows d vs+ -- return the visible windows for this workspace:+ return vs++ whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc+ setTopFocus+ asks (logHook . config) >>= userCode+ -- io performGC -- really helps, but seems to trigger GC bugs?++ -- hide every window that was potentially visible before, but is not+ -- given a position by a layout now.+ mapM_ hide (nub oldvisible \\ visible)++ clearEvents enterWindowMask++-- | setWMState. set the WM_STATE property+setWMState :: Window -> Int -> X ()+setWMState w v = withDisplay $ \dpy -> do+ a <- atom_WM_STATE+ io $ changeProperty32 dpy w a a propModeReplace [fromIntegral v, fromIntegral none]++-- | hide. Hide a window by unmapping it, and setting Iconified.+hide :: Window -> X ()+hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do+ io $ do selectInput d w (clientMask .&. complement structureNotifyMask)+ unmapWindow d w+ selectInput d w clientMask+ setWMState w iconicState+ -- this part is key: we increment the waitingUnmap counter to distinguish+ -- between client and xmonad initiated unmaps.+ modify (\s -> s { waitingUnmap = M.insertWith (+) w 1 (waitingUnmap s)+ , mapped = S.delete w (mapped s) })++-- | reveal. Show a window by mapping it and setting Normal+-- this is harmless if the window was already visible+reveal :: Window -> X ()+reveal w = withDisplay $ \d -> do+ setWMState w normalState+ io $ mapWindow d w+ modify (\s -> s { mapped = S.insert w (mapped s) })++-- | The client events that xmonad is interested in+clientMask :: EventMask+clientMask = structureNotifyMask .|. enterWindowMask .|. propertyChangeMask++-- | Set some properties when we initially gain control of a window+setInitialProperties :: Window -> X ()+setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do+ setWMState w iconicState+ io $ selectInput d w $ clientMask+ bw <- asks (borderWidth . config)+ io $ setWindowBorderWidth d w bw+ -- we must initially set the color of new windows, to maintain invariants+ -- required by the border setting in 'windows'+ io $ setWindowBorder d w nb++-- | refresh. Render the currently visible workspaces, as determined by+-- the StackSet. Also, set focus to the focused window.+--+-- This is our 'view' operation (MVC), in that it pretty prints our model+-- with X calls.+--+refresh :: X ()+refresh = windows id++-- | clearEvents. Remove all events of a given type from the event queue.+clearEvents :: EventMask -> X ()+clearEvents mask = withDisplay $ \d -> io $ do+ sync d False+ allocaXEvent $ \p -> fix $ \again -> do+ more <- checkMaskEvent d mask p+ when more again -- beautiful++-- | tileWindow. Moves and resizes w such that it fits inside the given+-- rectangle, including its border.+tileWindow :: Window -> Rectangle -> X ()+tileWindow w r = withDisplay $ \d -> do+ bw <- (fromIntegral . wa_border_width) <$> io (getWindowAttributes d w)+ -- give all windows at least 1x1 pixels+ let least x | x <= bw*2 = 1+ | otherwise = x - bw*2+ io $ moveResizeWindow d w (rect_x r) (rect_y r)+ (least $ rect_width r) (least $ rect_height r)+ reveal w++-- ---------------------------------------------------------------------++-- | rescreen. The screen configuration may have changed (due to+-- xrandr), update the state and refresh the screen, and reset the gap.+rescreen :: X ()+rescreen = do+ xinesc <- withDisplay (io . getScreenInfo)++ windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->+ let (xs, ys) = splitAt (length xinesc) $ map W.workspace (v:vs) ++ hs+ (a:as) = zipWith3 W.Screen xs [0..] $ zipWith SD xinesc gs+ sgs = map (statusGap . W.screenDetail) (v:vs)+ gs = take (length xinesc) (sgs ++ repeat (0,0,0,0))+ in ws { W.current = a+ , W.visible = as+ , W.hidden = ys }++-- ---------------------------------------------------------------------++-- | setButtonGrab. Tell whether or not to intercept clicks on a given window+setButtonGrab :: Bool -> Window -> X ()+setButtonGrab grab w = withDisplay $ \d -> io $+ if grab+ then forM_ [button1, button2, button3] $ \b ->+ grabButton d b anyModifier w False buttonPressMask+ grabModeAsync grabModeSync none none+ else ungrabButton d anyButton anyModifier w++-- ---------------------------------------------------------------------+-- Setting keyboard focus++-- | Set the focus to the window on top of the stack, or root+setTopFocus :: X ()+setTopFocus = withWindowSet $ maybe (setFocusX =<< asks theRoot) setFocusX . W.peek++-- | Set focus explicitly to window 'w' if it is managed by us, or root.+-- This happens if X notices we've moved the mouse (and perhaps moved+-- the mouse to a new screen).+focus :: Window -> X ()+focus w = withWindowSet $ \s -> do+ if W.member w s then when (W.peek s /= Just w) $ windows (W.focusWindow w)+ else whenX (isRoot w) $ setFocusX w++-- | Call X to set the keyboard focus details.+setFocusX :: Window -> X ()+setFocusX w = withWindowSet $ \ws -> do+ dpy <- asks display++ -- clear mouse button grab and border on other windows+ forM_ (W.current ws : W.visible ws) $ \wk -> do+ forM_ (W.index (W.view (W.tag (W.workspace wk)) ws)) $ \otherw -> do+ setButtonGrab True otherw++ -- If we ungrab buttons on the root window, we lose our mouse bindings.+ whenX (not <$> isRoot w) $ setButtonGrab False w+ io $ do setInputFocus dpy w revertToPointerRoot 0+ -- raiseWindow dpy w++------------------------------------------------------------------------+-- Message handling++-- | Throw a message to the current LayoutClass possibly modifying how we+-- layout the windows, then refresh.+sendMessage :: Message a => a -> X ()+sendMessage a = do+ w <- W.workspace . W.current <$> gets windowset+ ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing+ whenJust ml' $ \l' -> do+ windows $ \ws -> ws { W.current = (W.current ws)+ { W.workspace = (W.workspace $ W.current ws)+ { W.layout = l' }}}++-- | Send a message to a list of workspaces' layouts, without necessarily refreshing.+sendMessageToWorkspaces :: Message a => a -> [WorkspaceId] -> X ()+sendMessageToWorkspaces a l = runOnWorkspaces $ \w ->+ if W.tag w `elem` l+ then do ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing+ return $ w { W.layout = maybe (W.layout w) id ml' }+ else return w++-- | Send a message to all visible layouts, without necessarily refreshing.+-- This is how we implement the hooks, such as UnDoLayout.+broadcastMessage :: Message a => a -> X ()+broadcastMessage a = runOnWorkspaces $ \w -> do+ ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing+ return $ w { W.layout = maybe (W.layout w) id ml' }++-- | This is basically a map function, running a function in the X monad on+-- each workspace with the output of that function being the modified workspace.+runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X ()+runOnWorkspaces job =do+ ws <- gets windowset+ h <- mapM job $ W.hidden ws+ c:v <- mapM (\s -> (\w -> s { W.workspace = w}) <$> job (W.workspace s))+ $ W.current ws : W.visible ws+ modify $ \s -> s { windowset = ws { W.current = c, W.visible = v, W.hidden = h } }++-- | Set the layout of the currently viewed workspace+setLayout :: Layout Window -> X ()+setLayout l = do+ ss@(W.StackSet { W.current = c@(W.Screen { W.workspace = ws })}) <- gets windowset+ handleMessage (W.layout ws) (SomeMessage ReleaseResources)+ windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = l } } }++------------------------------------------------------------------------+-- Utilities++-- | Return workspace visible on screen 'sc', or Nothing.+screenWorkspace :: ScreenId -> X (Maybe WorkspaceId)+screenWorkspace sc = withWindowSet $ return . W.lookupWorkspace sc++-- | Apply an X operation to the currently focused window, if there is one.+withFocused :: (Window -> X ()) -> X ()+withFocused f = withWindowSet $ \w -> whenJust (W.peek w) f++-- | True if window is under management by us+isClient :: Window -> X Bool+isClient w = withWindowSet $ return . W.member w++-- | Combinations of extra modifier masks we need to grab keys\/buttons for.+-- (numlock and capslock)+extraModifiers :: X [KeyMask]+extraModifiers = do+ nlm <- asks (numlockMask . config)+ return [0, nlm, lockMask, nlm .|. lockMask ]++-- | Strip numlock\/capslock from a mask+cleanMask :: KeyMask -> X KeyMask+cleanMask km = do+ nlm <- asks (numlockMask . config)+ return (complement (nlm .|. lockMask) .&. km)++-- | Get the Pixel value for a named color+initColor :: Display -> String -> IO Pixel+initColor dpy c = (color_pixel . fst) <$> allocNamedColor dpy colormap c+ where colormap = defaultColormap dpy (defaultScreen dpy)++------------------------------------------------------------------------+-- | Floating layer support++-- | Given a window, find the screen it is located on, and compute+-- the geometry of that window wrt. that screen.+floatLocation :: Window -> X (ScreenId, W.RationalRect)+floatLocation w = withDisplay $ \d -> do+ ws <- gets windowset+ wa <- io $ getWindowAttributes d w+ bw <- fi <$> asks (borderWidth . config)++ -- XXX horrible+ let sc = fromMaybe (W.current ws) $ find (pointWithin (fi $ wa_x wa) (fi $ wa_y wa) . screenRect . W.screenDetail) $ W.screens ws+ sr = screenRect . W.screenDetail $ sc+ rr = W.RationalRect ((fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr))+ ((fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr))+ (fi (wa_width wa + bw*2) % fi (rect_width sr))+ (fi (wa_height wa + bw*2) % fi (rect_height sr))++ return (W.screen $ sc, rr)+ where fi x = fromIntegral x+ pointWithin :: Integer -> Integer -> Rectangle -> Bool+ pointWithin x y r = x >= fi (rect_x r) &&+ x < fi (rect_x r) + fi (rect_width r) &&+ y >= fi (rect_y r) &&+ y < fi (rect_y r) + fi (rect_height r)++-- | Make a tiled window floating, using its suggested rectangle+float :: Window -> X ()+float w = do+ (sc, rr) <- floatLocation w+ windows $ \ws -> W.float w rr . fromMaybe ws $ do+ i <- W.findTag w ws+ guard $ i `elem` map (W.tag . W.workspace) (W.screens ws)+ f <- W.peek ws+ sw <- W.lookupWorkspace sc ws+ return (W.focusWindow f . W.shiftWin sw w $ ws)++-- ---------------------------------------------------------------------+-- Mouse handling++-- | Accumulate mouse motion events+mouseDrag :: (Position -> Position -> X ()) -> X () -> X ()+mouseDrag f done = do+ drag <- gets dragging+ case drag of+ Just _ -> return () -- error case? we're already dragging+ Nothing -> do+ XConf { theRoot = root, display = d } <- ask+ io $ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask)+ grabModeAsync grabModeAsync none none currentTime+ modify $ \s -> s { dragging = Just (motion, cleanup) }+ where+ cleanup = do+ withDisplay $ io . flip ungrabPointer currentTime+ modify $ \s -> s { dragging = Nothing }+ done+ motion x y = do z <- f x y+ clearEvents pointerMotionMask+ return z++-- | XXX comment me+mouseMoveWindow :: Window -> X ()+mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do+ io $ raiseWindow d w+ wa <- io $ getWindowAttributes d w+ (_, _, _, ox', oy', _, _, _) <- io $ queryPointer d w+ let ox = fromIntegral ox'+ oy = fromIntegral oy'+ mouseDrag (\ex ey -> io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))+ (fromIntegral (fromIntegral (wa_y wa) + (ey - oy))))+ (float w)++-- | XXX comment me+mouseResizeWindow :: Window -> X ()+mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do+ io $ raiseWindow d w+ wa <- io $ getWindowAttributes d w+ sh <- io $ getWMNormalHints d w+ io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))+ mouseDrag (\ex ey -> do+ io $ resizeWindow d w `uncurry`+ applySizeHints sh (ex - fromIntegral (wa_x wa),+ ey - fromIntegral (wa_y wa)))+ (float w)++-- ---------------------------------------------------------------------+-- | Support for window size hints++type D = (Dimension, Dimension)++-- | Reduce the dimensions if needed to comply to the given SizeHints.+applySizeHints :: Integral a => SizeHints -> (a,a) -> D+applySizeHints sh (w,h) = applySizeHints' sh (fromIntegral $ max 1 w,+ fromIntegral $ max 1 h)++-- | XXX comment me+applySizeHints' :: SizeHints -> D -> D+applySizeHints' sh =+ maybe id applyMaxSizeHint (sh_max_size sh)+ . maybe id (\(bw, bh) (w, h) -> (w+bw, h+bh)) (sh_base_size sh)+ . maybe id applyResizeIncHint (sh_resize_inc sh)+ . maybe id applyAspectHint (sh_aspect sh)+ . maybe id (\(bw,bh) (w,h) -> (w-bw, h-bh)) (sh_base_size sh)++-- | Reduce the dimensions so their aspect ratio falls between the two given aspect ratios.+applyAspectHint :: (D, D) -> D -> D+applyAspectHint ((minx, miny), (maxx, maxy)) x@(w,h)+ | or [minx < 1, miny < 1, maxx < 1, maxy < 1] = x+ | w * maxy > h * maxx = (h * maxx `div` maxy, h)+ | w * miny < h * minx = (w, w * miny `div` minx)+ | otherwise = x++-- | Reduce the dimensions so they are a multiple of the size increments.+applyResizeIncHint :: D -> D -> D+applyResizeIncHint (iw,ih) x@(w,h) =+ if iw > 0 && ih > 0 then (w - w `mod` iw, h - h `mod` ih) else x++-- | Reduce the dimensions if they exceed the given maximum dimensions.+applyMaxSizeHint :: D -> D -> D+applyMaxSizeHint (mw,mh) x@(w,h) =+ if mw > 0 && mh > 0 then (min w mw,min h mh) else x
+ XMonad/StackSet.hs view
@@ -0,0 +1,574 @@+{-# LANGUAGE PatternGuards #-}++-----------------------------------------------------------------------------+-- |+-- Module : StackSet+-- Copyright : (c) Don Stewart 2007+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : dons@galois.com+-- Stability : experimental+-- Portability : portable, Haskell 98+--++module XMonad.StackSet (+ -- * Introduction+ -- $intro++ -- ** The Zipper+ -- $zipper++ -- ** Xinerama support+ -- $xinerama++ -- ** Master and Focus+ -- $focus++ StackSet(..), Workspace(..), Screen(..), Stack(..), RationalRect(..),+ -- * Construction+ -- $construction+ new, view, greedyView,+ -- * Xinerama operations+ -- $xinerama+ lookupWorkspace,+ screens, workspaces, allWindows,+ -- * Operations on the current stack+ -- $stackOperations+ peek, index, integrate, integrate', differentiate,+ focusUp, focusDown, focusMaster, focusWindow,+ tagMember, renameTag, ensureTags, member, findTag, mapWorkspace, mapLayout,+ -- * Modifying the stackset+ -- $modifyStackset+ insertUp, delete, delete', filter,+ -- * Setting the master window+ -- $settingMW+ swapUp, swapDown, swapMaster, modify, modify', float, sink, -- needed by users+ -- * Composite operations+ -- $composite+ shift, shiftWin,++ -- for testing+ abort+ ) where++import Prelude hiding (filter)+import Data.Maybe (listToMaybe,fromJust,isJust)+import qualified Data.List as L (deleteBy,find,splitAt,filter,nub)+import Data.List ( (\\) )+import qualified Data.Map as M (Map,insert,delete,empty)++-- $intro+--+-- The 'StackSet' data type encodes a window manager abstraction. The+-- window manager is a set of virtual workspaces. On each workspace is a+-- stack of windows. A given workspace is always current, and a given+-- window on each workspace has focus. The focused window on the current+-- workspace is the one which will take user input. It can be visualised+-- as follows:+--+-- > Workspace { 0*} { 1 } { 2 } { 3 } { 4 }+-- >+-- > Windows [1 [] [3* [6*] []+-- > ,2*] ,4+-- > ,5]+--+-- Note that workspaces are indexed from 0, windows are numbered+-- uniquely. A '*' indicates the window on each workspace that has+-- focus, and which workspace is current.++-- $zipper+--+-- We encode all the focus tracking directly in the data structure, with a 'zipper':+--+-- A Zipper is essentially an `updateable' and yet pure functional+-- cursor into a data structure. Zipper is also a delimited+-- continuation reified as a data structure.+--+-- The Zipper lets us replace an item deep in a complex data+-- structure, e.g., a tree or a term, without an mutation. The+-- resulting data structure will share as much of its components with+-- the old structure as possible.+--+-- Oleg Kiselyov, 27 Apr 2005, haskell\@, "Zipper as a delimited continuation"+--+-- We use the zipper to keep track of the focused workspace and the+-- focused window on each workspace, allowing us to have correct focus+-- by construction. We closely follow Huet's original implementation:+--+-- G. Huet, /Functional Pearl: The Zipper/,+-- 1997, J. Functional Programming 75(5):549-554.+-- and:+-- R. Hinze and J. Jeuring, /Functional Pearl: The Web/.+--+-- and Conor McBride's zipper differentiation paper.+-- Another good reference is:+--+-- The Zipper, Haskell wikibook++-- $xinerama+-- Xinerama in X11 lets us view multiple virtual workspaces+-- simultaneously. While only one will ever be in focus (i.e. will+-- receive keyboard events), other workspaces may be passively+-- viewable. We thus need to track which virtual workspaces are+-- associated (viewed) on which physical screens. To keep track of+-- this, StackSet keeps separate lists of visible but non-focused+-- workspaces, and non-visible workspaces. ++-- $focus+--+-- Each stack tracks a focused item, and for tiling purposes also tracks+-- a 'master' position. The connection between 'master' and 'focus'+-- needs to be well defined, particularly in relation to 'insert' and+-- 'delete'.+--++-- |+-- API changes from xmonad 0.1:+-- StackSet constructor arguments changed. StackSet workspace window screen+--+-- * new, -- was: empty+--+-- * view,+--+-- * index,+--+-- * peek, -- was: peek\/peekStack+--+-- * focusUp, focusDown, -- was: rotate+--+-- * swapUp, swapDown+--+-- * focus -- was: raiseFocus+--+-- * insertUp, -- was: insert\/push+--+-- * delete,+--+-- * swapMaster, -- was: promote\/swap+--+-- * member,+--+-- * shift,+--+-- * lookupWorkspace, -- was: workspace+--+-- * visibleWorkspaces -- gone.+--+------------------------------------------------------------------------+-- |+-- A cursor into a non-empty list of workspaces.+--+-- We puncture the workspace list, producing a hole in the structure+-- used to track the currently focused workspace. The two other lists+-- that are produced are used to track those workspaces visible as+-- Xinerama screens, and those workspaces not visible anywhere.++data StackSet i l a sid sd =+ StackSet { current :: !(Screen i l a sid sd) -- ^ currently focused workspace+ , visible :: [Screen i l a sid sd] -- ^ non-focused workspaces, visible in xinerama+ , hidden :: [Workspace i l a] -- ^ workspaces not visible anywhere+ , floating :: M.Map a RationalRect -- ^ floating windows+ } deriving (Show, Read, Eq)++-- | Visible workspaces, and their Xinerama screens.+data Screen i l a sid sd = Screen { workspace :: !(Workspace i l a)+ , screen :: !sid+ , screenDetail :: !sd }+ deriving (Show, Read, Eq)++-- |+-- A workspace is just a tag - its index - and a stack+--+data Workspace i l a = Workspace { tag :: !i, layout :: l, stack :: Maybe (Stack a) }+ deriving (Show, Read, Eq)++-- | A structure for window geometries+data RationalRect = RationalRect Rational Rational Rational Rational+ deriving (Show, Read, Eq)++-- |+-- A stack is a cursor onto a (possibly empty) window list.+-- The data structure tracks focus by construction, and+-- the master window is by convention the top-most item.+-- Focus operations will not reorder the list that results from+-- flattening the cursor. The structure can be envisaged as:+--+-- > +-- master: < '7' >+-- > up | [ '2' ]+-- > +--------- [ '3' ]+-- > focus: < '4' >+-- > dn +----------- [ '8' ]+--+-- A 'Stack' can be viewed as a list with a hole punched in it to make+-- the focused position. Under the zipper\/calculus view of such+-- structures, it is the differentiation of a [a], and integrating it+-- back has a natural implementation used in 'index'.+--+data Stack a = Stack { focus :: !a -- focused thing in this set+ , up :: [a] -- clowns to the left+ , down :: [a] } -- jokers to the right+ deriving (Show, Read, Eq)+++-- | this function indicates to catch that an error is expected+abort :: String -> a+abort x = error $ "xmonad: StackSet: " ++ x++-- ---------------------------------------------------------------------+-- $construction++-- | /O(n)/. Create a new stackset, of empty stacks, with given tags,+-- with physical screens whose descriptions are given by 'm'. The+-- number of physical screens (@length 'm'@) should be less than or+-- equal to the number of workspace tags. The first workspace in the+-- list will be current.+--+-- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.+--+new :: (Integral s) => l -> [i] -> [sd] -> StackSet i l a s sd+new l wids m | not (null wids) && length m <= length wids = StackSet cur visi unseen M.empty+ where (seen,unseen) = L.splitAt (length m) $ map (\i -> Workspace i l Nothing) wids+ (cur:visi) = [ Screen i s sd | (i, s, sd) <- zip3 seen [0..] m ]+ -- now zip up visibles with their screen id+new _ _ _ = abort "non-positive argument to StackSet.new"++-- |+-- /O(w)/. Set focus to the workspace with index \'i\'.+-- If the index is out of range, return the original StackSet.+--+-- Xinerama: If the workspace is not visible on any Xinerama screen, it+-- becomes the current screen. If it is in the visible list, it becomes+-- current.++view :: (Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd+view i s+ | not (i `tagMember` s)+ || i == tag (workspace (current s)) = s -- out of bounds or current++ | Just x <- L.find ((i==).tag.workspace) (visible s)+ -- if it is visible, it is just raised+ = s { current = x, visible = current s : L.deleteBy (equating screen) x (visible s) }++ | Just x <- L.find ((i==).tag) (hidden s) -- must be hidden then+ -- if it was hidden, it is raised on the xine screen currently used+ = s { current = (current s) { workspace = x }+ , hidden = workspace (current s) : L.deleteBy (equating tag) x (hidden s) }++ | otherwise = s -- can't happen: all workspaces are either invalid, current, visible, or hidden++ where equating f = \x y -> f x == f y++ -- 'Catch'ing this might be hard. Relies on monotonically increasing+ -- workspace tags defined in 'new'+ --+ -- and now tags are not monotonic, what happens here?++-- |+-- Set focus to the given workspace. If that workspace does not exist+-- in the stackset, the original workspace is returned. If that workspace is+-- 'hidden', then display that workspace on the current screen, and move the+-- current workspace to 'hidden'. If that workspace is 'visible' on another+-- screen, the workspaces of the current screen and the other screen are+-- swapped.++greedyView :: (Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd+greedyView w ws+ | any wTag (hidden ws) = view w ws+ | (Just s) <- L.find (wTag . workspace) (visible ws)+ = ws { current = (current ws) { workspace = workspace s }+ , visible = s { workspace = workspace (current ws) }+ : L.filter (not . wTag . workspace) (visible ws) }+ | otherwise = ws+ where wTag = (w == ) . tag++-- ---------------------------------------------------------------------+-- $xinerama++-- | Find the tag of the workspace visible on Xinerama screen 'sc'.+-- Nothing if screen is out of bounds.+lookupWorkspace :: Eq s => s -> StackSet i l a s sd -> Maybe i+lookupWorkspace sc w = listToMaybe [ tag i | Screen i s _ <- current w : visible w, s == sc ]++-- ---------------------------------------------------------------------+-- $stackOperations++-- |+-- The 'with' function takes a default value, a function, and a+-- StackSet. If the current stack is Nothing, 'with' returns the+-- default value. Otherwise, it applies the function to the stack,+-- returning the result. It is like 'maybe' for the focused workspace.+--+with :: b -> (Stack a -> b) -> StackSet i l a s sd -> b+with dflt f = maybe dflt f . stack . workspace . current++-- |+-- Apply a function, and a default value for Nothing, to modify the current stack.+--+modify :: Maybe (Stack a) -> (Stack a -> Maybe (Stack a)) -> StackSet i l a s sd -> StackSet i l a s sd+modify d f s = s { current = (current s)+ { workspace = (workspace (current s)) { stack = with d f s }}}++-- |+-- Apply a function to modify the current stack if it isn't empty, and we don't+-- want to empty it.+--+modify' :: (Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd+modify' f = modify Nothing (Just . f)++-- |+-- /O(1)/. Extract the focused element of the current stack.+-- Return Just that element, or Nothing for an empty stack.+--+peek :: StackSet i l a s sd -> Maybe a+peek = with Nothing (return . focus)++-- |+-- /O(n)/. Flatten a Stack into a list.+--+integrate :: Stack a -> [a]+integrate (Stack x l r) = reverse l ++ x : r++-- |+-- /O(n)/ Flatten a possibly empty stack into a list.+integrate' :: Maybe (Stack a) -> [a]+integrate' = maybe [] integrate++-- | +-- /O(n)/. Turn a list into a possibly empty stack (i.e., a zipper):+-- the first element of the list is current, and the rest of the list+-- is down.+differentiate :: [a] -> Maybe (Stack a)+differentiate [] = Nothing+differentiate (x:xs) = Just $ Stack x [] xs++-- |+-- /O(n)/. 'filter p s' returns the elements of 's' such that 'p' evaluates to+-- True. Order is preserved, and focus moves as described for 'delete'.+--+filter :: (a -> Bool) -> Stack a -> Maybe (Stack a)+filter p (Stack f ls rs) = case L.filter p (f:rs) of+ f':rs' -> Just $ Stack f' (L.filter p ls) rs' -- maybe move focus down+ [] -> case L.filter p ls of -- filter back up+ f':ls' -> Just $ Stack f' ls' [] -- else up+ [] -> Nothing++-- |+-- /O(s)/. Extract the stack on the current workspace, as a list.+-- The order of the stack is determined by the master window -- it will be+-- the head of the list. The implementation is given by the natural+-- integration of a one-hole list cursor, back to a list.+--+index :: StackSet i l a s sd -> [a]+index = with [] integrate++-- |+-- /O(1), O(w) on the wrapping case/.+--+-- focusUp, focusDown. Move the window focus up or down the stack,+-- wrapping if we reach the end. The wrapping should model a 'cycle'+-- on the current stack. The 'master' window, and window order,+-- are unaffected by movement of focus.+--+-- swapUp, swapDown, swap the neighbour in the stack ordering, wrapping+-- if we reach the end. Again the wrapping model should 'cycle' on+-- the current stack.+--+focusUp, focusDown, swapUp, swapDown :: StackSet i l a s sd -> StackSet i l a s sd+focusUp = modify' focusUp'+focusDown = modify' (reverseStack . focusUp' . reverseStack)++swapUp = modify' swapUp'+swapDown = modify' (reverseStack . swapUp' . reverseStack)++focusUp', swapUp' :: Stack a -> Stack a+focusUp' (Stack t (l:ls) rs) = Stack l ls (t:rs)+focusUp' (Stack t [] rs) = Stack x xs [] where (x:xs) = reverse (t:rs)++swapUp' (Stack t (l:ls) rs) = Stack t ls (l:rs)+swapUp' (Stack t [] rs) = Stack t (reverse rs) []++-- | reverse a stack: up becomes down and down becomes up.+reverseStack :: Stack a -> Stack a+reverseStack (Stack t ls rs) = Stack t rs ls++--+-- | /O(1) on current window, O(n) in general/. Focus the window 'w',+-- and set its workspace as current.+--+focusWindow :: (Eq s, Eq a, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd+focusWindow w s | Just w == peek s = s+ | otherwise = maybe s id $ do+ n <- findTag w s+ return $ until ((Just w ==) . peek) focusUp (view n s)++-- | Get a list of all screens in the StackSet.+screens :: StackSet i l a s sd -> [Screen i l a s sd]+screens s = current s : visible s++-- | Get a list of all workspaces in the StackSet.+workspaces :: StackSet i l a s sd -> [Workspace i l a]+workspaces s = workspace (current s) : map workspace (visible s) ++ hidden s++-- | Get a list of all windows in the StackSet in no particular order+allWindows :: Eq a => StackSet i l a s sd -> [a]+allWindows = L.nub . concatMap (integrate' . stack) . workspaces++-- | Is the given tag present in the StackSet?+tagMember :: Eq i => i -> StackSet i l a s sd -> Bool+tagMember t = elem t . map tag . workspaces++-- | Rename a given tag if present in the StackSet.+renameTag :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd+renameTag o n = mapWorkspace rename+ where rename w = if tag w == o then w { tag = n } else w++-- | Ensure that a given set of workspace tags is present by renaming+-- existing workspaces and\/or creating new hidden workspaces as+-- necessary.+ensureTags :: Eq i => l -> [i] -> StackSet i l a s sd -> StackSet i l a s sd+ensureTags l allt st = et allt (map tag (workspaces st) \\ allt) st+ where et [] _ s = s+ et (i:is) rn s | i `tagMember` s = et is rn s+ et (i:is) [] s = et is [] (s { hidden = Workspace i l Nothing : hidden s })+ et (i:is) (r:rs) s = et is rs $ renameTag r i s++-- | Map a function on all the workspaces in the StackSet.+mapWorkspace :: (Workspace i l a -> Workspace i l a) -> StackSet i l a s sd -> StackSet i l a s sd+mapWorkspace f s = s { current = updScr (current s)+ , visible = map updScr (visible s)+ , hidden = map f (hidden s) }+ where updScr scr = scr { workspace = f (workspace scr) }++-- | Map a function on all the layouts in the StackSet.+mapLayout :: (l -> l') -> StackSet i l a s sd -> StackSet i l' a s sd+mapLayout f (StackSet v vs hs m) = StackSet (fScreen v) (map fScreen vs) (map fWorkspace hs) m+ where+ fScreen (Screen ws s sd) = Screen (fWorkspace ws) s sd+ fWorkspace (Workspace t l s) = Workspace t (f l) s++-- | /O(n)/. Is a window in the StackSet.+member :: Eq a => a -> StackSet i l a s sd -> Bool+member a s = isJust (findTag a s)++-- | /O(1) on current window, O(n) in general/.+-- Return Just the workspace tag of the given window, or Nothing+-- if the window is not in the StackSet.+findTag :: Eq a => a -> StackSet i l a s sd -> Maybe i+findTag a s = listToMaybe+ [ tag w | w <- workspaces s, has a (stack w) ]+ where has _ Nothing = False+ has x (Just (Stack t l r)) = x `elem` (t : l ++ r)++-- ---------------------------------------------------------------------+-- $modifyStackset++-- |+-- /O(n)/. (Complexity due to duplicate check). Insert a new element+-- into the stack, above the currently focused element. The new+-- element is given focus; the previously focused element is moved+-- down.+--+-- If the element is already in the stackset, the original stackset is+-- returned unmodified.+--+-- Semantics in Huet's paper is that insert doesn't move the cursor.+-- However, we choose to insert above, and move the focus.+--+insertUp :: Eq a => a -> StackSet i l a s sd -> StackSet i l a s sd+insertUp a s = if member a s then s else insert+ where insert = modify (Just $ Stack a [] []) (\(Stack t l r) -> Just $ Stack a l (t:r)) s++-- insertDown :: a -> StackSet i l a s sd -> StackSet i l a s sd+-- insertDown a = modify (Stack a [] []) $ \(Stack t l r) -> Stack a (t:l) r+-- Old semantics, from Huet.+-- > w { down = a : down w }++-- |+-- /O(1) on current window, O(n) in general/. Delete window 'w' if it exists.+-- There are 4 cases to consider:+--+-- * delete on an Nothing workspace leaves it Nothing+-- * otherwise, try to move focus to the down+-- * otherwise, try to move focus to the up+-- * otherwise, you've got an empty workspace, becomes Nothing+--+-- Behaviour with respect to the master:+--+-- * deleting the master window resets it to the newly focused window+-- * otherwise, delete doesn't affect the master.+--+delete :: (Ord a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd+delete w = sink w . delete' w++-- | Only temporarily remove the window from the stack, thereby not destroying special+-- information saved in the Stackset+delete' :: (Eq a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd+delete' w s = s { current = removeFromScreen (current s)+ , visible = map removeFromScreen (visible s)+ , hidden = map removeFromWorkspace (hidden s) }+ where removeFromWorkspace ws = ws { stack = stack ws >>= filter (/=w) }+ removeFromScreen scr = scr { workspace = removeFromWorkspace (workspace scr) }++------------------------------------------------------------------------++-- | Given a window, and its preferred rectangle, set it as floating+-- A floating window should already be managed by the StackSet.+float :: Ord a => a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd+float w r s = s { floating = M.insert w r (floating s) }++-- | Clear the floating status of a window+sink :: Ord a => a -> StackSet i l a s sd -> StackSet i l a s sd+sink w s = s { floating = M.delete w (floating s) }++------------------------------------------------------------------------+-- $settingMW++-- | /O(s)/. Set the master window to the focused window.+-- The old master window is swapped in the tiling order with the focused window.+-- Focus stays with the item moved.+swapMaster :: StackSet i l a s sd -> StackSet i l a s sd+swapMaster = modify' $ \c -> case c of+ Stack _ [] _ -> c -- already master.+ Stack t ls rs -> Stack t [] (xs ++ x : rs) where (x:xs) = reverse ls++-- natural! keep focus, move current to the top, move top to current.++-- | /O(s)/. Set focus to the master window.+focusMaster :: StackSet i l a s sd -> StackSet i l a s sd+focusMaster = modify' $ \c -> case c of+ Stack _ [] _ -> c+ Stack t ls rs -> Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls++--+-- ---------------------------------------------------------------------+-- $composite++-- | /O(w)/. shift. Move the focused element of the current stack to stack+-- 'n', leaving it as the focused element on that stack. The item is+-- inserted above the currently focused element on that workspace.+-- The actual focused workspace doesn't change. If there is no+-- element on the current stack, the original stackSet is returned.+--+shift :: (Ord a, Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd+shift n s | n `tagMember` s && n /= curtag = maybe s go (peek s)+ | otherwise = s+ where go w = view curtag . insertUp w . view n . delete' w $ s+ curtag = tag (workspace (current s))++-- | /O(n)/. shiftWin. Searches for the specified window 'w' on all workspaces+-- of the stackSet and moves it to stack 'n', leaving it as the focused+-- element on that stack. The item is inserted above the currently+-- focused element on that workspace.+-- The actual focused workspace doesn't change. If the window is not+-- found in the stackSet, the original stackSet is returned.+-- TODO how does this duplicate 'shift's behaviour?+shiftWin :: (Ord a, Eq a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd+shiftWin n w s | from == Nothing = s -- not found+ | n `tagMember` s && (Just n) /= from = go+ | otherwise = s+ where from = findTag w s++ go = on n (insertUp w) . on (fromJust from) (delete' w) $ s+ curtag = tag (workspace (current s))+ on i f = view curtag . f . view i+
man/xmonad.1 view
@@ -38,7 +38,7 @@ .SS Default keyboard bindings .IP \fBmod-shift-return\fR-Launch an xterm+Launch terminal .IP \fBmod-p\fR Launch dmenu
+ man/xmonad.hs view
@@ -0,0 +1,276 @@+--+-- xmonad example config file.+--+-- A template showing all available configuration hooks,+-- and how to override the defaults in your own xmonad.hs conf file.+--+-- Normally, you'd only override those defaults you care about.+--++import XMonad+import System.Exit++import qualified XMonad.StackSet as W+import qualified Data.Map as M++-- The preferred terminal program, which is used in a binding below and by+-- certain contrib modules.+--+myTerminal = "xterm"++-- Width of the window border in pixels.+--+myBorderWidth = 1++-- modMask lets you specify which modkey you want to use. The default+-- is mod1Mask ("left alt"). You may also consider using mod3Mask+-- ("right alt"), which does not conflict with emacs keybindings. The+-- "windows key" is usually mod4Mask.+--+myModMask = mod1Mask++-- The mask for the numlock key. Numlock status is "masked" from the+-- current modifier status, so the keybindings will work with numlock on or+-- off. You may need to change this on some systems.+--+-- You can find the numlock modifier by running "xmodmap" and looking for a+-- modifier with Num_Lock bound to it:+--+-- > $ xmodmap | grep Num+-- > mod2 Num_Lock (0x4d)+--+-- Set numlockMask = 0 if you don't have a numlock key, or want to treat+-- numlock status separately.+--+myNumlockMask = mod2Mask++-- The default number of workspaces (virtual screens) and their names.+-- By default we use numeric strings, but any string may be used as a+-- workspace name. The number of workspaces is determined by the length+-- of this list.+--+-- A tagging example:+--+-- > workspaces = ["web", "irc", "code" ] ++ map show [4..9]+--+myWorkspaces = ["1","2","3","4","5","6","7","8","9"]++-- Border colors for unfocused and focused windows, respectively.+--+myNormalBorderColor = "#dddddd"+myFocusedBorderColor = "#ff0000"++-- Default offset of drawable screen boundaries from each physical+-- screen. Anything non-zero here will leave a gap of that many pixels+-- on the given edge, on the that screen. A useful gap at top of screen+-- for a menu bar (e.g. 15)+--+-- An example, to set a top gap on monitor 1, and a gap on the bottom of+-- monitor 2, you'd use a list of geometries like so:+--+-- > defaultGaps = [(18,0,0,0),(0,18,0,0)] -- 2 gaps on 2 monitors+--+-- Fields are: top, bottom, left, right.+--+myDefaultGaps = [(0,0,0,0)]++------------------------------------------------------------------------+-- Key bindings. Add, modify or remove key bindings here.+--+myKeys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $++ -- launch a terminal+ [ ((modMask .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf)++ -- launch dmenu+ , ((modMask, xK_p ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"")++ -- launch gmrun+ , ((modMask .|. shiftMask, xK_p ), spawn "gmrun")++ -- close focused window + , ((modMask .|. shiftMask, xK_c ), kill)++ -- Rotate through the available layout algorithms+ , ((modMask, xK_space ), sendMessage NextLayout)++ -- Reset the layouts on the current workspace to default+ , ((modMask .|. shiftMask, xK_space ), setLayout $ XMonad.layoutHook conf)++ -- Resize viewed windows to the correct size+ , ((modMask, xK_n ), refresh)++ -- Move focus to the next window+ , ((modMask, xK_Tab ), windows W.focusDown)++ -- Move focus to the next window+ , ((modMask, xK_j ), windows W.focusDown)++ -- Move focus to the previous window+ , ((modMask, xK_k ), windows W.focusUp )++ -- Move focus to the master window+ , ((modMask, xK_m ), windows W.focusMaster )++ -- Swap the focused window and the master window+ , ((modMask, xK_Return), windows W.swapMaster)++ -- Swap the focused window with the next window+ , ((modMask .|. shiftMask, xK_j ), windows W.swapDown )++ -- Swap the focused window with the previous window+ , ((modMask .|. shiftMask, xK_k ), windows W.swapUp )++ -- Shrink the master area+ , ((modMask, xK_h ), sendMessage Shrink)++ -- Expand the master area+ , ((modMask, xK_l ), sendMessage Expand)++ -- Push window back into tiling+ , ((modMask, xK_t ), withFocused $ windows . W.sink)++ -- Increment the number of windows in the master area+ , ((modMask , xK_comma ), sendMessage (IncMasterN 1))++ -- Deincrement the number of windows in the master area+ , ((modMask , xK_period), sendMessage (IncMasterN (-1)))++ -- toggle the status bar gap+ , ((modMask , xK_b ),+ modifyGap (\i n -> let x = (XMonad.defaultGaps conf ++ repeat (0,0,0,0)) !! i+ in if n == x then (0,0,0,0) else x))++ -- Quit xmonad+ , ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess))++ -- Restart xmonad+ , ((modMask , xK_q ),+ broadcastMessage ReleaseResources >> restart (Just "xmonad") True)+ ]+ ++++ --+ -- mod-[1..9], Switch to workspace N+ -- mod-shift-[1..9], Move client to workspace N+ --+ [((m .|. modMask, k), windows $ f i)+ | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]+ , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]+ ++++ --+ -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3+ -- mod-shift-{w,e,r}, Move client to screen 1, 2, or 3+ --+ [((m .|. modMask, key), screenWorkspace sc >>= flip whenJust (windows . f))+ | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]+ , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]+++------------------------------------------------------------------------+-- Mouse bindings: default actions bound to mouse events+--+myMouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList $++ -- mod-button1, Set the window to floating mode and move by dragging+ [ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w))++ -- mod-button2, Raise the window to the top of the stack+ , ((modMask, button2), (\w -> focus w >> windows W.swapMaster))++ -- mod-button3, Set the window to floating mode and resize by dragging+ , ((modMask, button3), (\w -> focus w >> mouseResizeWindow w))++ -- you may also bind events to the mouse scroll wheel (button4 and button5)+ ]++------------------------------------------------------------------------+-- Layouts:++-- You can specify and transform your layouts by modifying these values.+-- If you change layout bindings be sure to use 'mod-shift-space' after+-- restarting (with 'mod-q') to reset your layout state to the new+-- defaults, as xmonad preserves your old layout settings by default.+--+-- The available layouts. Note that each layout is separated by |||,+-- which denotes layout choice.+--+myLayout = tiled ||| Mirror tiled ||| Full+ where+ -- default tiling algorithm partitions the screen into two panes+ tiled = Tall nmaster delta ratio++ -- The default number of windows in the master pane+ nmaster = 1++ -- Default proportion of screen occupied by master pane+ ratio = 1/2++ -- Percent of screen to increment by when resizing panes+ delta = 3/100++------------------------------------------------------------------------+-- Window rules:++-- Execute arbitrary actions and WindowSet manipulations when managing+-- a new window. You can use this to, for example, always float a+-- particular program, or have a client always appear on a particular+-- workspace.+--+-- To find the property name associated with a program, use+-- > xprop | grep WM_CLASS+-- and click on the client you're interested in.+--+myManageHook = composeAll+ [ className =? "MPlayer" --> doFloat+ , className =? "Gimp" --> doFloat+ , resource =? "desktop_window" --> doIgnore+ , resource =? "kdesktop" --> doIgnore ]+++------------------------------------------------------------------------+-- Status bars and logging++-- Perform an arbitrary action on each internal state change or X event.+-- See the 'DynamicLog' extension for examples.+--+-- To emulate dwm's status bar+--+-- > logHook = dynamicLogDzen+--+myLogHook = return ()++------------------------------------------------------------------------+-- Now run xmonad with all the defaults we set up.++-- Run xmonad with the settings you specify. No need to modify this.+--+main = xmonad defaults++-- A structure containing your configuration settings, overriding+-- fields in the default config. Any you don't override, will +-- use the defaults defined in xmonad/XMonad/Config.hs+-- +-- No need to modify this.+--+defaults = defaultConfig {+ -- simple stuff+ terminal = myTerminal,+ borderWidth = myBorderWidth,+ modMask = myModMask,+ numlockMask = myNumlockMask,+ workspaces = myWorkspaces,+ normalBorderColor = myNormalBorderColor,+ focusedBorderColor = myFocusedBorderColor,+ defaultGaps = myDefaultGaps,++ -- key bindings+ keys = myKeys,+ mouseBindings = myMouseBindings,++ -- hooks, layouts+ layoutHook = myLayout,+ manageHook = myManageHook,+ logHook = myLogHook+ }
man/xmonad.html view
@@ -3,8 +3,8 @@ <HTML><HEAD><TITLE>Manpage of xmonad</TITLE> </HEAD><BODY> <H1>xmonad</H1>-Section: xmonad manual (1)<BR>Updated: 16 October 07<BR><A HREF="#index">Index</A>-<A HREF="http://www.xmonad.org">Return to Main Contents</A><HR>+Section: xmonad manual (1)<BR>Updated: 18 April 07<BR><A HREF="#index">Index</A>+<A HREF="http://localhost/cgi-bin/man/man2html">Return to Main Contents</A><HR> <A NAME="lbAB"> </A> <H2>NAME</H2>@@ -67,7 +67,7 @@ <DL COMPACT> <DT><DD> <BR> <B>mod-shift-return</B>-Launch an xterm+Launch terminal <DT><DD> <BR> <B>mod-p</B> Launch dmenu@@ -190,6 +190,6 @@ This document was created by <A HREF="http://localhost/cgi-bin/man/man2html">man2html</A>, using the manual pages.<BR>-Time: 21:33:21 GMT, October 16, 2007+Time: 03:12:22 GMT, December 05, 2007 </BODY> </HTML>
tests/Properties.hs view
@@ -1,9 +1,8 @@ {-# OPTIONS -fglasgow-exts #-} module Properties where -import StackSet hiding (filter)-import qualified StackSet as S (filter)-import Operations (tile)+import XMonad.StackSet hiding (filter)+import qualified XMonad.StackSet as S (filter) import Debug.Trace import Data.Word@@ -351,14 +350,14 @@ in hidden_spaces (focusWindow (s !! i) x) == hidden_spaces x -- ------------------------------------------------------------------------ member/findIndex+-- member/findTag ----- For all windows in the stackSet, findIndex should identify the+-- For all windows in the stackSet, findTag should identify the -- correct workspace -- prop_findIndex (x :: T) =- and [ tag w == fromJust (findIndex i x)+ and [ tag w == fromJust (findTag i x) | w <- workspace (current x) : map workspace (visible x) ++ hidden x , t <- maybeToList (stack w) , i <- focus t : up t ++ down t@@ -529,7 +528,7 @@ -- shiftWin leaves the current screen as it is, if neither i is the tag -- of the current workspace nor w on the current workspace prop_shift_win_fix_current i w (x :: T) =- i `tagMember` x && w `member` x && i /= n && findIndex w x /= Just n+ i `tagMember` x && w `member` x && i /= n && findTag w x /= Just n ==> (current $ x) == (current $ shiftWin i w x) where n = tag (workspace $ current x)@@ -707,7 +706,7 @@ ,("focusWindow is local", mytest prop_focusWindow_local) ,("focusWindow works" , mytest prop_focusWindow_works) - ,("findIndex" , mytest prop_findIndex)+ ,("findTag" , mytest prop_findIndex) ,("allWindows/member" , mytest prop_allWindowsMember) ,("insert: invariant" , mytest prop_insertUp_I)
util/GenerateManpage.hs view
@@ -42,6 +42,6 @@ replace x y = map (\a -> if a == x then y else a) main = do- troffBindings <- (concatMap troff . allBindings) `liftM` readFile "./Config.hs"+ troffBindings <- (concatMap troff . allBindings) `liftM` readFile "./XMonad/Config.hs" let sed = unlines . replace "___KEYBINDINGS___" troffBindings . lines readFile "./man/xmonad.1.in" >>= return . sed >>= writeFile "./man/xmonad.1"
xmonad.cabal view
@@ -1,7 +1,7 @@ name: xmonad-version: 0.4.1+version: 0.5 homepage: http://xmonad.org-synopsis: A lightweight X11 window manager.+synopsis: A tiling window manager description: xmonad is a tiling window manager for X. Windows are arranged automatically to tile the screen without gaps or overlap, maximising@@ -16,15 +16,40 @@ license: BSD3 license-file: LICENSE author: Spencer Janssen-maintainer: sjanssen@cse.unl.edu-build-depends: base>=2.0, mtl>=1.0, unix>=1.0, X11==1.3.0-extra-source-files: README TODO tests/loc.hs tests/Properties.hs man/xmonad.1.in- Config.hs-boot util/GenerateManpage.hs man/xmonad.1 man/xmonad.html+maintainer: xmonad@haskell.org+extra-source-files: README TODO CONFIG STYLE tests/loc.hs tests/Properties.hs+ man/xmonad.1.in man/xmonad.1 man/xmonad.html man/xmonad.hs+ util/GenerateManpage.hs+cabal-version: >= 1.2 -executable: xmonad-main-is: Main.hs-other-modules: Config Operations StackSet XMonad-ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s-ghc-prof-options: -prof -auto-all-extensions: GeneralizedNewtypeDeriving--- Also requires deriving Typeable, PatternGuards+flag small_base+ description: Choose the new smaller, split-up base package.++library+ exposed-modules: XMonad+ XMonad.Main+ XMonad.Core+ XMonad.Config+ XMonad.Layout+ XMonad.ManageHook+ XMonad.Operations+ XMonad.StackSet++ if flag(small_base)+ build-depends: base >= 3, containers, directory, process+ else+ build-depends: base < 3+ build-depends: X11>=1.4.0, mtl, unix++ ghc-options: -funbox-strict-fields -Wall -Werror -optl-Wl,-s+ ghc-prof-options: -prof -auto-all+ extensions: CPP++executable xmonad+ main-is: Main.hs+ other-modules: XMonad.Core XMonad.Main XMonad.Layout+ XMonad.Operations XMonad.StackSet XMonad++ ghc-options: -funbox-strict-fields -Wall -Werror -optl-Wl,-s+ ghc-prof-options: -prof -auto-all+ extensions: CPP