xmonad 0.3 → 0.4
raw patch · 15 files changed
+926/−465 lines, 15 filesdep ~X11-extras
Dependency ranges changed: X11-extras
Files
- Config.hs +162/−89
- Config.hs-boot +4/−2
- LICENSE +1/−1
- Main.hs +54/−46
- Operations.hs +218/−143
- README +11/−5
- StackSet.hs +153/−87
- TODO +13/−15
- XMonad.hs +97/−33
- man/xmonad.1 +6/−0
- man/xmonad.html +9/−3
- tests/Properties.hs +183/−24
- tests/loc.hs +0/−1
- util/GenerateManpage.hs +3/−3
- xmonad.cabal +12/−13
Config.hs view
@@ -3,21 +3,20 @@ -- Module : Config.hs -- Copyright : (c) Spencer Janssen 2007 -- License : BSD3-style (see LICENSE)--- --- Maintainer : dons@cse.unsw.edu.au+--+-- 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@@ -29,72 +28,115 @@ 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. ----- The number of workspaces (virtual screens, or window groups)+-- A tagging example: --+-- > workspaces = ["web", "irc", "code" ] ++ map show [4..9]+-- workspaces :: [WorkspaceId]-workspaces = [0..8]+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 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 --- |--- 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---- |--- numlock handling:------ The mask for the numlock key. You may need to change this on some systems.+-- | 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)+-- > $ 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 --- |--- Border colors for unfocused and focused windows, respectively.+-- | 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" --- |--- Width of the window border in pixels+-- | 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) ---borderWidth :: Dimension-borderWidth = 1+-- 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 --- |--- The default set of tiling algorithms+------------------------------------------------------------------------+-- 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. ---defaultLayouts :: [Layout Window]-defaultLayouts = [ tiled , mirror tiled , full ]+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+ tiled = Tall nmaster delta ratio -- The default number of windows in the master pane nmaster = 1@@ -105,82 +147,113 @@ -- Percent of screen to increment by when resizing panes delta = 3%100 --- |--- Perform an arbitrary action on each state change.+-- | 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 () --- |--- The key bindings list.--- --- The unusual comment format is used to generate the documentation--- automatically.+------------------------------------------------------------------------+-- 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 .|. 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 ), switchLayout) -- @@ Rotate through the available layout algorithms+ , ((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+ , ((modMask, xK_n ), refresh) -- %! Resize viewed windows to the correct size -- move focus up or down the window stack- , ((modMask, xK_Tab ), focusDown) -- @@ Move focus to the next window- , ((modMask, xK_j ), focusDown) -- @@ Move focus to the next window- , ((modMask, xK_k ), focusUp ) -- @@ Move focus to the previous window+ , ((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), swapMaster) -- @@ Swap the focused window and the master window- , ((modMask .|. shiftMask, xK_j ), swapDown ) -- @@ Swap the focused window with the next window- , ((modMask .|. shiftMask, xK_k ), swapUp ) -- @@ Swap the focused window with the previous window+ , ((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+ , ((modMask, xK_h ), sendMessage Shrink) -- %! Shrink the master area+ , ((modMask, xK_l ), sendMessage Expand) -- %! Expand the master area - , ((modMask, xK_t ), withFocused sink) -- @@ Push window back into tiling+ -- 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+ , ((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+ , ((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 ), restart Nothing True) -- @@ Restart xmonad+ , ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit xmonad+ , ((modMask , xK_q ), broadcastMessage ReleaseResources >> restart Nothing True) -- %! Restart xmonad - ] ++- -- mod-[1..9] @@ Switch to workspace N- -- mod-shift-[1..9] @@ Move client to workspace N- [((m .|. modMask, k), f i)+ -- % 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 ..]- , (f, m) <- [(view, 0), (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+ , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] ++- [((m .|. modMask, key), screenWorkspace sc >>= flip whenJust f)+ -- 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) <- [(windows . W.view, 0), (shift, shiftMask)]]+ , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] --- |--- default actions bound to mouse events+ -- % 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+ -- 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 >> swapMaster))- -- mod-button3 @@ Set the window to floating mode and resize by dragging- , ((modMask, button3), (\w -> focus w >> mouseResizeWindow 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 view
@@ -1,8 +1,10 @@ module Config where import Graphics.X11.Xlib.Types (Dimension)-import Graphics.X11.Xlib (KeyMask)+import Graphics.X11.Xlib (KeyMask,Window) import XMonad borderWidth :: Dimension-logHook :: X () numlockMask :: KeyMask workspaces :: [WorkspaceId]+logHook :: X ()+manageHook :: Window -> String -> String -> String -> X (WindowSet -> WindowSet)+serialisedLayouts :: [Layout Window]
LICENSE view
@@ -14,7 +14,7 @@ may be used to endorse or promote products derived from this software without specific prior written permission. -THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
Main.hs view
@@ -1,4 +1,4 @@------------------------------------------------------------------------------+---------------------------------------------------------------------------- -- | -- Module : Main.hs -- Copyright : (c) Spencer Janssen 2007@@ -9,7 +9,7 @@ -- Portability : not portable, uses mtl, X11, posix -- -- xmonad, a minimalist, tiling window manager for X11--- +-- ----------------------------------------------------------------------------- module Main where@@ -29,7 +29,7 @@ import XMonad import Config-import StackSet (new, floating, member, findIndex, workspace, tag, current, visible)+import StackSet (new, floating, member) import qualified StackSet as W import Operations @@ -50,20 +50,27 @@ hSetBuffering stdout NoBuffering args <- getArgs - let winset | ("--resume" : s : _) <- args- , [(x, "")] <- reads s = x- | otherwise = new workspaces $ zipWith SD xinesc gaps+ 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) - safeLayouts = case defaultLayouts of [] -> (full, []); (x:xs) -> (x,xs) cf = XConf { display = dpy , theRoot = rootw , normalBorder = nbc , focusedBorder = fbc } st = XState- { windowset = winset- , layouts = M.fromList [(w, safeLayouts) | w <- workspaces]+ { windowset = initialWinset , mapped = S.empty , waitingUnmap = M.empty , dragging = Nothing }@@ -74,32 +81,30 @@ sync dpy False selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask- grabKeys dpy rootw- grabButtons dpy rootw - sync dpy False-- ws <- scan dpy rootw -- on the resume case, will pick up new windows allocaXEvent $ \e -> runX cf st $ do - -- walk workspace, resetting X states/mask for windows- -- TODO, general iterators for these lists.- sequence_ [ setInitialProperties w >> reveal w- | wk <- map W.workspace (W.current winset : W.visible winset)- , w <- W.integrate' (W.stack wk) ]+ grabKeys+ grabButtons - sequence_ [ setInitialProperties w >> hide w- | wk <- W.hidden winset- , w <- W.integrate' (W.stack wk) ]+ io $ sync dpy False - mapM_ manage ws -- find new windows- refresh+ -- 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)+ forever_ $ handle =<< io (nextEvent dpy e >> getEvent e) - where forever a = a >> forever a+ return ()+ where forever_ a = a >> forever_ a -- --------------------------------------------------------------------- -- IO stuff. Doesn't require any X state@@ -123,23 +128,25 @@ && (wa_map_state wa == waIsViewable || ic) -- | Grab the keys back-grabKeys :: Display -> Window -> IO ()-grabKeys dpy rootw = do- ungrabKey dpy anyKey anyModifier rootw+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 <- keysymToKeycode dpy sym+ 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 - where grab kc m = grabKey dpy kc m rootw True grabModeAsync grabModeAsync--grabButtons :: Display -> Window -> IO ()-grabButtons dpy rootw = do- ungrabButton dpy anyButton anyModifier rootw+-- | 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)- where grab button mask = grabButton dpy button mask rootw False buttonPressMask- grabModeAsync grabModeSync none none -- --------------------------------------------------------------------- -- | Event handler. Map X events onto calls into Operations.hs, which@@ -158,7 +165,7 @@ handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code}) | t == keyPress = withDisplay $ \dpy -> do s <- io $ keycodeToKeysym dpy code 0- whenJust (M.lookup (cleanMask m,s) keys) id+ userCode $ whenJust (M.lookup (cleanMask m,s) keys) id -- manage a new window handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do@@ -180,9 +187,9 @@ else modify (\s -> s { waitingUnmap = M.adjust pred w (waitingUnmap s) }) -- set keyboard mapping-handle e@(MappingNotifyEvent {ev_window = w}) = do+handle e@(MappingNotifyEvent {}) = do io $ refreshKeyboardMapping e- when (ev_request e == mappingKeyboard) $ withDisplay $ io . flip grabKeys w+ when (ev_request e == mappingKeyboard) grabKeys -- handle button release, which may finish dragging. handle e@(ButtonEvent {ev_event_type = t})@@ -206,7 +213,7 @@ -- 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 whenJust (M.lookup (cleanMask (ev_state e), b) mouseBindings) ($ ev_subwindow e)+ 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. @@ -226,10 +233,7 @@ ws <- gets windowset wa <- io $ getWindowAttributes dpy w - -- TODO temporary workaround for some bugs in float. Don't call 'float' on- -- windows that aren't visible, because it changes the focused screen- let vis = any ((== findIndex w ws) . Just . tag . workspace) (current ws : visible ws)- if (M.member w (floating ws) && vis)+ 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@@ -248,7 +252,11 @@ sendEvent dpy w False 0 ev io $ sync dpy False --- the root may have configured+-- 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 view
@@ -1,11 +1,13 @@-{-# OPTIONS -fno-warn-orphans -fglasgow-exts #-}--- \^^ deriving Typeable+{-# 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@@ -18,10 +20,10 @@ import XMonad import qualified StackSet as W-import {-# SOURCE #-} Config (borderWidth,logHook,numlockMask)+import {-# SOURCE #-} Config (borderWidth,logHook,manageHook,numlockMask,serialisedLayouts) import Data.Maybe-import Data.List (nub, (\\), find)+import Data.List (nub, (\\), find, partition) import Data.Bits ((.|.), (.&.), complement) import Data.Ratio import qualified Data.Map as M@@ -29,15 +31,13 @@ import Control.Monad.State import Control.Monad.Reader-import Control.Arrow ((***), first, second)+import Control.Arrow ((***), second) import System.IO import Graphics.X11.Xlib import Graphics.X11.Xinerama (getScreenInfo) import Graphics.X11.Xlib.Extras -import qualified Data.Traversable as T- -- --------------------------------------------------------------------- -- | -- Window manager operations@@ -49,51 +49,37 @@ -- manage :: Window -> X () manage w = whenX (fmap not $ isClient w) $ withDisplay $ \d -> do- setInitialProperties w >> reveal w-- -- FIXME: This is pretty awkward. We can't can't let "refresh" happen- -- before the call to float, because that will resize the window and- -- lose the default sizing.- 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)- if isFixedSize || isTransient- then do modify $ \s -> s { windowset = W.insertUp w (windowset s) }- float w -- \^^ now go the refresh.- else windows $ W.insertUp 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. ----- FIXME: clearFloating should be taken care of in W.delete, but if we do it--- there, floating status is lost when moving windows between workspaces,--- because W.shift calls W.delete.--- -- should also unmap? -- unmanage :: Window -> X () unmanage w = do- windows (W.sink w . W.delete w)+ windows (W.delete w) setWMState w 0 {-withdrawn-} modify (\s -> s {mapped = S.delete w (mapped s), waitingUnmap = M.delete w (waitingUnmap s)}) --- | focus. focus window up or down. or swap various windows.-focusUp, focusDown, swapUp, swapDown, swapMaster :: X ()-focusUp = windows W.focusUp-focusDown = windows W.focusDown-swapUp = windows W.swapUp-swapDown = windows W.swapDown-swapMaster = windows W.swapMaster---- | shift. Move a window to a new workspace, 0 indexed.-shift :: WorkspaceId -> X ()-shift n = windows (W.shift n)---- | view. Change the current workspace to workspace at offset n (0 indexed).-view :: WorkspaceId -> X ()-view = windows . W.greedyView- -- | 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 ()@@ -124,29 +110,33 @@ -- --------------------------------------------------------------------- -- Managing windows -data UnDoLayout = UnDoLayout deriving ( Typeable, Eq )-instance Message UnDoLayout+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- -- Notify visible layouts to remove decorations etc- -- We cannot use sendMessage because this must not call refresh ever,- -- and must be called on all visible workspaces.- broadcastMessage UnDoLayout- XState { windowset = old, layouts = fls } <- get+ 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 })- d <- asks display + -- 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.current ws : W.visible ws+ 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- Just l = fmap fst $ M.lookup n fls+ 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))@@ -158,10 +148,11 @@ -- just the tiled windows: -- now tile the windows on this workspace, modified by the gap- (rs, ml') <- runLayout l viewrect tiled `catchX` runLayout full viewrect tiled+ (rs, ml') <- runLayout l viewrect tiled `catchX` runLayout (Layout Full) viewrect tiled mapM_ (uncurry tileWindow) rs- whenJust ml' $ \l' -> modify $ \ss ->- ss { layouts = M.adjust (first (const l')) n (layouts ss) }+ 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@@ -176,8 +167,9 @@ -- return the visible windows for this workspace: return vs + whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc setTopFocus- logHook+ userCode logHook -- io performGC -- really helps, but seems to trigger GC bugs? -- hide every window that was potentially visible before, but is not@@ -218,9 +210,12 @@ -- | Set some properties when we initially gain control of a window setInitialProperties :: Window -> X ()-setInitialProperties w = withDisplay $ \d -> io $ do+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.@@ -297,122 +292,190 @@ -- | Call X to set the keyboard focus details. setFocusX :: Window -> X () setFocusX w = withWindowSet $ \ws -> do- XConf { display = dpy , normalBorder = nbc, focusedBorder = fbc } <- ask+ 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- io $ setWindowBorder dpy otherw nbc -- 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- io $ setWindowBorder dpy w fbc --- ------------------------------------------------------------------------ Managing layout---- | switchLayout. Switch to another layout scheme. Switches the--- layout of the current workspace. By convention, a window set as--- master in Tall mode remains as master in Wide mode. When switching--- from full screen to a tiling mode, the currently focused window--- becomes a master. When switching back , the focused window is--- uppermost.------ Note that the new layout's deconstructor will be called, so it should be--- idempotent.-switchLayout :: X ()-switchLayout = do- broadcastMessage UnDoLayout -- calling refresh now would defeat the point of deconstruction- n <- gets (W.tag . W.workspace . W.current . windowset)- modify $ \s -> s { layouts = M.adjust switch n (layouts s) }- refresh- where switch (x, xs) = let xs' = xs ++ [x] in (head xs', tail xs')+------------------------------------------------------------------------+-- Message handling --- | Throw a message to the current Layout possibly modifying how we+-- | Throw a message to the current LayoutClass possibly modifying how we -- layout the windows, then refresh.--- sendMessage :: Message a => a -> X ()-sendMessage a = do n <- (W.tag . W.workspace . W.current) `fmap` gets windowset- Just (l,ls) <- M.lookup n `fmap` gets layouts- ml' <- modifyLayout l (SomeMessage a) `catchX` return (Just l)- whenJust ml' $ \l' -> do modify $ \s -> s { layouts = M.insert n (l',ls) (layouts s) }- refresh+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 = do- ol <- gets layouts- nl <- T.forM ol $ \ (l,ls) -> maybe (l,ls) (flip (,) ls) `fmap`- (modifyLayout l (SomeMessage a) `catchX` return (Just l))- modify $ \s -> s { layouts = nl }+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: ----- Builtin layout algorithms:+-- > NextLayout+-- > PrevLayout+-- > JumpToLayout. ----- fullscreen mode--- tall mode--- +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+-- > Shrink+-- > Expand --- data Resize = Shrink | Expand deriving Typeable-data IncMasterN = IncMasterN Int 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.--- a plea for tuple sections: map . (,sc)-full :: Layout a-full = Layout { doLayout = \sc (W.Stack f _ _) -> return ([(f, sc)],Nothing)- , modifyLayout = const (return Nothing) } -- no changes+-- | Simple fullscreen mode, just render all windows fullscreen.+data Full a = Full deriving (Show, Read) ------ The tiling mode of xmonad, and its operations.----tall :: Int -> Rational -> Rational -> Layout a-tall nmaster delta frac =- Layout { doLayout = \r -> return . (\x->(x,Nothing)) .- ap zip (tile frac r nmaster . length) . W.integrate- , modifyLayout = \m -> return $ msum [fmap resize (fromMessage m)- ,fmap incmastern (fromMessage m)] }+instance LayoutClass Full a - 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+-- | 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.-mirror :: Layout a -> Layout a-mirror (Layout { doLayout = dl, modifyLayout = ml }) =- Layout { doLayout = \sc w -> do (wrs, ml') <- dl (mirrorRect sc) w- return (map (second mirrorRect) wrs, mirror `fmap` ml')- , modifyLayout = fmap (fmap mirror) . ml }+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). +-- 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. +-- 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@@ -437,6 +500,7 @@ , 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 ------------------------------------------------------------------------@@ -471,30 +535,23 @@ ------------------------------------------------------------------------ -- | Floating layer support --- | Make a floating window tiled-sink :: Window -> X ()-sink = windows . W.sink---- | Make a tiled window floating, using its suggested rectangle------ TODO: float changes the set of visible workspaces when we call it for an--- invisible window -- this should not happen. See 'temporary workaround' in--- the handler for ConfigureRequestEvent also.-float :: Window -> X ()-float w = withDisplay $ \d -> do+-- | 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 - let sc = fromMaybe (W.current ws) $ find (pointWithin (fi $ wa_x wa) (fi $ wa_y wa) . screenRect . W.screenDetail) $ W.current ws : W.visible ws+ -- 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- sw = W.tag . W.workspace $ 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)) - windows $ maybe id W.focusWindow (W.peek ws) . W.shift sw . W.focusWindow w . W.float w- (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) &&@@ -502,6 +559,17 @@ 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 @@ -525,6 +593,7 @@ clearEvents pointerMotionMask return z +-- | XXX comment me mouseMoveWindow :: Window -> X () mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do io $ raiseWindow d w@@ -536,6 +605,7 @@ (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@@ -544,8 +614,8 @@ 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 ((fromIntegral (max 1 (ex - fromIntegral (wa_x wa)))),- (fromIntegral (max 1 (ey - fromIntegral (wa_y wa))))))+ applySizeHints sh (ex - fromIntegral (wa_x wa),+ ey - fromIntegral (wa_y wa))) (float w) -- ---------------------------------------------------------------------@@ -554,8 +624,13 @@ type D = (Dimension, Dimension) -- | Reduce the dimensions if needed to comply to the given SizeHints.-applySizeHints :: SizeHints -> D -> D-applySizeHints sh =+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)
README view
@@ -40,13 +40,19 @@ Get the dependencies + 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:++ 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' 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.2.2- X11-extras: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/X11-extras-0.3+ X11 http://hackage.haskell.org/cgi-bin/hackage-scripts/package/X11-1.2.3+ X11-extras: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/X11-extras-0.4 And then build with Cabal: @@ -62,7 +68,7 @@ use the darcs version of X11-extras, which is developed concurrently with xmonad. - darcs get http://darcs.haskell.org/~sjanssen/X11-extras+ darcs get http://code.haskell.org/X11-extras Not using X11-extras from darcs, is the most common reason for the darcs version of xmonad to fail to build.@@ -85,9 +91,9 @@ Examples include an ion3-like tabbed layout, a prompt/program launcher, and various other useful modules. XMonadContrib is available at: - 0.3 release: http://www.xmonad.org/XMonadContrib-0.3.tar.gz+ 0.4 release: http://www.xmonad.org/XMonadContrib-0.4.tar.gz - darcs version: darcs get http://darcs.haskell.org/~sjanssen/XMonadContrib+ darcs version: darcs get http://code.haskell.org/XMonadContrib ------------------------------------------------------------------------
StackSet.hs view
@@ -1,10 +1,12 @@+{-# LANGUAGE PatternGuards #-}+ ----------------------------------------------------------------------------- -- | -- Module : StackSet -- Copyright : (c) Don Stewart 2007 -- License : BSD3-style (see LICENSE) ----- Maintainer : dons@cse.unsw.edu.au+-- Maintainer : dons@galois.com -- Stability : experimental -- Portability : portable, Haskell 98 --@@ -19,25 +21,30 @@ -- * Xinerama operations -- $xinerama lookupWorkspace,+ screens, workspaces, allWindows, -- * Operations on the current stack -- $stackOperations peek, index, integrate, integrate', differentiate,- focusUp, focusDown,- focusWindow, tagMember, member, findIndex,+ focusUp, focusDown, focusMaster, focusWindow,+ tagMember, renameTag, ensureTags, member, findIndex, mapWorkspace, mapLayout, -- * Modifying the stackset -- $modifyStackset- insertUp, delete, filter,+ insertUp, delete, delete', filter, -- * Setting the master window -- $settingMW- swapMaster, swapUp, swapDown, modify, modify', float, sink, -- needed by users+ swapUp, swapDown, swapMaster, modify, modify', float, sink, -- needed by users -- * Composite operations -- $composite- shift+ shift, shiftWin,++ -- for testing+ abort ) where import Prelude hiding (filter)-import Data.Maybe (listToMaybe)-import qualified Data.List as L (delete,deleteBy,find,splitAt,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@@ -48,18 +55,18 @@ -- 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 +-- Zipper -- -- We encode all the focus tracking directly in the data structure, with a 'zipper': --@@ -70,7 +77,7 @@ -- 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. +-- the old structure as possible. -- -- Oleg Kiselyov, 27 Apr 2005, haskell\@, "Zipper as a delimited continuation" --@@ -87,7 +94,7 @@ -- Another good reference is: -- -- The Zipper, Haskell wikibook--- +-- -- Xinerama support: -- -- Xinerama in X11 lets us view multiple virtual workspaces@@ -105,7 +112,7 @@ -- 'delete'. -- --- | +-- | -- API changes from xmonad 0.1: -- StackSet constructor arguments changed. StackSet workspace window screen --@@ -129,7 +136,7 @@ -- -- * swapMaster, -- was: promote\/swap ----- * member, +-- * member, -- -- * shift, --@@ -139,32 +146,33 @@ -- ------------------------------------------------------------------------ -- |--- A cursor into a non-empty list of workspaces. --- +-- 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 a sid sd =- StackSet { current :: !(Screen i a sid sd) -- ^ currently focused workspace- , visible :: [Screen i a sid sd] -- ^ non-focused workspaces, visible in xinerama- , hidden :: [Workspace i a] -- ^ 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 a sid sd = Screen { workspace :: !(Workspace i a)- , screen :: !sid- , screenDetail :: !sd }+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 a = Workspace { tag :: !i, stack :: StackOrNot a }+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) @@ -207,42 +215,43 @@ -- -- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0. ---new :: (Integral s) => [i] -> [sd] -> StackSet i a s sd-new wids m | not (null wids) && length m <= length wids = StackSet cur visi unseen M.empty- where (seen,unseen) = L.splitAt (length m) $ map (flip Workspace Nothing) wids+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"--+new _ _ _ = abort "non-positive argument to StackSet.new" -- |--- /O(w)/. Set focus to the workspace with index \'i\'. +-- /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 a, Eq s, Eq i) => i -> StackSet i a s sd -> StackSet i a s sd+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 screenEq x (visible s) }+ = s { current = x, visible = current s : L.deleteBy (equating screen) x (visible s) } - | Just x <- L.find ((i==).tag) (hidden 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.delete x (hidden s) }+ , hidden = workspace (current s) : L.deleteBy (equating tag) x (hidden s) } - | otherwise = s- where screenEq x y = screen x == screen y+ | 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@@ -252,23 +261,22 @@ -- screen, the workspaces of the current screen and the other screen are -- swapped. -greedyView :: (Eq a, Eq s, Eq i) => i -> StackSet i a s sd -> StackSet i a s sd+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+ | 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 a s sd -> Maybe i+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 ] -- ---------------------------------------------------------------------@@ -280,13 +288,13 @@ -- 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 a s sd -> b+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 a s sd -> StackSet i a s sd+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 }}} @@ -294,14 +302,14 @@ -- 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 a s sd -> StackSet i a s sd+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. +-- /O(1)/. Extract the focused element of the current stack. -- Return Just that element, or Nothing for an empty stack. ---peek :: StackSet i a s sd -> Maybe a+peek :: StackSet i l a s sd -> Maybe a peek = with Nothing (return . focus) -- |@@ -319,7 +327,7 @@ -- /O(n)/. Texture a list. -- differentiate :: [a] -> StackOrNot a-differentiate [] = Nothing+differentiate [] = Nothing differentiate (x:xs) = Just $ Stack x [] xs -- |@@ -339,24 +347,24 @@ -- 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 a s sd -> [a]+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/. +-- /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'+-- 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 a s sd -> StackSet i a s sd+--+focusUp, focusDown, swapUp, swapDown :: StackSet i l a s sd -> StackSet i l a s sd focusUp = modify' focusUp' focusDown = modify' (reverseStack . focusUp' . reverseStack) @@ -375,38 +383,66 @@ reverseStack (Stack t ls rs) = Stack t rs ls ----- | /O(1) on current window, O(n) in general/. Focus the window 'w', +-- | /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 a s sd -> StackSet i a s sd+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 a s sd -> [Workspace i a]+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 a s sd -> Bool+tagMember :: Eq i => i -> StackSet i l a s sd -> Bool tagMember t = elem t . map tag . workspaces --- |--- Finding if a window is in the stackset is a little tedious. We could--- keep a cache :: Map a i, but with more bookkeeping.---+-- | 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 a s sd -> Bool+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 a s sd -> Maybe i+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@@ -429,11 +465,11 @@ -- 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 a s sd -> StackSet i a s sd+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 a s sd -> StackSet i a s sd+-- 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 }@@ -452,22 +488,27 @@ -- * 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 a s sd -> StackSet i a s sd-delete w s = s { current = removeFromScreen (current s)- , visible = map removeFromScreen (visible s)- , hidden = map removeFromWorkspace (hidden s) }+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) }+ 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 a s sd -> StackSet i a s sd+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 a s sd -> StackSet i a s sd+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) } ------------------------------------------------------------------------@@ -476,24 +517,49 @@ -- | /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 a s sd -> StackSet i a s sd+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 [] (ys ++ x : rs) where (x:ys) = reverse ls+ 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+-- 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 a s sd -> StackSet i a s sd+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+ 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,17 +1,15 @@-0.3 release:- * stable contrib repo tarball- * haddocks for core and contribs on xmonad.org- * tag xmonad- * tag X11-extras- * tag X11- * more QC tests---- possibles:- - use more constrained type in StackSet to avoid pattern match warnings- - audit for events handled in dwm.+ - Write down invariants for the window life cycle, especially:+ - When are borders set? Prove that the current handling is sufficient. -- related:- - xcb bindings- - randr+= Release management = +* build and typecheck all XMC+* 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+* check tour.html and intro.html are up to date, and mention all core bindings+* bump xmonad.cabal version
XMonad.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}+ ----------------------------------------------------------------------------- -- | -- Module : XMonad.hs@@ -15,16 +16,19 @@ ----------------------------------------------------------------------------- module XMonad (- X, WindowSet, WorkspaceId(..), ScreenId(..), ScreenDetail(..), XState(..), XConf(..), Layout(..),+ X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), LayoutClass(..), Layout(..), ReadableLayout(..), Typeable, Message, SomeMessage(..), fromMessage, runLayout,- runX, catchX, io, catchIO, withDisplay, withWindowSet, isRoot, spawn, restart, trace, whenJust, whenX,+ 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@@ -43,8 +47,6 @@ { windowset :: !WindowSet -- ^ workspace list , mapped :: !(S.Set Window) -- ^ the Set of mapped windows , waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents- , layouts :: !(M.Map WorkspaceId (Layout Window, [Layout Window]))- -- ^ mapping of workspaces to descriptions of their layouts , dragging :: !(Maybe (Position -> Position -> X (), X ())) } data XConf = XConf { display :: Display -- ^ the X11 display@@ -52,14 +54,16 @@ , normalBorder :: !Pixel -- ^ border color of unfocused windows , focusedBorder :: !Pixel } -- ^ border color of the focused window -type WindowSet = StackSet WorkspaceId Window ScreenId ScreenDetail+type WindowSet = StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail+type WindowSpace = Workspace WorkspaceId (Layout Window) Window -- | Virtual workspace indicies-newtype WorkspaceId = W Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)+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)@@ -78,20 +82,27 @@ -- | 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 ()-runX c st (X a) = runStateT (runReaderT a c) st >> return ()+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 (X job) (X errcase) = do+catchX job errcase = do st <- get c <- ask- (a,s') <- io ((runStateT (runReaderT job c) st) `catch`- \e -> (do hPutStrLn stderr (show e); runStateT (runReaderT errcase c) st))+ (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 @@ -118,28 +129,87 @@ atom_WM_STATE = getAtom "WM_STATE" --------------------------------------------------------------------------- | Layout handling+-- | LayoutClass handling. See particular instances in Operations.hs --- The different layout modes+-- | 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'. ----- 'modifyLayout' performs message handling for that layout. If--- 'modifyLayout' returns Nothing, then the layout did not respond to--- that message and the screen is not refreshed. Otherwise, 'modifyLayout'--- returns an updated 'Layout' and the screen is refreshed.----data Layout a = Layout { doLayout :: Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Layout a))- , modifyLayout :: SomeMessage -> X (Maybe (Layout a)) }+class (Show (layout a), Read (layout a)) => LayoutClass layout a where -runLayout :: Layout a -> Rectangle -> StackOrNot a -> X ([(a, Rectangle)], Maybe (Layout a))+ -- | 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 modifyLayout handler.--- +-- 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@@ -166,7 +236,7 @@ -- | 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 -> do hPutStrLn stderr (show e); hFlush stderr)+catchIO f = liftIO (f `catch` \e -> hPrint stderr e >> hFlush stderr) -- | spawn. Launch an external application spawn :: String -> X ()@@ -188,8 +258,9 @@ restart :: Maybe String -> Bool -> X () restart mprog resume = do prog <- maybe (io getProgName) return mprog- args <- if resume then gets (("--resume":) . return . show . windowset) else return []+ args <- if resume then gets (("--resume":) . return . showWs . windowset) else return [] catchIO (executeFile prog True args Nothing)+ where showWs = show . mapLayout show -- | Run a side effecting action with the current workspace. Like 'when' but whenJust :: Maybe a -> (a -> X ()) -> X ()@@ -198,13 +269,6 @@ -- | Conditionally run an action, using a X event to decide whenX :: X Bool -> X () -> X () whenX a f = a >>= \b -> when b f---- Grab the X server (lock it) from the X monad--- withServerX :: X () -> X ()--- withServerX f = withDisplay $ \dpy -> do--- io $ grabServer dpy--- f--- io $ ungrabServer dpy -- | A 'trace' for the X monad. Logs a string to stderr. The result may -- be found in your .xsession-errors file
man/xmonad.1 view
@@ -52,6 +52,9 @@ \fBmod-space\fR Rotate through the available layout algorithms .IP+ \fBmod-shift-space\fR+Reset the layouts on the current workspace to default+.IP \fBmod-n\fR Resize viewed windows to the correct size .IP@@ -63,6 +66,9 @@ .IP \fBmod-k\fR Move focus to the previous window+.IP+ \fBmod-m\fR+Move focus to the master window .IP \fBmod-return\fR Swap the focused window and the master window
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: 18 April 07<BR><A HREF="#index">Index</A>-<A HREF="http://localhost/cgi-bin/man/man2html">Return to Main Contents</A><HR>+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> <A NAME="lbAB"> </A> <H2>NAME</H2>@@ -81,6 +81,9 @@ <BR> <B>mod-space</B> Rotate through the available layout algorithms <DT><DD>+<BR> <B>mod-shift-space</B>+Reset the layouts on the current workspace to default+<DT><DD> <BR> <B>mod-n</B> Resize viewed windows to the correct size <DT><DD>@@ -93,6 +96,9 @@ <BR> <B>mod-k</B> Move focus to the previous window <DT><DD>+<BR> <B>mod-m</B>+Move focus to the master window+<DT><DD> <BR> <B>mod-return</B> Swap the focused window and the master window <DT><DD>@@ -184,6 +190,6 @@ This document was created by <A HREF="http://localhost/cgi-bin/man/man2html">man2html</A>, using the manual pages.<BR>-Time: 04:55:21 GMT, August 24, 2007+Time: 21:33:21 GMT, October 16, 2007 </BODY> </HTML>
tests/Properties.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS -fglasgow-exts #-}+module Properties where import StackSet hiding (filter) import qualified StackSet as S (filter)@@ -11,8 +12,10 @@ import Data.Maybe import System.Environment import Control.Exception (assert)+import qualified Control.Exception as C import Control.Monad import Test.QuickCheck hiding (promote)+import System.IO.Unsafe import System.IO import System.Random hiding (next) import Text.Printf@@ -28,18 +31,19 @@ -- Some general hints for creating StackSet properties: -- -- * ops that mutate the StackSet are usually local--- * most ops on StackSet should either be trivially reversible, or +-- * most ops on StackSet should either be trivially reversible, or -- idempotent, or both. -- -- The all important Arbitrary instance for StackSet. ---instance (Integral i, Integral s, Eq a, Arbitrary a, Arbitrary sd)- => Arbitrary (StackSet i a s sd) where+instance (Integral i, Integral s, Eq a, Arbitrary a, Arbitrary l, Arbitrary sd)+ => Arbitrary (StackSet i l a s sd) where arbitrary = do sz <- choose (1,10) -- number of workspaces n <- choose (0,sz-1) -- pick one to be in focus sc <- choose (1,sz) -- a number of physical screens+ lay <- arbitrary -- pick any layout sds <- replicateM sc arbitrary ls <- vector sz -- a vector of sz workspaces @@ -48,7 +52,7 @@ else liftM Just (choose ((-1),length s-1)) | s <- ls ] - return $ fromList (fromIntegral n, sds,fs,ls)+ return $ fromList (fromIntegral n, sds,fs,ls,lay) coarbitrary = error "no coarbitrary for StackSet" @@ -62,14 +66,14 @@ -- 'fs' random focused window on each workspace -- 'xs' list of list of windows ---fromList :: (Integral i, Integral s, Eq a) => (i, [sd], [Maybe Int], [[a]]) -> StackSet i a s sd-fromList (_,_,_,[]) = error "Cannot build a StackSet from an empty list"+fromList :: (Integral i, Integral s, Eq a) => (i, [sd], [Maybe Int], [[a]], l) -> StackSet i l a s sd+fromList (_,_,_,[],_) = error "Cannot build a StackSet from an empty list" -fromList (o,m,fs,xs) =+fromList (o,m,fs,xs,l) = let s = view o $ foldr (\(i,ys) s -> foldr insertUp (view i s) ys)- (new [0..genericLength xs-1] m) (zip [0..] xs)+ (new l [0..genericLength xs-1] m) (zip [0..] xs) in foldr (\f t -> case f of Nothing -> t Just i -> foldr (const focusUp) t [0..i] ) s fs@@ -79,7 +83,7 @@ -- -- Just generate StackSets with Char elements. ---type T = StackSet (NonNegative Int) Char Int Int+type T = StackSet (NonNegative Int) Int Char Int Int -- Useful operation, the non-local workspaces hidden_spaces x = map workspace (visible x) ++ hidden x@@ -87,7 +91,7 @@ -- Basic data invariants of the StackSet -- -- With the new zipper-based StackSet, tracking focus is no longer an--- issue: the data structure enforces focus by construction. +-- issue: the data structure enforces focus by construction. -- -- But we still need to ensure there are no duplicates, and master/and -- the xinerama mapping aren't checked by the data structure at all.@@ -129,9 +133,9 @@ prop_invariant = invariant -- and check other ops preserve invariants-prop_empty_I (n :: Positive Int) = forAll (choose (1,fromIntegral n)) $ \m ->- forAll (vector m) $ \ms ->- invariant $ new [0..fromIntegral n-1] ms+prop_empty_I (n :: Positive Int) l = forAll (choose (1,fromIntegral n)) $ \m ->+ forAll (vector m) $ \ms ->+ invariant $ new l [0..fromIntegral n-1] ms prop_view_I (n :: NonNegative Int) (x :: T) = n `tagMember` x ==> invariant $ view (fromIntegral n) x@@ -141,6 +145,8 @@ prop_focusUp_I (n :: NonNegative Int) (x :: T) = invariant $ foldr (const focusUp) x [1..n]+prop_focusMaster_I (n :: NonNegative Int) (x :: T) =+ invariant $ foldr (const focusMaster) x [1..n] prop_focusDown_I (n :: NonNegative Int) (x :: T) = invariant $ foldr (const focusDown) x [1..n] @@ -167,21 +173,24 @@ prop_shift_I (n :: NonNegative Int) (x :: T) = n `tagMember` x ==> invariant $ shift (fromIntegral n) x +prop_shift_win_I (n :: NonNegative Int) (w :: Char) (x :: T) =+ n `tagMember` x && w `member` x ==> invariant $ shiftWin (fromIntegral n) w x + -- --------------------------------------------------------------------- -- 'new' -- empty StackSets have no windows in them-prop_empty (EmptyStackSet x) = +prop_empty (EmptyStackSet x) = all (== Nothing) [ stack w | w <- workspace (current x) : map workspace (visible x) ++ hidden x ] -- empty StackSets always have focus on first workspace-prop_empty_current (NonEmptyNubList ns) (NonEmptyNubList sds) =+prop_empty_current (NonEmptyNubList ns) (NonEmptyNubList sds) l = -- TODO, this is ugly length sds <= length ns ==> tag (workspace $ current x) == head ns- where x = new ns sds :: T+ where x = new l ns sds :: T -- no windows will be a member of an empty workspace prop_member_empty i (EmptyStackSet x)@@ -196,7 +205,7 @@ where i = fromIntegral n --- view *only* sets the current workspace, and touches Xinerama. +-- view *only* sets the current workspace, and touches Xinerama. -- no workspace contents will be changed. prop_view_local (x :: T) (n :: NonNegative Int) = i `tagMember` x ==> workspaces x == workspaces (view i x)@@ -229,7 +238,7 @@ where i = fromIntegral n --- greedyView *only* sets the current workspace, and touches Xinerama. +-- greedyView *only* sets the current workspace, and touches Xinerama. -- no workspace contents will be changed. prop_greedyView_local (x :: T) (n :: NonNegative Int) = i `tagMember` x ==> workspaces x == workspaces (greedyView i x)@@ -287,13 +296,16 @@ -- -- master/focus--- +-- -- The tiling order, and master window, of a stack is unaffected by focus changes. -- prop_focus_left_master (n :: NonNegative Int) (x::T) = index (foldr (const focusUp) x [1..n]) == index x prop_focus_right_master (n :: NonNegative Int) (x::T) = index (foldr (const focusDown) x [1..n]) == index x+prop_focus_master_master (n :: NonNegative Int) (x::T) =+ index (foldr (const focusMaster) x [1..n]) == index x+ prop_focusWindow_master (n :: NonNegative Int) (x :: T) = case peek x of Nothing -> True@@ -305,6 +317,9 @@ prop_focus_left (x :: T) = (focusUp (focusDown x)) == x prop_focus_right (x :: T) = (focusDown (focusUp x)) == x +-- focus master is idempotent+prop_focusMaster_idem (x :: T) = focusMaster x == focusMaster (focusMaster x)+ -- focusWindow actually leaves the window focused... prop_focusWindow_works (n :: NonNegative Int) (x :: T) = case peek x of@@ -323,8 +338,11 @@ -- f x' = foldr (\_ y -> rotate GT y) x' [1..n] -- focus is local to the current workspace-prop_focus_local (x :: T) = hidden_spaces (focusDown x) == hidden_spaces x+prop_focus_down_local (x :: T) = hidden_spaces (focusDown x) == hidden_spaces x+prop_focus_up_local (x :: T) = hidden_spaces (focusUp x) == hidden_spaces x +prop_focus_master_local (x :: T) = hidden_spaces (focusMaster x) == hidden_spaces x+ prop_focusWindow_local (n :: NonNegative Int) (x::T ) = case peek x of Nothing -> True@@ -346,6 +364,8 @@ , i <- focus t : up t ++ down t ] +prop_allWindowsMember w (x :: T) = (w `elem` allWindows x) ==> member w x+ -- --------------------------------------------------------------------- -- 'insert' @@ -438,7 +458,7 @@ -- preserve order prop_filter_order (x :: T) = case stack $ workspace $ current x of- Nothing -> True+ Nothing -> True Just s@(Stack i _ _) -> integrate' (S.filter (/= i) s) == filter (/= i) (integrate' (Just s)) -- ---------------------------------------------------------------------@@ -493,14 +513,121 @@ y = swapMaster x n = tag (workspace $ current y) +-- ---------------------------------------------------------------------+-- shiftWin++-- shiftWin on current window is the same as shift+prop_shift_win_focus i (x :: T) =+ i `tagMember` x ==> case peek x of+ Nothing -> True+ Just w -> shiftWin i w x == shift i x++-- shiftWin on a non-existant window is identity+prop_shift_win_indentity i w (x :: T) =+ i `tagMember` x && not (w `member` x) ==> shiftWin i w x == x++-- 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+ ==> (current $ x) == (current $ shiftWin i w x)+ where+ n = tag (workspace $ current x)+ ------------------------------------------------------------------------+-- properties for the floating layer:++prop_float_reversible n (x :: T) =+ n `member` x ==> sink n (float n geom x) == x+ where+ geom = RationalRect 100 100 100 100++-- check rectanges were set+{-+prop_float_sets_geometry n (x :: T) =+ n `member` x ==> let y = float n geom x in M.lookup y (floating x) == Just geom+ where+ geom = RationalRect 100 100 100 100+-}++------------------------------------------------------------------------++prop_screens (x :: T) = n `elem` screens x+ where+ n = current x++prop_differentiate xs =+ if null xs then differentiate xs == Nothing+ else (differentiate xs) == Just (Stack (head xs) [] (tail xs))+ where _ = xs :: [Int]++-- looking up the tag of the current workspace should always produce a tag.+prop_lookup_current (x :: T) = lookupWorkspace scr x == Just tg+ where+ (Screen (Workspace tg _ _) scr _) = current x++-- looking at a visible tag+prop_lookup_visible (x :: T) =+ visible x /= [] ==>+ fromJust (lookupWorkspace scr x) `elem` tags+ where+ tags = [ tag (workspace y) | y <- visible x ]+ scr = last [ screen y | y <- visible x ]+++-- ---------------------------------------------------------------------+-- testing for failure++-- and help out hpc+prop_abort x = unsafePerformIO $ C.catch (abort "fail")+ (\e -> return $ show e == "xmonad: StackSet: fail" )+ where+ _ = x :: Int++-- new should fail with an abort+prop_new_abort x = unsafePerformIO $ C.catch f+ (\e -> return $ show e == "xmonad: StackSet: non-positive argument to StackSet.new" )+ where+ f = new undefined{-layout-} [] [] `seq` return False++ _ = x :: Int++-- prop_view_should_fail = view {- with some bogus data -}++-- screens makes sense+prop_screens_works (x :: T) = screens x == current x : visible x++------------------------------------------------------------------------+-- renaming tags++-- | Rename a given tag if present in the StackSet.+-- 408 renameTag :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd++prop_rename1 (x::T) o n = o `tagMember` x && not (n `tagMember` x) ==>+ let y = renameTag o n x+ in n `tagMember` y++prop_ensure (x :: T) l xs = let y = ensureTags l xs x+ in and [ n `tagMember` y | n <- xs ]++prop_mapWorkspaceId (x::T) = x == mapWorkspace id x++prop_mapWorkspaceInverse (x::T) = x == mapWorkspace predTag (mapWorkspace succTag x)+ where predTag w = w { tag = pred $ tag w }+ succTag w = w { tag = succ $ tag w }++prop_mapLayoutId (x::T) = x == mapLayout id x++prop_mapLayoutInverse (x::T) = x == mapLayout pred (mapLayout succ x)++------------------------------------------------------------------------ -- some properties for layouts: -- 1 window should always be tiled fullscreen {- prop_tile_fullscreen rect = tile pct rect 1 1 == [rect] --- multiple windows +-- multiple windows prop_tile_non_overlap rect windows nmaster = noOverlaps (tile pct rect nmaster windows) where _ = rect :: Rectangle @@ -561,20 +688,27 @@ ,("index/length" , mytest prop_index_length) ,("focus left : invariant", mytest prop_focusUp_I)+ ,("focus master : invariant", mytest prop_focusMaster_I) ,("focus right: invariant", mytest prop_focusDown_I) ,("focusWindow: invariant", mytest prop_focus_I) ,("focus left/master" , mytest prop_focus_left_master) ,("focus right/master" , mytest prop_focus_right_master)+ ,("focus master/master" , mytest prop_focus_master_master) ,("focusWindow master" , mytest prop_focusWindow_master) ,("focus left/right" , mytest prop_focus_left) ,("focus right/left" , mytest prop_focus_right) ,("focus all left " , mytest prop_focus_all_l) ,("focus all right " , mytest prop_focus_all_r)- ,("focus is local" , mytest prop_focus_local)+ ,("focus down is local" , mytest prop_focus_down_local)+ ,("focus up is local" , mytest prop_focus_up_local)+ ,("focus master is local" , mytest prop_focus_master_local)+ ,("focus master idemp" , mytest prop_focusMaster_idem)+ ,("focusWindow is local", mytest prop_focusWindow_local) ,("focusWindow works" , mytest prop_focusWindow_works) ,("findIndex" , mytest prop_findIndex)+ ,("allWindows/member" , mytest prop_allWindowsMember) ,("insert: invariant" , mytest prop_insertUp_I) ,("insert/new" , mytest prop_insert_empty)@@ -611,7 +745,31 @@ ,("shift: invariant" , mytest prop_shift_I) ,("shift is reversible" , mytest prop_shift_reversible)+ ,("shiftWin: invariant" , mytest prop_shift_win_I)+ ,("shiftWin is shift on focus" , mytest prop_shift_win_focus)+ ,("shiftWin fix current" , mytest prop_shift_win_fix_current) + ,("floating is reversible" , mytest prop_float_reversible)+ ,("screens includes current", mytest prop_screens)+ ,("differentiate works", mytest prop_differentiate)+ ,("lookupTagOnScreen", mytest prop_lookup_current)+ ,("lookupTagOnVisbleScreen", mytest prop_lookup_visible)+ ,("screens works", mytest prop_screens_works)+ ,("renaming works", mytest prop_rename1)+ ,("ensure works", mytest prop_ensure)++ ,("mapWorkspace id", mytest prop_mapWorkspaceId)+ ,("mapWorkspace inverse", mytest prop_mapWorkspaceInverse)+ ,("mapLayout id", mytest prop_mapLayoutId)+ ,("mapLayout inverse", mytest prop_mapLayoutInverse)++ -- testing for failure:+ ,("abort fails", mytest prop_abort)+ ,("new fails with abort", mytest prop_new_abort)+ ,("shiftWin identity", mytest prop_shift_win_indentity)++ -- renaming+ {- ,("tile 1 window fullsize", mytest prop_tile_fullscreen) ,("tiles never overlap", mytest prop_tile_non_overlap)@@ -781,8 +939,9 @@ arbitrary = do (NonEmptyNubList ns) <- arbitrary (NonEmptyNubList sds) <- arbitrary+ l <- arbitrary -- there cannot be more screens than workspaces:- return . EmptyStackSet . new ns $ take (min (length ns) (length sds)) sds+ return . EmptyStackSet . new l ns $ take (min (length ns) (length sds)) sds -- | Generates a value that satisfies a predicate. suchThat :: Gen a -> (a -> Bool) -> Gen a
tests/loc.hs view
@@ -9,7 +9,6 @@ -- uncomment the following to check for mistakes in isntcomment -- putStr $ unlines $ actual_loc -isntcomment "" = False isntcomment ('-':'-':_) = False isntcomment ('{':'-':_) = False -- pragmas isntcomment _ = True
util/GenerateManpage.hs view
@@ -4,14 +4,14 @@ -- -- Format for the docstrings in Config.hs takes the following form: ----- -- mod-x @@ Frob the whatsit+-- -- mod-x %! Frob the whatsit -- -- "Frob the whatsit" will be used as the description for keybinding "mod-x" -- -- If the keybinding name is omitted, it will try to guess from the rest of the -- line. For example: ----- [ ((modMask .|. shiftMask, xK_Return), spawn "xterm") -- @@ Launch an xterm+-- [ ((modMask .|. shiftMask, xK_Return), spawn "xterm") -- %! Launch an xterm -- -- Here, mod-shift-return will be used as the keybinding name. --@@ -32,7 +32,7 @@ binding [ _, _, keyCombo, desc ] = (keyCombo, desc) allBindings :: String -> [(String, String)]-allBindings xs = map (binding . map trim) (xs =~ "(.*)--(.*)@@(.*)")+allBindings xs = map (binding . map trim) (xs =~ "(.*)--(.*)%!(.*)") -- FIXME: What escaping should we be doing on these strings? troff :: (String, String) -> String
xmonad.cabal view
@@ -1,24 +1,23 @@ name: xmonad-version: 0.3+version: 0.4 homepage: http://xmonad.org synopsis: A lightweight X11 window manager. description:- Xmonad is a minimalist tiling window manager for X, written in- Haskell. Windows are managed using automatic layout algorithms,- which can be dynamically reconfigured. At any time windows are- arranged so as to maximise the use of screen real estate. All- features of the window manager are accessible purely from the- keyboard: a mouse is entirely optional. Xmonad is configured in- Haskell, and custom layout algorithms may be implemented by the user- in config files. A principle of Xmonad is predictability: the user- should know in advance precisely the window arrangement that will- result from any action.+ xmonad is a tiling window manager for X. Windows are arranged+ automatically to tile the screen without gaps or overlap, 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. Custom layout algorithms, 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 screens. category: System license: BSD3 license-file: LICENSE author: Spencer Janssen maintainer: sjanssen@cse.unl.edu-build-depends: base>=2.0, X11>=1.2.1, X11-extras>=0.3, mtl>=1.0, unix>=1.0+build-depends: base>=2.0, X11>=1.2.1, X11-extras>=0.4, mtl>=1.0, unix>=1.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 @@ -28,4 +27,4 @@ ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s ghc-prof-options: -prof -auto-all extensions: GeneralizedNewtypeDeriving--- Also requires deriving Typeable+-- Also requires deriving Typeable, PatternGuards