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