mirror of
https://github.com/xmonad/xmonad.git
synced 2025-08-02 13:11:53 -07:00
Compare commits
149 Commits
Author | SHA1 | Date | |
---|---|---|---|
|
f2461c9e3a | ||
|
11b37429b1 | ||
|
bbf5d0010c | ||
|
2f60ee5680 | ||
|
3e2d48d5da | ||
|
462422d07a | ||
|
33f28ed2ac | ||
|
a29590034a | ||
|
f394956e56 | ||
|
039d9e2b96 | ||
|
a73f8ec709 | ||
|
1bb18654d6 | ||
|
fa45d59e95 | ||
|
f73f8f38a5 | ||
|
28cc666a75 | ||
|
c8f16a85cf | ||
|
6908189698 | ||
|
39eccc350c | ||
|
c8ab301c95 | ||
|
5e310c0c94 | ||
|
4fa10442ab | ||
|
1ab1d729a0 | ||
|
c95b8d9160 | ||
|
92b4510d7b | ||
|
6114bb371e | ||
|
7e2ec3840c | ||
|
6ce125a566 | ||
|
3456086f85 | ||
|
3b83895d28 | ||
|
dc6ba6b5ee | ||
|
df5003eb16 | ||
|
99dd1a30ba | ||
|
d6c5eb3e80 | ||
|
9d9b733994 | ||
|
ea71fd67e8 | ||
|
e9eadd6141 | ||
|
ddf9e49e49 | ||
|
81803ffe81 | ||
|
31ce83d04e | ||
|
c2ae7a8c71 | ||
|
45eea722be | ||
|
4bb6371155 | ||
|
dfd4d435d8 | ||
|
ac41c8fb52 | ||
|
223b48ab27 | ||
|
107b942414 | ||
|
6aee5509de | ||
|
ba6d9c8a52 | ||
|
3a995b40c9 | ||
|
656f4551da | ||
|
6ae94edbe4 | ||
|
22ccca29e6 | ||
|
2302bb3304 | ||
|
b4e0e77911 | ||
|
dcf53fbaf6 | ||
|
833e37da9c | ||
|
cf0c3b9ab6 | ||
|
532a920bce | ||
|
0d506daf45 | ||
|
4887c5ac42 | ||
|
3d0c08365d | ||
|
e4c2a81ca1 | ||
|
58fc2bc59e | ||
|
c8473e3ae9 | ||
|
11711e1a46 | ||
|
99fb75eb9b | ||
|
ceb1c51b3f | ||
|
14b6306ac2 | ||
|
b51f6f55a8 | ||
|
e2ab6e8a27 | ||
|
a5200b3862 | ||
|
f81ec95fa0 | ||
|
39f4fe7a90 | ||
|
d50d6c909d | ||
|
dbfd13207d | ||
|
6eb23670bb | ||
|
bbe4a27f65 | ||
|
94924123bb | ||
|
ece268cd1e | ||
|
dfd8e51136 | ||
|
0de10862c2 | ||
|
f7b6a4508f | ||
|
00f83ac78a | ||
|
3a902ce613 | ||
|
5342be0e67 | ||
|
88845e5d97 | ||
|
4732557c12 | ||
|
a13c11ff52 | ||
|
fcea17f920 | ||
|
a5acef3ad6 | ||
|
76e960a40c | ||
|
30af3a8f84 | ||
|
c9142952c2 | ||
|
934fb2c368 | ||
|
d1c29a40cf | ||
|
cd9c592ebc | ||
|
131e060533 | ||
|
4996b1bc47 | ||
|
4b2366b5ce | ||
|
0590f5da9e | ||
|
c3c39aae12 | ||
|
7bc4ab41c7 | ||
|
7dc2d254d1 | ||
|
528d51e58a | ||
|
9ef3fdcf08 | ||
|
e8d3f674ef | ||
|
8a5d2490bb | ||
|
22aacf9bf6 | ||
|
b0b43050f4 | ||
|
23035e944b | ||
|
bf52d34bbf | ||
|
8a8c538c23 | ||
|
e50927ffc0 | ||
|
3789f37f25 | ||
|
48ccbc7fb2 | ||
|
d679ceb234 | ||
|
7b3c1243b7 | ||
|
97fe14dfd2 | ||
|
c1e039ba88 | ||
|
9bd11aeea5 | ||
|
c350caf9b8 | ||
|
066da1cd99 | ||
|
cadf81976f | ||
|
ddd1fa9cae | ||
|
3bd63adb60 | ||
|
e384a358b5 | ||
|
8971ab7fae | ||
|
2e8794d0f3 | ||
|
92d58ae0a8 | ||
|
33e14e7ba7 | ||
|
ec45881d4c | ||
|
b73ac809ba | ||
|
d0507c9eb3 | ||
|
fc82a7d412 | ||
|
cc019f487c | ||
|
4c7cf15cdb | ||
|
350a4d6f6b | ||
|
1ddaffbfba | ||
|
0903c76d40 | ||
|
156a89b761 | ||
|
1ea1c05617 | ||
|
f5ad470815 | ||
|
1be4bc5d91 | ||
|
0514380d76 | ||
|
18cf8fbb10 | ||
|
eb65473591 | ||
|
c734586275 | ||
|
74131eb15f | ||
|
ac94932345 |
82
CONFIG
Normal file
82
CONFIG
Normal file
@@ -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.
|
@@ -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]
|
|
265
Main.hs
265
Main.hs
@@ -12,251 +12,38 @@
|
|||||||
--
|
--
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
module Main where
|
module Main (main) where
|
||||||
|
|
||||||
import Data.Bits
|
import XMonad.Main
|
||||||
import qualified Data.Map as M
|
import XMonad.Config
|
||||||
import qualified Data.Set as S
|
import XMonad.Core (getXMonadDir, recompile)
|
||||||
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
|
|
||||||
import Config
|
|
||||||
import StackSet (new, floating, member)
|
|
||||||
import qualified StackSet as W
|
|
||||||
import Operations
|
|
||||||
|
|
||||||
|
import Control.Exception (handle)
|
||||||
import System.IO
|
import System.IO
|
||||||
|
import System.Environment
|
||||||
|
import System.Posix.Process (executeFile)
|
||||||
|
|
||||||
-- |
|
-- | The entry point into xmonad. Attempts to compile any custom main
|
||||||
-- The main entry point
|
-- for xmonad, and if it doesn't find one, just launches the default.
|
||||||
--
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
dpy <- openDisplay ""
|
handle (hPrint stderr) buildLaunch
|
||||||
let dflt = defaultScreen dpy
|
xmonad defaultConfig -- if buildLaunch returns, execute the trusted core
|
||||||
|
|
||||||
rootw <- rootWindow dpy dflt
|
-- | Build "~/.xmonad/xmonad.hs" with ghc, then execute it. If there are no
|
||||||
xinesc <- getScreenInfo dpy
|
-- errors, this function does not return. An exception is raised in any of
|
||||||
nbc <- initColor dpy normalBorderColor
|
-- these cases:
|
||||||
fbc <- initColor dpy focusedBorderColor
|
-- * ghc missing
|
||||||
hSetBuffering stdout NoBuffering
|
-- * ~/.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
|
args <- getArgs
|
||||||
|
executeFile (dir ++ "/xmonad") False args Nothing
|
||||||
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)
|
|
||||||
|
|
||||||
return ()
|
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
|
|
||||||
|
160
README
160
README
@@ -1,76 +1,101 @@
|
|||||||
xmonad : a lightweight X11 window manager.
|
xmonad : a tiling window manager
|
||||||
|
|
||||||
http://xmonad.org
|
http://xmonad.org
|
||||||
|
|
||||||
------------------------------------------------------------------------
|
xmonad is a tiling window manager for X. Windows are arranged
|
||||||
|
automatically to tile the screen without gaps or overlap, maximising
|
||||||
About:
|
screen use. Window manager features are accessible from the
|
||||||
|
keyboard: a mouse is optional. xmonad is written, configured and
|
||||||
Xmonad is a tiling window manager for X. Windows are managed using
|
extensible in Haskell. Custom layout algorithms, key bindings and
|
||||||
automatic tiling algorithms, which can be dynamically configured.
|
other extensions may be written by the user in config files. Layouts
|
||||||
Windows are arranged so as to tile the screen without gaps, maximising
|
are applied dynamically, and different layouts may be used on each
|
||||||
screen use. All features of the window manager are accessible
|
workspace. Xinerama is fully supported, allowing windows to be tiled
|
||||||
from the keyboard: a mouse is strictly optional. Xmonad is written
|
on several physical screens.
|
||||||
and extensible in Haskell, and custom layout algorithms may be
|
|
||||||
implemented by the user in config files. A guiding principle of the
|
|
||||||
user interface is <i>predictability</i>: users should know in
|
|
||||||
advance precisely the window arrangement that will result from any
|
|
||||||
action, leading to an intuitive user interface.
|
|
||||||
|
|
||||||
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.
|
|
||||||
|
|
||||||
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.
|
|
||||||
|
|
||||||
------------------------------------------------------------------------
|
|
||||||
|
|
||||||
Building:
|
Building:
|
||||||
|
|
||||||
Get the dependencies
|
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.
|
||||||
|
|
||||||
Firstly, you'll need the C X11 library headers. On many platforms,
|
We'll now walk through the complete list of toolchain dependencies.
|
||||||
these come pre-installed. For others, such as Debian, you can get
|
|
||||||
them from your package manager:
|
* 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
|
||||||
|
|
||||||
|
For example, in Debian you would install GHC with:
|
||||||
|
|
||||||
|
apt-get install ghc6
|
||||||
|
|
||||||
|
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
|
apt-get install libx11-dev
|
||||||
|
|
||||||
It is likely that you already have some of these dependencies. To check
|
Typically you need: libXinerama libXext libX11
|
||||||
whether you've got a package run 'ghc-pkg list some_package_name'
|
|
||||||
|
|
||||||
mtl http://hackage.haskell.org/cgi-bin/hackage-scripts/package/mtl-1.0
|
* Cabal
|
||||||
unix http://hackage.haskell.org/cgi-bin/hackage-scripts/package/unix-2.0
|
|
||||||
X11 http://hackage.haskell.org/cgi-bin/hackage-scripts/package/X11-1.2.3
|
xmonad requires a recent version of Cabal, >= 1.2.0. If you're using
|
||||||
X11-extras: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/X11-extras-0.4
|
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:
|
||||||
|
|
||||||
And then build with Cabal:
|
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/Cabal
|
||||||
|
|
||||||
runhaskell Setup.lhs configure --prefix=$HOME
|
You can check which version you have with the command:
|
||||||
runhaskell Setup.lhs build
|
|
||||||
runhaskell Setup.lhs install --user
|
$ 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
|
||||||
|
|
||||||
|
* Build xmonad:
|
||||||
|
|
||||||
|
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
|
Notes for using the darcs version
|
||||||
|
|
||||||
If you're building the darcs version of xmonad, be sure to also
|
If you're building the darcs version of xmonad, be sure to also
|
||||||
use the darcs version of X11-extras, which is developed concurrently
|
use the darcs version of the X11 library, which is developed
|
||||||
with xmonad.
|
concurrently with xmonad.
|
||||||
|
|
||||||
darcs get http://code.haskell.org/X11-extras
|
darcs get http://darcs.haskell.org/X11
|
||||||
|
|
||||||
Not using X11-extras from darcs, is the most common reason for the
|
Not using X11 from darcs is the most common reason for the
|
||||||
darcs version of xmonad to fail to build.
|
darcs version of xmonad to fail to build.
|
||||||
|
|
||||||
------------------------------------------------------------------------
|
------------------------------------------------------------------------
|
||||||
@@ -85,33 +110,40 @@ Running xmonad:
|
|||||||
|
|
||||||
------------------------------------------------------------------------
|
------------------------------------------------------------------------
|
||||||
|
|
||||||
|
Configuring:
|
||||||
|
|
||||||
|
See the CONFIG document
|
||||||
|
|
||||||
|
------------------------------------------------------------------------
|
||||||
|
|
||||||
XMonadContrib
|
XMonadContrib
|
||||||
|
|
||||||
There are various contributed modules that can be used with xmonad.
|
There are many extensions to xmonad available in the XMonadContrib
|
||||||
Examples include an ion3-like tabbed layout, a prompt/program launcher,
|
(xmc) library. Examples include an ion3-like tabbed layout, a
|
||||||
and various other useful modules. XMonadContrib is available at:
|
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:
|
Other useful programs:
|
||||||
|
|
||||||
For a program dispatch menu:
|
A nicer xterm replacment, that supports resizing better:
|
||||||
|
|
||||||
dmenu http://www.suckless.org/download/
|
urxvt http://software.schmorp.de/pkg/rxvt-unicode.html
|
||||||
or
|
|
||||||
gmrun (in your package system)
|
|
||||||
|
|
||||||
For custom status bars:
|
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:
|
Authors:
|
||||||
|
|
||||||
|
21
STYLE
Normal file
21
STYLE
Normal file
@@ -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).
|
15
TODO
15
TODO
@@ -1,15 +1,20 @@
|
|||||||
- Write down invariants for the window life cycle, especially:
|
- Write down invariants for the window life cycle, especially:
|
||||||
- When are borders set? Prove that the current handling is sufficient.
|
- 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 =
|
= Release management =
|
||||||
|
|
||||||
* build and typecheck all XMC
|
* configuration documentation
|
||||||
|
|
||||||
* generate haddocks for core and XMC, upload to xmonad.org
|
* generate haddocks for core and XMC, upload to xmonad.org
|
||||||
* generate manpage, generate html manpage
|
* generate manpage, generate html manpage
|
||||||
* document, with photos, any new layouts
|
|
||||||
* double check README build instructions
|
* double check README build instructions
|
||||||
* test core with 6.6 and 6.8
|
* test core with 6.6 and 6.8
|
||||||
* upload X11/X11-extras/xmonad to hacakge
|
* bump xmonad.cabal version and X11 version
|
||||||
* check examples/text in use-facing Config.hs
|
* 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
|
* check tour.html and intro.html are up to date, and mention all core bindings
|
||||||
* bump xmonad.cabal version
|
|
||||||
|
303
XMonad.hs
303
XMonad.hs
@@ -1,276 +1,47 @@
|
|||||||
{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}
|
--------------------------------------------------------------------
|
||||||
|
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.hs
|
-- Module : XMonad
|
||||||
-- Copyright : (c) Spencer Janssen 2007
|
-- Copyright : (c) Don Stewart
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3
|
||||||
--
|
--
|
||||||
-- Maintainer : sjanssen@cse.unl.edu
|
-- Maintainer: Don Stewart <dons@galois.com>
|
||||||
-- Stability : unstable
|
-- Stability : provisional
|
||||||
-- Portability : not portable, uses cunning newtype deriving
|
-- 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 (
|
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
|
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(..)
|
||||||
|
|
||||||
|
) where
|
||||||
|
|
||||||
|
-- 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
|
||||||
|
|
||||||
|
-- modules needed to get basic configuration working
|
||||||
|
import Data.Bits
|
||||||
|
import Graphics.X11 hiding (refreshKeyboardMapping)
|
||||||
|
import Graphics.X11.Xlib.Extras
|
||||||
|
|
||||||
import Prelude hiding ( catch )
|
|
||||||
import Control.Exception (catch, throw, Exception(ExitException))
|
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Control.Monad.Reader
|
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 ()
|
|
||||||
|
|
||||||
-- | 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
|
|
||||||
|
|
||||||
-- | 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
|
|
||||||
|
|
||||||
-- | 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 :: String -> X ()
|
|
||||||
trace msg = io $! do hPutStrLn stderr msg; hFlush stderr
|
|
||||||
|
@@ -1,6 +1,7 @@
|
|||||||
|
{-# OPTIONS -fno-warn-missing-signatures #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : Config.hs
|
-- Module : XMonad.Config
|
||||||
-- Copyright : (c) Spencer Janssen 2007
|
-- Copyright : (c) Spencer Janssen 2007
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -8,28 +9,33 @@
|
|||||||
-- Stability : stable
|
-- Stability : stable
|
||||||
-- Portability : portable
|
-- Portability : portable
|
||||||
--
|
--
|
||||||
-- This module specifies configurable defaults for xmonad. If you change
|
-- This module specifies the default configuration values for xmonad.
|
||||||
-- values here, be sure to recompile and restart (mod-q) xmonad,
|
-- Users should not modify this file. Rather, they should provide their
|
||||||
-- for the changes to take effect.
|
-- own @~\/.xmonad\/xmonad.hs@ that overrides specific fields in defaultConfig.
|
||||||
--
|
--
|
||||||
------------------------------------------------------------------------
|
------------------------------------------------------------------------
|
||||||
|
|
||||||
module Config where
|
module XMonad.Config (defaultConfig) where
|
||||||
|
|
||||||
--
|
--
|
||||||
-- Useful imports
|
-- Useful imports
|
||||||
--
|
--
|
||||||
import XMonad
|
import XMonad.Core as XMonad hiding
|
||||||
import Operations
|
(workspaces,manageHook,numlockMask,keys,logHook,borderWidth,mouseBindings
|
||||||
import qualified StackSet as W
|
,defaultGaps,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor)
|
||||||
import Data.Ratio
|
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 Data.Bits ((.|.))
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import Graphics.X11.Xlib
|
import Graphics.X11.Xlib
|
||||||
|
|
||||||
-- % Extension-provided imports
|
|
||||||
|
|
||||||
-- | The default number of workspaces (virtual screens) and their names.
|
-- | The default number of workspaces (virtual screens) and their names.
|
||||||
-- By default we use numeric strings, but any string may be used as a
|
-- 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
|
-- workspace name. The number of workspaces is determined by the length
|
||||||
@@ -47,8 +53,8 @@ workspaces = map show [1 .. 9 :: Int]
|
|||||||
-- ("right alt"), which does not conflict with emacs keybindings. The
|
-- ("right alt"), which does not conflict with emacs keybindings. The
|
||||||
-- "windows key" is usually mod4Mask.
|
-- "windows key" is usually mod4Mask.
|
||||||
--
|
--
|
||||||
modMask :: KeyMask
|
defaultModMask :: KeyMask
|
||||||
modMask = mod1Mask
|
defaultModMask = mod1Mask
|
||||||
|
|
||||||
-- | The mask for the numlock key. Numlock status is "masked" from the
|
-- | The mask for the numlock key. Numlock status is "masked" from the
|
||||||
-- current modifier status, so the keybindings will work with numlock on or
|
-- current modifier status, so the keybindings will work with numlock on or
|
||||||
@@ -100,67 +106,16 @@ defaultGaps = [(0,0,0,0)] -- 15 for default dzen font
|
|||||||
-- particular program, or have a client always appear on a particular
|
-- particular program, or have a client always appear on a particular
|
||||||
-- workspace.
|
-- workspace.
|
||||||
--
|
--
|
||||||
manageHook :: Window -- ^ the new window to manage
|
-- To find the property name associated with a program, use
|
||||||
-> String -- ^ window title
|
-- xprop | grep WM_CLASS
|
||||||
-> String -- ^ window resource name
|
-- and click on the client you're interested in.
|
||||||
-> 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'
|
manageHook :: ManageHook
|
||||||
-- above, but you may program your own selection behaviour here. Layout
|
manageHook = composeAll
|
||||||
-- transformers, for example, would be hooked in here.
|
[ className =? "MPlayer" --> doFloat
|
||||||
--
|
, className =? "Gimp" --> doFloat
|
||||||
layoutHook :: Layout Window
|
, resource =? "desktop_window" --> doIgnore
|
||||||
layoutHook = Layout $ Select layouts
|
, resource =? "kdesktop" --> doIgnore ]
|
||||||
|
|
||||||
-- | 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
|
-- Logging
|
||||||
@@ -175,23 +130,53 @@ serialisedLayouts = layoutHook : layouts
|
|||||||
logHook :: X ()
|
logHook :: X ()
|
||||||
logHook = return ()
|
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:
|
-- 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 xmonad key bindings. Add, modify or remove key bindings here.
|
||||||
--
|
--
|
||||||
-- (The comment formatting character is used when generating the manpage)
|
-- (The comment formatting character is used when generating the manpage)
|
||||||
--
|
--
|
||||||
keys :: M.Map (KeyMask, KeySym) (X ())
|
keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
|
||||||
keys = M.fromList $
|
keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
|
||||||
-- launching and killing programs
|
-- launching and killing programs
|
||||||
[ ((modMask .|. shiftMask, xK_Return), spawn "xterm") -- %! Launch an xterm
|
[ ((modMask .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal
|
||||||
, ((modMask, xK_p ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu
|
, ((modMask, xK_p ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu
|
||||||
, ((modMask .|. shiftMask, xK_p ), spawn "gmrun") -- %! Launch gmrun
|
, ((modMask .|. shiftMask, xK_p ), spawn "gmrun") -- %! Launch gmrun
|
||||||
, ((modMask .|. shiftMask, xK_c ), kill) -- %! Close the focused window
|
, ((modMask .|. shiftMask, xK_c ), kill) -- %! Close the focused window
|
||||||
|
|
||||||
, ((modMask, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms
|
, ((modMask, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms
|
||||||
, ((modMask .|. shiftMask, xK_space ), setLayout layoutHook) -- %! Reset the layouts on the current workspace to default
|
, ((modMask .|. 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
|
, ((modMask, xK_n ), refresh) -- %! Resize viewed windows to the correct size
|
||||||
|
|
||||||
@@ -218,19 +203,17 @@ keys = M.fromList $
|
|||||||
, ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement 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
|
-- toggle the status bar gap
|
||||||
, ((modMask , xK_b ), modifyGap (\i n -> let x = (defaultGaps ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap
|
, ((modMask , xK_b ), modifyGap (\i n -> let x = (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
|
-- quit, or restart
|
||||||
, ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit xmonad
|
, ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit xmonad
|
||||||
, ((modMask , xK_q ), broadcastMessage ReleaseResources >> restart Nothing True) -- %! Restart xmonad
|
, ((modMask , xK_q ), broadcastMessage ReleaseResources >> restart (Just "xmonad") True) -- %! Restart xmonad
|
||||||
|
|
||||||
-- % Extension-provided key bindings
|
|
||||||
]
|
]
|
||||||
++
|
++
|
||||||
-- mod-[1..9] %! Switch to workspace N
|
-- mod-[1..9] %! Switch to workspace N
|
||||||
-- mod-shift-[1..9] %! Move client to workspace N
|
-- mod-shift-[1..9] %! Move client to workspace N
|
||||||
[((m .|. modMask, k), windows $ f i)
|
[((m .|. modMask, k), windows $ f i)
|
||||||
| (i, k) <- zip workspaces [xK_1 ..]
|
| (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]
|
||||||
, (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
|
, (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
|
||||||
++
|
++
|
||||||
-- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3
|
-- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3
|
||||||
@@ -239,12 +222,10 @@ keys = M.fromList $
|
|||||||
| (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
|
| (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
|
||||||
, (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
|
, (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
|
||||||
|
|
||||||
-- % Extension-provided key bindings lists
|
|
||||||
|
|
||||||
-- | Mouse bindings: default actions bound to mouse events
|
-- | Mouse bindings: default actions bound to mouse events
|
||||||
--
|
--
|
||||||
mouseBindings :: M.Map (KeyMask, Button) (Window -> X ())
|
mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
|
||||||
mouseBindings = M.fromList $
|
mouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList $
|
||||||
-- mod-button1 %! Set the window to floating mode and move by dragging
|
-- mod-button1 %! Set the window to floating mode and move by dragging
|
||||||
[ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w))
|
[ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w))
|
||||||
-- mod-button2 %! Raise the window to the top of the stack
|
-- mod-button2 %! Raise the window to the top of the stack
|
||||||
@@ -252,8 +233,20 @@ mouseBindings = M.fromList $
|
|||||||
-- mod-button3 %! Set the window to floating mode and resize by dragging
|
-- mod-button3 %! Set the window to floating mode and resize by dragging
|
||||||
, ((modMask, button3), (\w -> focus w >> mouseResizeWindow w))
|
, ((modMask, button3), (\w -> focus w >> mouseResizeWindow w))
|
||||||
-- you may also bind events to the mouse scroll wheel (button4 and button5)
|
-- you may also bind events to the mouse scroll wheel (button4 and button5)
|
||||||
|
|
||||||
-- % Extension-provided mouse bindings
|
|
||||||
]
|
]
|
||||||
|
|
||||||
-- % Extension-provided definitions
|
-- | 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 }
|
370
XMonad/Core.hs
Normal file
370
XMonad/Core.hs
Normal file
@@ -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
|
175
XMonad/Layout.hs
Normal file
175
XMonad/Layout.hs
Normal file
@@ -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
|
279
XMonad/Main.hs
Normal file
279
XMonad/Main.hs
Normal file
@@ -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)
|
78
XMonad/ManageHook.hs
Normal file
78
XMonad/ManageHook.hs
Normal file
@@ -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)
|
@@ -16,22 +16,22 @@
|
|||||||
--
|
--
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
module Operations where
|
module XMonad.Operations where
|
||||||
|
|
||||||
import XMonad
|
import XMonad.Core
|
||||||
import qualified StackSet as W
|
import XMonad.Layout (Full(..))
|
||||||
import {-# SOURCE #-} Config (borderWidth,logHook,manageHook,numlockMask,serialisedLayouts)
|
import qualified XMonad.StackSet as W
|
||||||
|
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.List (nub, (\\), find, partition)
|
import Data.List (nub, (\\), find)
|
||||||
import Data.Bits ((.|.), (.&.), complement)
|
import Data.Bits ((.|.), (.&.), complement)
|
||||||
import Data.Ratio
|
import Data.Ratio
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
|
||||||
|
import Control.Applicative
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Arrow ((***), second)
|
|
||||||
|
|
||||||
import System.IO
|
import System.IO
|
||||||
import Graphics.X11.Xlib
|
import Graphics.X11.Xlib
|
||||||
@@ -48,11 +48,11 @@ import Graphics.X11.Xlib.Extras
|
|||||||
-- border set, and its event mask set.
|
-- border set, and its event mask set.
|
||||||
--
|
--
|
||||||
manage :: Window -> X ()
|
manage :: Window -> X ()
|
||||||
manage w = whenX (fmap not $ isClient w) $ withDisplay $ \d -> do
|
manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
|
||||||
sh <- io $ getWMNormalHints d w
|
sh <- io $ getWMNormalHints d w
|
||||||
|
|
||||||
let isFixedSize = sh_min_size sh /= Nothing && sh_min_size sh == sh_max_size sh
|
let isFixedSize = sh_min_size sh /= Nothing && sh_min_size sh == sh_max_size sh
|
||||||
isTransient <- isJust `liftM` io (getTransientForHint d w)
|
isTransient <- isJust <$> io (getTransientForHint d w)
|
||||||
|
|
||||||
(sc, rr) <- floatLocation w
|
(sc, rr) <- floatLocation w
|
||||||
-- ensure that float windows don't go over the edge of the screen
|
-- ensure that float windows don't go over the edge of the screen
|
||||||
@@ -64,9 +64,8 @@ manage w = whenX (fmap not $ isClient w) $ withDisplay $ \d -> do
|
|||||||
| otherwise = W.insertUp w ws
|
| otherwise = W.insertUp w ws
|
||||||
where i = fromMaybe (W.tag . W.workspace . W.current $ ws) $ W.lookupWorkspace sc ws
|
where i = fromMaybe (W.tag . W.workspace . W.current $ ws) $ W.lookupWorkspace sc ws
|
||||||
|
|
||||||
n <- fmap (fromMaybe "") $ io $ fetchName d w
|
mh <- asks (manageHook . config)
|
||||||
(ClassHint rn rc) <- io $ getClassHint d w
|
g <- runManageHook mh w `catchX` return id
|
||||||
g <- manageHook w n rn rc `catchX` return id
|
|
||||||
windows (g . f)
|
windows (g . f)
|
||||||
|
|
||||||
-- | unmanage. A window no longer exists, remove it from the window
|
-- | unmanage. A window no longer exists, remove it from the window
|
||||||
@@ -77,7 +76,7 @@ manage w = whenX (fmap not $ isClient w) $ withDisplay $ \d -> do
|
|||||||
unmanage :: Window -> X ()
|
unmanage :: Window -> X ()
|
||||||
unmanage w = do
|
unmanage w = do
|
||||||
windows (W.delete w)
|
windows (W.delete w)
|
||||||
setWMState w 0 {-withdrawn-}
|
setWMState w withdrawnState
|
||||||
modify (\s -> s {mapped = S.delete w (mapped s), waitingUnmap = M.delete w (waitingUnmap s)})
|
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
|
-- | Modify the size of the status gap at the top of the current screen
|
||||||
@@ -110,10 +109,6 @@ kill = withDisplay $ \d -> withFocused $ \w -> do
|
|||||||
-- ---------------------------------------------------------------------
|
-- ---------------------------------------------------------------------
|
||||||
-- Managing windows
|
-- 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. Modify the current window list with a pure function, and refresh
|
||||||
windows :: (WindowSet -> WindowSet) -> X ()
|
windows :: (WindowSet -> WindowSet) -> X ()
|
||||||
windows f = do
|
windows f = do
|
||||||
@@ -139,8 +134,8 @@ windows f = do
|
|||||||
l = W.layout (W.workspace w)
|
l = W.layout (W.workspace w)
|
||||||
flt = filter (flip M.member (W.floating ws)) (W.index this)
|
flt = filter (flip M.member (W.floating ws)) (W.index this)
|
||||||
tiled = (W.stack . W.workspace . W.current $ this)
|
tiled = (W.stack . W.workspace . W.current $ this)
|
||||||
>>= W.filter (not . flip M.member (W.floating ws))
|
>>= W.filter (`M.notMember` W.floating ws)
|
||||||
>>= W.filter (not . (`elem` vis))
|
>>= W.filter (`notElem` vis)
|
||||||
(SD (Rectangle sx sy sw sh)
|
(SD (Rectangle sx sy sw sh)
|
||||||
(gt,gb,gl,gr)) = W.screenDetail w
|
(gt,gb,gl,gr)) = W.screenDetail w
|
||||||
viewrect = Rectangle (sx + fromIntegral gl) (sy + fromIntegral gt)
|
viewrect = Rectangle (sx + fromIntegral gl) (sy + fromIntegral gt)
|
||||||
@@ -169,7 +164,7 @@ windows f = do
|
|||||||
|
|
||||||
whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc
|
whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc
|
||||||
setTopFocus
|
setTopFocus
|
||||||
userCode logHook
|
asks (logHook . config) >>= userCode
|
||||||
-- io performGC -- really helps, but seems to trigger GC bugs?
|
-- io performGC -- really helps, but seems to trigger GC bugs?
|
||||||
|
|
||||||
-- hide every window that was potentially visible before, but is not
|
-- hide every window that was potentially visible before, but is not
|
||||||
@@ -190,7 +185,7 @@ hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do
|
|||||||
io $ do selectInput d w (clientMask .&. complement structureNotifyMask)
|
io $ do selectInput d w (clientMask .&. complement structureNotifyMask)
|
||||||
unmapWindow d w
|
unmapWindow d w
|
||||||
selectInput d w clientMask
|
selectInput d w clientMask
|
||||||
setWMState w 3 --iconic
|
setWMState w iconicState
|
||||||
-- this part is key: we increment the waitingUnmap counter to distinguish
|
-- this part is key: we increment the waitingUnmap counter to distinguish
|
||||||
-- between client and xmonad initiated unmaps.
|
-- between client and xmonad initiated unmaps.
|
||||||
modify (\s -> s { waitingUnmap = M.insertWith (+) w 1 (waitingUnmap s)
|
modify (\s -> s { waitingUnmap = M.insertWith (+) w 1 (waitingUnmap s)
|
||||||
@@ -200,7 +195,7 @@ hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do
|
|||||||
-- this is harmless if the window was already visible
|
-- this is harmless if the window was already visible
|
||||||
reveal :: Window -> X ()
|
reveal :: Window -> X ()
|
||||||
reveal w = withDisplay $ \d -> do
|
reveal w = withDisplay $ \d -> do
|
||||||
setWMState w 1 --normal
|
setWMState w normalState
|
||||||
io $ mapWindow d w
|
io $ mapWindow d w
|
||||||
modify (\s -> s { mapped = S.insert w (mapped s) })
|
modify (\s -> s { mapped = S.insert w (mapped s) })
|
||||||
|
|
||||||
@@ -210,12 +205,14 @@ clientMask = structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
|
|||||||
|
|
||||||
-- | Set some properties when we initially gain control of a window
|
-- | Set some properties when we initially gain control of a window
|
||||||
setInitialProperties :: Window -> X ()
|
setInitialProperties :: Window -> X ()
|
||||||
setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> io $ do
|
setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do
|
||||||
selectInput d w $ clientMask
|
setWMState w iconicState
|
||||||
setWindowBorderWidth d w borderWidth
|
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
|
-- we must initially set the color of new windows, to maintain invariants
|
||||||
-- required by the border setting in 'windows'
|
-- required by the border setting in 'windows'
|
||||||
setWindowBorder d w nb
|
io $ setWindowBorder d w nb
|
||||||
|
|
||||||
-- | refresh. Render the currently visible workspaces, as determined by
|
-- | refresh. Render the currently visible workspaces, as determined by
|
||||||
-- the StackSet. Also, set focus to the focused window.
|
-- the StackSet. Also, set focus to the focused window.
|
||||||
@@ -238,7 +235,7 @@ clearEvents mask = withDisplay $ \d -> io $ do
|
|||||||
-- rectangle, including its border.
|
-- rectangle, including its border.
|
||||||
tileWindow :: Window -> Rectangle -> X ()
|
tileWindow :: Window -> Rectangle -> X ()
|
||||||
tileWindow w r = withDisplay $ \d -> do
|
tileWindow w r = withDisplay $ \d -> do
|
||||||
bw <- (fromIntegral . wa_border_width) `liftM` io (getWindowAttributes d w)
|
bw <- (fromIntegral . wa_border_width) <$> io (getWindowAttributes d w)
|
||||||
-- give all windows at least 1x1 pixels
|
-- give all windows at least 1x1 pixels
|
||||||
let least x | x <= bw*2 = 1
|
let least x | x <= bw*2 = 1
|
||||||
| otherwise = x - bw*2
|
| otherwise = x - bw*2
|
||||||
@@ -300,7 +297,7 @@ setFocusX w = withWindowSet $ \ws -> do
|
|||||||
setButtonGrab True otherw
|
setButtonGrab True otherw
|
||||||
|
|
||||||
-- If we ungrab buttons on the root window, we lose our mouse bindings.
|
-- If we ungrab buttons on the root window, we lose our mouse bindings.
|
||||||
whenX (not `liftM` isRoot w) $ setButtonGrab False w
|
whenX (not <$> isRoot w) $ setButtonGrab False w
|
||||||
io $ do setInputFocus dpy w revertToPointerRoot 0
|
io $ do setInputFocus dpy w revertToPointerRoot 0
|
||||||
-- raiseWindow dpy w
|
-- raiseWindow dpy w
|
||||||
|
|
||||||
@@ -311,7 +308,7 @@ setFocusX w = withWindowSet $ \ws -> do
|
|||||||
-- layout the windows, then refresh.
|
-- layout the windows, then refresh.
|
||||||
sendMessage :: Message a => a -> X ()
|
sendMessage :: Message a => a -> X ()
|
||||||
sendMessage a = do
|
sendMessage a = do
|
||||||
w <- (W.workspace . W.current) `fmap` gets windowset
|
w <- W.workspace . W.current <$> gets windowset
|
||||||
ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
|
ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
|
||||||
whenJust ml' $ \l' -> do
|
whenJust ml' $ \l' -> do
|
||||||
windows $ \ws -> ws { W.current = (W.current ws)
|
windows $ \ws -> ws { W.current = (W.current ws)
|
||||||
@@ -339,7 +336,7 @@ runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X ()
|
|||||||
runOnWorkspaces job =do
|
runOnWorkspaces job =do
|
||||||
ws <- gets windowset
|
ws <- gets windowset
|
||||||
h <- mapM job $ W.hidden ws
|
h <- mapM job $ W.hidden ws
|
||||||
c:v <- mapM (\s -> fmap (\w -> s { W.workspace = w}) $ job (W.workspace s))
|
c:v <- mapM (\s -> (\w -> s { W.workspace = w}) <$> job (W.workspace s))
|
||||||
$ W.current ws : W.visible ws
|
$ W.current ws : W.visible ws
|
||||||
modify $ \s -> s { windowset = ws { W.current = c, W.visible = v, W.hidden = h } }
|
modify $ \s -> s { windowset = ws { W.current = c, W.visible = v, W.hidden = h } }
|
||||||
|
|
||||||
@@ -350,159 +347,6 @@ setLayout l = do
|
|||||||
handleMessage (W.layout ws) (SomeMessage ReleaseResources)
|
handleMessage (W.layout ws) (SomeMessage ReleaseResources)
|
||||||
windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = l } } }
|
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
|
-- Utilities
|
||||||
|
|
||||||
@@ -520,16 +364,20 @@ isClient w = withWindowSet $ return . W.member w
|
|||||||
|
|
||||||
-- | Combinations of extra modifier masks we need to grab keys\/buttons for.
|
-- | Combinations of extra modifier masks we need to grab keys\/buttons for.
|
||||||
-- (numlock and capslock)
|
-- (numlock and capslock)
|
||||||
extraModifiers :: [KeyMask]
|
extraModifiers :: X [KeyMask]
|
||||||
extraModifiers = [0, numlockMask, lockMask, numlockMask .|. lockMask ]
|
extraModifiers = do
|
||||||
|
nlm <- asks (numlockMask . config)
|
||||||
|
return [0, nlm, lockMask, nlm .|. lockMask ]
|
||||||
|
|
||||||
-- | Strip numlock\/capslock from a mask
|
-- | Strip numlock\/capslock from a mask
|
||||||
cleanMask :: KeyMask -> KeyMask
|
cleanMask :: KeyMask -> X KeyMask
|
||||||
cleanMask = (complement (numlockMask .|. lockMask) .&.)
|
cleanMask km = do
|
||||||
|
nlm <- asks (numlockMask . config)
|
||||||
|
return (complement (nlm .|. lockMask) .&. km)
|
||||||
|
|
||||||
-- | Get the Pixel value for a named color
|
-- | Get the Pixel value for a named color
|
||||||
initColor :: Display -> String -> IO Pixel
|
initColor :: Display -> String -> IO Pixel
|
||||||
initColor dpy c = (color_pixel . fst) `liftM` allocNamedColor dpy colormap c
|
initColor dpy c = (color_pixel . fst) <$> allocNamedColor dpy colormap c
|
||||||
where colormap = defaultColormap dpy (defaultScreen dpy)
|
where colormap = defaultColormap dpy (defaultScreen dpy)
|
||||||
|
|
||||||
------------------------------------------------------------------------
|
------------------------------------------------------------------------
|
||||||
@@ -541,11 +389,11 @@ floatLocation :: Window -> X (ScreenId, W.RationalRect)
|
|||||||
floatLocation w = withDisplay $ \d -> do
|
floatLocation w = withDisplay $ \d -> do
|
||||||
ws <- gets windowset
|
ws <- gets windowset
|
||||||
wa <- io $ getWindowAttributes d w
|
wa <- io $ getWindowAttributes d w
|
||||||
|
bw <- fi <$> asks (borderWidth . config)
|
||||||
|
|
||||||
-- XXX horrible
|
-- XXX horrible
|
||||||
let sc = fromMaybe (W.current ws) $ find (pointWithin (fi $ wa_x wa) (fi $ wa_y wa) . screenRect . W.screenDetail) $ W.screens ws
|
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
|
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))
|
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_y wa) - fi (rect_y sr)) % fi (rect_height sr))
|
||||||
(fi (wa_width wa + bw*2) % fi (rect_width sr))
|
(fi (wa_width wa + bw*2) % fi (rect_width sr))
|
||||||
@@ -564,7 +412,7 @@ float :: Window -> X ()
|
|||||||
float w = do
|
float w = do
|
||||||
(sc, rr) <- floatLocation w
|
(sc, rr) <- floatLocation w
|
||||||
windows $ \ws -> W.float w rr . fromMaybe ws $ do
|
windows $ \ws -> W.float w rr . fromMaybe ws $ do
|
||||||
i <- W.findIndex w ws
|
i <- W.findTag w ws
|
||||||
guard $ i `elem` map (W.tag . W.workspace) (W.screens ws)
|
guard $ i `elem` map (W.tag . W.workspace) (W.screens ws)
|
||||||
f <- W.peek ws
|
f <- W.peek ws
|
||||||
sw <- W.lookupWorkspace sc ws
|
sw <- W.lookupWorkspace sc ws
|
@@ -11,10 +11,20 @@
|
|||||||
-- Portability : portable, Haskell 98
|
-- Portability : portable, Haskell 98
|
||||||
--
|
--
|
||||||
|
|
||||||
module StackSet (
|
module XMonad.StackSet (
|
||||||
-- * Introduction
|
-- * Introduction
|
||||||
-- $intro
|
-- $intro
|
||||||
StackSet(..), Workspace(..), Screen(..), StackOrNot, Stack(..), RationalRect(..),
|
|
||||||
|
-- ** The Zipper
|
||||||
|
-- $zipper
|
||||||
|
|
||||||
|
-- ** Xinerama support
|
||||||
|
-- $xinerama
|
||||||
|
|
||||||
|
-- ** Master and Focus
|
||||||
|
-- $focus
|
||||||
|
|
||||||
|
StackSet(..), Workspace(..), Screen(..), Stack(..), RationalRect(..),
|
||||||
-- * Construction
|
-- * Construction
|
||||||
-- $construction
|
-- $construction
|
||||||
new, view, greedyView,
|
new, view, greedyView,
|
||||||
@@ -26,7 +36,7 @@ module StackSet (
|
|||||||
-- $stackOperations
|
-- $stackOperations
|
||||||
peek, index, integrate, integrate', differentiate,
|
peek, index, integrate, integrate', differentiate,
|
||||||
focusUp, focusDown, focusMaster, focusWindow,
|
focusUp, focusDown, focusMaster, focusWindow,
|
||||||
tagMember, renameTag, ensureTags, member, findIndex, mapWorkspace, mapLayout,
|
tagMember, renameTag, ensureTags, member, findTag, mapWorkspace, mapLayout,
|
||||||
-- * Modifying the stackset
|
-- * Modifying the stackset
|
||||||
-- $modifyStackset
|
-- $modifyStackset
|
||||||
insertUp, delete, delete', filter,
|
insertUp, delete, delete', filter,
|
||||||
@@ -42,7 +52,7 @@ module StackSet (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Prelude hiding (filter)
|
import Prelude hiding (filter)
|
||||||
import Data.Maybe (listToMaybe,fromJust)
|
import Data.Maybe (listToMaybe,fromJust,isJust)
|
||||||
import qualified Data.List as L (deleteBy,find,splitAt,filter,nub)
|
import qualified Data.List as L (deleteBy,find,splitAt,filter,nub)
|
||||||
import Data.List ( (\\) )
|
import Data.List ( (\\) )
|
||||||
import qualified Data.Map as M (Map,insert,delete,empty)
|
import qualified Data.Map as M (Map,insert,delete,empty)
|
||||||
@@ -65,8 +75,8 @@ import qualified Data.Map as M (Map,insert,delete,empty)
|
|||||||
-- Note that workspaces are indexed from 0, windows are numbered
|
-- Note that workspaces are indexed from 0, windows are numbered
|
||||||
-- uniquely. A '*' indicates the window on each workspace that has
|
-- uniquely. A '*' indicates the window on each workspace that has
|
||||||
-- focus, and which workspace is current.
|
-- focus, and which workspace is current.
|
||||||
--
|
|
||||||
-- Zipper
|
-- $zipper
|
||||||
--
|
--
|
||||||
-- We encode all the focus tracking directly in the data structure, with a 'zipper':
|
-- We encode all the focus tracking directly in the data structure, with a 'zipper':
|
||||||
--
|
--
|
||||||
@@ -94,21 +104,21 @@ import qualified Data.Map as M (Map,insert,delete,empty)
|
|||||||
-- Another good reference is:
|
-- Another good reference is:
|
||||||
--
|
--
|
||||||
-- The Zipper, Haskell wikibook
|
-- The Zipper, Haskell wikibook
|
||||||
--
|
|
||||||
-- Xinerama support:
|
-- $xinerama
|
||||||
--
|
|
||||||
-- Xinerama in X11 lets us view multiple virtual workspaces
|
-- Xinerama in X11 lets us view multiple virtual workspaces
|
||||||
-- simultaneously. While only one will ever be in focus (i.e. will
|
-- simultaneously. While only one will ever be in focus (i.e. will
|
||||||
-- receive keyboard events), other workspaces may be passively viewable.
|
-- receive keyboard events), other workspaces may be passively
|
||||||
-- We thus need to track which virtual workspaces are associated
|
-- viewable. We thus need to track which virtual workspaces are
|
||||||
-- (viewed) on which physical screens. We use a simple Map Workspace
|
-- associated (viewed) on which physical screens. To keep track of
|
||||||
-- Screen for this.
|
-- this, StackSet keeps separate lists of visible but non-focused
|
||||||
--
|
-- workspaces, and non-visible workspaces.
|
||||||
-- Master and Focus
|
|
||||||
|
-- $focus
|
||||||
--
|
--
|
||||||
-- Each stack tracks a focused item, and for tiling purposes also tracks
|
-- Each stack tracks a focused item, and for tiling purposes also tracks
|
||||||
-- a 'master' position. The connection between 'master' and 'focus'
|
-- a 'master' position. The connection between 'master' and 'focus'
|
||||||
-- needs to be well defined. Particular in relation to 'insert' and
|
-- needs to be well defined, particularly in relation to 'insert' and
|
||||||
-- 'delete'.
|
-- 'delete'.
|
||||||
--
|
--
|
||||||
|
|
||||||
@@ -124,13 +134,13 @@ import qualified Data.Map as M (Map,insert,delete,empty)
|
|||||||
--
|
--
|
||||||
-- * peek, -- was: peek\/peekStack
|
-- * peek, -- was: peek\/peekStack
|
||||||
--
|
--
|
||||||
-- * focusUp, focusDown, -- was: rotate
|
-- * focusUp, focusDown, -- was: rotate
|
||||||
--
|
--
|
||||||
-- * swapUp, swapDown
|
-- * swapUp, swapDown
|
||||||
--
|
--
|
||||||
-- * focus -- was: raiseFocus
|
-- * focus -- was: raiseFocus
|
||||||
--
|
--
|
||||||
-- * insertUp, -- was: insert\/push
|
-- * insertUp, -- was: insert\/push
|
||||||
--
|
--
|
||||||
-- * delete,
|
-- * delete,
|
||||||
--
|
--
|
||||||
@@ -156,8 +166,8 @@ import qualified Data.Map as M (Map,insert,delete,empty)
|
|||||||
data StackSet i l a sid sd =
|
data StackSet i l a sid sd =
|
||||||
StackSet { current :: !(Screen i l a sid sd) -- ^ currently focused workspace
|
StackSet { current :: !(Screen i l a sid sd) -- ^ currently focused workspace
|
||||||
, visible :: [Screen i l a sid sd] -- ^ non-focused workspaces, visible in xinerama
|
, visible :: [Screen i l a sid sd] -- ^ non-focused workspaces, visible in xinerama
|
||||||
, hidden :: [Workspace i l a] -- ^ workspaces not visible anywhere
|
, hidden :: [Workspace i l a] -- ^ workspaces not visible anywhere
|
||||||
, floating :: M.Map a RationalRect -- ^ floating windows
|
, floating :: M.Map a RationalRect -- ^ floating windows
|
||||||
} deriving (Show, Read, Eq)
|
} deriving (Show, Read, Eq)
|
||||||
|
|
||||||
-- | Visible workspaces, and their Xinerama screens.
|
-- | Visible workspaces, and their Xinerama screens.
|
||||||
@@ -169,7 +179,7 @@ data Screen i l a sid sd = Screen { workspace :: !(Workspace i l a)
|
|||||||
-- |
|
-- |
|
||||||
-- A workspace is just a tag - its index - and a stack
|
-- A workspace is just a tag - its index - and a stack
|
||||||
--
|
--
|
||||||
data Workspace i l a = Workspace { tag :: !i, layout :: l, stack :: StackOrNot a }
|
data Workspace i l a = Workspace { tag :: !i, layout :: l, stack :: Maybe (Stack a) }
|
||||||
deriving (Show, Read, Eq)
|
deriving (Show, Read, Eq)
|
||||||
|
|
||||||
-- | A structure for window geometries
|
-- | A structure for window geometries
|
||||||
@@ -194,8 +204,6 @@ data RationalRect = RationalRect Rational Rational Rational Rational
|
|||||||
-- structures, it is the differentiation of a [a], and integrating it
|
-- structures, it is the differentiation of a [a], and integrating it
|
||||||
-- back has a natural implementation used in 'index'.
|
-- 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
|
data Stack a = Stack { focus :: !a -- focused thing in this set
|
||||||
, up :: [a] -- clowns to the left
|
, up :: [a] -- clowns to the left
|
||||||
, down :: [a] } -- jokers to the right
|
, down :: [a] } -- jokers to the right
|
||||||
@@ -209,9 +217,11 @@ abort x = error $ "xmonad: StackSet: " ++ x
|
|||||||
-- ---------------------------------------------------------------------
|
-- ---------------------------------------------------------------------
|
||||||
-- $construction
|
-- $construction
|
||||||
|
|
||||||
-- | /O(n)/. Create a new stackset, of empty stacks, with given tags, with
|
-- | /O(n)/. Create a new stackset, of empty stacks, with given tags,
|
||||||
-- 'm' physical screens. 'm' should be less than or equal to the number of
|
-- with physical screens whose descriptions are given by 'm'. The
|
||||||
-- workspace tags. The first workspace in the list will be current.
|
-- 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.
|
-- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.
|
||||||
--
|
--
|
||||||
@@ -294,7 +304,7 @@ with dflt f = maybe dflt f . stack . workspace . current
|
|||||||
-- |
|
-- |
|
||||||
-- Apply a function, and a default value for Nothing, to modify the current stack.
|
-- 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 :: 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)
|
modify d f s = s { current = (current s)
|
||||||
{ workspace = (workspace (current s)) { stack = with d f s }}}
|
{ workspace = (workspace (current s)) { stack = with d f s }}}
|
||||||
|
|
||||||
@@ -320,13 +330,14 @@ integrate (Stack x l r) = reverse l ++ x : r
|
|||||||
|
|
||||||
-- |
|
-- |
|
||||||
-- /O(n)/ Flatten a possibly empty stack into a list.
|
-- /O(n)/ Flatten a possibly empty stack into a list.
|
||||||
integrate' :: StackOrNot a -> [a]
|
integrate' :: Maybe (Stack a) -> [a]
|
||||||
integrate' = maybe [] integrate
|
integrate' = maybe [] integrate
|
||||||
|
|
||||||
-- |
|
-- |
|
||||||
-- /O(n)/. Texture a list.
|
-- /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
|
||||||
differentiate :: [a] -> StackOrNot a
|
-- is down.
|
||||||
|
differentiate :: [a] -> Maybe (Stack a)
|
||||||
differentiate [] = Nothing
|
differentiate [] = Nothing
|
||||||
differentiate (x:xs) = Just $ Stack x [] xs
|
differentiate (x:xs) = Just $ Stack x [] xs
|
||||||
|
|
||||||
@@ -334,7 +345,7 @@ differentiate (x:xs) = Just $ Stack x [] xs
|
|||||||
-- /O(n)/. 'filter p s' returns the elements of 's' such that 'p' evaluates to
|
-- /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'.
|
-- True. Order is preserved, and focus moves as described for 'delete'.
|
||||||
--
|
--
|
||||||
filter :: (a -> Bool) -> Stack a -> StackOrNot a
|
filter :: (a -> Bool) -> Stack a -> Maybe (Stack a)
|
||||||
filter p (Stack f ls rs) = case L.filter p (f:rs) of
|
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
|
f':rs' -> Just $ Stack f' (L.filter p ls) rs' -- maybe move focus down
|
||||||
[] -> case L.filter p ls of -- filter back up
|
[] -> case L.filter p ls of -- filter back up
|
||||||
@@ -350,8 +361,6 @@ filter p (Stack f ls rs) = case L.filter p (f:rs) of
|
|||||||
index :: StackSet i l a s sd -> [a]
|
index :: StackSet i l a s sd -> [a]
|
||||||
index = with [] integrate
|
index = with [] integrate
|
||||||
|
|
||||||
-- let is = t : r ++ reverse l in take (length is) (dropWhile (/= m) (cycle is))
|
|
||||||
|
|
||||||
-- |
|
-- |
|
||||||
-- /O(1), O(w) on the wrapping case/.
|
-- /O(1), O(w) on the wrapping case/.
|
||||||
--
|
--
|
||||||
@@ -389,7 +398,7 @@ reverseStack (Stack t ls rs) = Stack t rs ls
|
|||||||
focusWindow :: (Eq s, Eq a, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd
|
focusWindow :: (Eq s, Eq a, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd
|
||||||
focusWindow w s | Just w == peek s = s
|
focusWindow w s | Just w == peek s = s
|
||||||
| otherwise = maybe s id $ do
|
| otherwise = maybe s id $ do
|
||||||
n <- findIndex w s
|
n <- findTag w s
|
||||||
return $ until ((Just w ==) . peek) focusUp (view n s)
|
return $ until ((Just w ==) . peek) focusUp (view n s)
|
||||||
|
|
||||||
-- | Get a list of all screens in the StackSet.
|
-- | Get a list of all screens in the StackSet.
|
||||||
@@ -413,7 +422,9 @@ renameTag :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd
|
|||||||
renameTag o n = mapWorkspace rename
|
renameTag o n = mapWorkspace rename
|
||||||
where rename w = if tag w == o then w { tag = n } else w
|
where rename w = if tag w == o then w { tag = n } else w
|
||||||
|
|
||||||
-- | Ensure that a given set of tags is present.
|
-- | 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 :: 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
|
ensureTags l allt st = et allt (map tag (workspaces st) \\ allt) st
|
||||||
where et [] _ s = s
|
where et [] _ s = s
|
||||||
@@ -437,13 +448,13 @@ mapLayout f (StackSet v vs hs m) = StackSet (fScreen v) (map fScreen vs) (map fW
|
|||||||
|
|
||||||
-- | /O(n)/. Is a window in the StackSet.
|
-- | /O(n)/. Is a window in the StackSet.
|
||||||
member :: Eq a => a -> StackSet i l a s sd -> Bool
|
member :: Eq a => a -> StackSet i l a s sd -> Bool
|
||||||
member a s = maybe False (const True) (findIndex a s)
|
member a s = isJust (findTag a s)
|
||||||
|
|
||||||
-- | /O(1) on current window, O(n) in general/.
|
-- | /O(1) on current window, O(n) in general/.
|
||||||
-- Return Just the workspace index of the given window, or Nothing
|
-- Return Just the workspace tag of the given window, or Nothing
|
||||||
-- if the window is not in the StackSet.
|
-- if the window is not in the StackSet.
|
||||||
findIndex :: Eq a => a -> StackSet i l a s sd -> Maybe i
|
findTag :: Eq a => a -> StackSet i l a s sd -> Maybe i
|
||||||
findIndex a s = listToMaybe
|
findTag a s = listToMaybe
|
||||||
[ tag w | w <- workspaces s, has a (stack w) ]
|
[ tag w | w <- workspaces s, has a (stack w) ]
|
||||||
where has _ Nothing = False
|
where has _ Nothing = False
|
||||||
has x (Just (Stack t l r)) = x `elem` (t : l ++ r)
|
has x (Just (Stack t l r)) = x `elem` (t : l ++ r)
|
||||||
@@ -452,12 +463,10 @@ findIndex a s = listToMaybe
|
|||||||
-- $modifyStackset
|
-- $modifyStackset
|
||||||
|
|
||||||
-- |
|
-- |
|
||||||
-- /O(n)/. (Complexity due to duplicate check). Insert a new element into
|
-- /O(n)/. (Complexity due to duplicate check). Insert a new element
|
||||||
-- the stack, above the currently focused element.
|
-- into the stack, above the currently focused element. The new
|
||||||
--
|
-- element is given focus; the previously focused element is moved
|
||||||
-- The new element is given focus, and is set as the master window.
|
-- down.
|
||||||
-- 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
|
-- If the element is already in the stackset, the original stackset is
|
||||||
-- returned unmodified.
|
-- returned unmodified.
|
||||||
@@ -557,7 +566,7 @@ shiftWin :: (Ord a, Eq a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackS
|
|||||||
shiftWin n w s | from == Nothing = s -- not found
|
shiftWin n w s | from == Nothing = s -- not found
|
||||||
| n `tagMember` s && (Just n) /= from = go
|
| n `tagMember` s && (Just n) /= from = go
|
||||||
| otherwise = s
|
| otherwise = s
|
||||||
where from = findIndex w s
|
where from = findTag w s
|
||||||
|
|
||||||
go = on n (insertUp w) . on (fromJust from) (delete' w) $ s
|
go = on n (insertUp w) . on (fromJust from) (delete' w) $ s
|
||||||
curtag = tag (workspace (current s))
|
curtag = tag (workspace (current s))
|
276
man/xmonad.hs
Normal file
276
man/xmonad.hs
Normal file
@@ -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
|
||||||
|
}
|
@@ -1,9 +1,8 @@
|
|||||||
{-# OPTIONS -fglasgow-exts #-}
|
{-# OPTIONS -fglasgow-exts #-}
|
||||||
module Properties where
|
module Properties where
|
||||||
|
|
||||||
import StackSet hiding (filter)
|
import XMonad.StackSet hiding (filter)
|
||||||
import qualified StackSet as S (filter)
|
import qualified XMonad.StackSet as S (filter)
|
||||||
import Operations (tile)
|
|
||||||
|
|
||||||
import Debug.Trace
|
import Debug.Trace
|
||||||
import Data.Word
|
import Data.Word
|
||||||
@@ -351,14 +350,14 @@ prop_focusWindow_local (n :: NonNegative Int) (x::T ) =
|
|||||||
in hidden_spaces (focusWindow (s !! i) x) == hidden_spaces x
|
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
|
-- correct workspace
|
||||||
--
|
--
|
||||||
prop_findIndex (x :: T) =
|
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
|
| w <- workspace (current x) : map workspace (visible x) ++ hidden x
|
||||||
, t <- maybeToList (stack w)
|
, t <- maybeToList (stack w)
|
||||||
, i <- focus t : up t ++ down t
|
, i <- focus t : up t ++ down t
|
||||||
@@ -529,7 +528,7 @@ prop_shift_win_indentity i w (x :: T) =
|
|||||||
-- shiftWin leaves the current screen as it is, if neither i is the tag
|
-- shiftWin leaves the current screen as it is, if neither i is the tag
|
||||||
-- of the current workspace nor w on the current workspace
|
-- of the current workspace nor w on the current workspace
|
||||||
prop_shift_win_fix_current i w (x :: T) =
|
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)
|
==> (current $ x) == (current $ shiftWin i w x)
|
||||||
where
|
where
|
||||||
n = tag (workspace $ current x)
|
n = tag (workspace $ current x)
|
||||||
@@ -707,7 +706,7 @@ main = do
|
|||||||
,("focusWindow is local", mytest prop_focusWindow_local)
|
,("focusWindow is local", mytest prop_focusWindow_local)
|
||||||
,("focusWindow works" , mytest prop_focusWindow_works)
|
,("focusWindow works" , mytest prop_focusWindow_works)
|
||||||
|
|
||||||
,("findIndex" , mytest prop_findIndex)
|
,("findTag" , mytest prop_findIndex)
|
||||||
,("allWindows/member" , mytest prop_allWindowsMember)
|
,("allWindows/member" , mytest prop_allWindowsMember)
|
||||||
|
|
||||||
,("insert: invariant" , mytest prop_insertUp_I)
|
,("insert: invariant" , mytest prop_insertUp_I)
|
||||||
|
@@ -42,6 +42,6 @@ replace :: Eq a => a -> a -> [a] -> [a]
|
|||||||
replace x y = map (\a -> if a == x then y else a)
|
replace x y = map (\a -> if a == x then y else a)
|
||||||
|
|
||||||
main = do
|
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
|
let sed = unlines . replace "___KEYBINDINGS___" troffBindings . lines
|
||||||
readFile "./man/xmonad.1.in" >>= return . sed >>= writeFile "./man/xmonad.1"
|
readFile "./man/xmonad.1.in" >>= return . sed >>= writeFile "./man/xmonad.1"
|
||||||
|
51
xmonad.cabal
51
xmonad.cabal
@@ -1,7 +1,7 @@
|
|||||||
name: xmonad
|
name: xmonad
|
||||||
version: 0.4
|
version: 0.5
|
||||||
homepage: http://xmonad.org
|
homepage: http://xmonad.org
|
||||||
synopsis: A lightweight X11 window manager.
|
synopsis: A tiling window manager
|
||||||
description:
|
description:
|
||||||
xmonad is a tiling window manager for X. Windows are arranged
|
xmonad is a tiling window manager for X. Windows are arranged
|
||||||
automatically to tile the screen without gaps or overlap, maximising
|
automatically to tile the screen without gaps or overlap, maximising
|
||||||
@@ -16,15 +16,40 @@ category: System
|
|||||||
license: BSD3
|
license: BSD3
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
author: Spencer Janssen
|
author: Spencer Janssen
|
||||||
maintainer: sjanssen@cse.unl.edu
|
maintainer: xmonad@haskell.org
|
||||||
build-depends: base>=2.0, X11>=1.2.1, X11-extras>=0.4, mtl>=1.0, unix>=1.0
|
extra-source-files: README TODO CONFIG STYLE tests/loc.hs tests/Properties.hs
|
||||||
extra-source-files: README TODO tests/loc.hs tests/Properties.hs man/xmonad.1.in
|
man/xmonad.1.in man/xmonad.1 man/xmonad.html man/xmonad.hs
|
||||||
Config.hs-boot util/GenerateManpage.hs man/xmonad.1 man/xmonad.html
|
util/GenerateManpage.hs
|
||||||
|
cabal-version: >= 1.2
|
||||||
|
|
||||||
executable: xmonad
|
flag small_base
|
||||||
main-is: Main.hs
|
description: Choose the new smaller, split-up base package.
|
||||||
other-modules: Config Operations StackSet XMonad
|
|
||||||
ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s
|
library
|
||||||
ghc-prof-options: -prof -auto-all
|
exposed-modules: XMonad
|
||||||
extensions: GeneralizedNewtypeDeriving
|
XMonad.Main
|
||||||
-- Also requires deriving Typeable, PatternGuards
|
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
|
||||||
|
Reference in New Issue
Block a user