diff --git a/Config.hs b/Config.hs
--- a/Config.hs
+++ b/Config.hs
@@ -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
diff --git a/Config.hs-boot b/Config.hs-boot
--- a/Config.hs-boot
+++ b/Config.hs-boot
@@ -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]
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -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
diff --git a/Main.hs b/Main.hs
--- a/Main.hs
+++ b/Main.hs
@@ -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
diff --git a/Operations.hs b/Operations.hs
--- a/Operations.hs
+++ b/Operations.hs
@@ -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)
diff --git a/README b/README
--- a/README
+++ b/README
@@ -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
------------------------------------------------------------------------
diff --git a/StackSet.hs b/StackSet.hs
--- a/StackSet.hs
+++ b/StackSet.hs
@@ -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
+
diff --git a/TODO b/TODO
--- a/TODO
+++ b/TODO
@@ -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
diff --git a/XMonad.hs b/XMonad.hs
--- a/XMonad.hs
+++ b/XMonad.hs
@@ -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
diff --git a/man/xmonad.1 b/man/xmonad.1
--- a/man/xmonad.1
+++ b/man/xmonad.1
@@ -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
diff --git a/man/xmonad.html b/man/xmonad.html
--- a/man/xmonad.html
+++ b/man/xmonad.html
@@ -3,8 +3,8 @@
Manpage of xmonad
xmonad
-Section: xmonad manual (1)
Updated: 18 April 07
Index
-Return to Main Contents
+Section: xmonad manual (1)
Updated: 16 October 07
Index
+Return to Main Contents
NAME
@@ -81,6 +81,9 @@
mod-space
Rotate through the available layout algorithms
+
mod-shift-space
+Reset the layouts on the current workspace to default
+
mod-n
Resize viewed windows to the correct size
@@ -93,6 +96,9 @@
mod-k
Move focus to the previous window
+
mod-m
+Move focus to the master window
+
mod-return
Swap the focused window and the master window
@@ -184,6 +190,6 @@
This document was created by
man2html,
using the manual pages.
-Time: 04:55:21 GMT, August 24, 2007
+Time: 21:33:21 GMT, October 16, 2007
diff --git a/tests/Properties.hs b/tests/Properties.hs
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -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
diff --git a/tests/loc.hs b/tests/loc.hs
--- a/tests/loc.hs
+++ b/tests/loc.hs
@@ -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
diff --git a/util/GenerateManpage.hs b/util/GenerateManpage.hs
--- a/util/GenerateManpage.hs
+++ b/util/GenerateManpage.hs
@@ -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
diff --git a/xmonad.cabal b/xmonad.cabal
--- a/xmonad.cabal
+++ b/xmonad.cabal
@@ -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