91 Commits
v0.7 ... v0.9

Author SHA1 Message Date
Spencer Janssen
0eb84e4866 Bump version to 0.9 2009-10-26 00:45:43 +00:00
Adam Vogt
b4bf8de874 Grab the xmonad.cabal version for putting into the manpage 2009-10-24 20:09:20 +00:00
Adam Vogt
17c89e327e Correct formatting in manpage 2009-10-24 20:07:48 +00:00
Don Stewart
da71b6c8ac depend on X11 >= 1.4.6.1, for conformity with XMC 2009-10-24 21:24:09 +00:00
Khudyakov Alexey
2621f3f6a8 Fix for Tall documentation 2009-05-16 10:47:53 +00:00
Daniel Wagner
8ec0bf3290 correct a comment 2009-07-27 03:20:24 +00:00
Spencer Janssen
7e20d0d308 man/xmonad.hs is in data-files, remove it from extra-source-files 2009-10-23 03:14:57 +00:00
Adam Vogt
24d8de93d7 Add the template config as distributed file. 2009-10-22 04:14:02 +00:00
Adam Vogt
2dd6eeba7d Note in manpage that 'exec xmonad' should be used 2009-09-01 04:05:38 +00:00
Adam Vogt
72997cf982 Manual page spelling: maximise -> maximize, utilising -> utilizing 2009-09-01 04:02:17 +00:00
Adam Vogt
7365d7bc11 Describe modular configuration in the manual page 2009-09-01 04:00:46 +00:00
Spencer Janssen
36e20f689c Remove redundant parens 2009-09-18 03:55:47 +00:00
wirtwolff
cde261ed56 man_xmonad.hs: import Data.Monoid for mempty, keybinding edits
Bring mempty into scope. Add commented ToggleStruts binding.
Replace shadowed modMask in keybindings with modm instead.
2009-03-20 02:46:24 +00:00
Adam Vogt
8d8cc8bcd8 Only watch mtime for .hs, .lhs, .hsc for ~/.xmonad/lib
Previously xmonad would force a recompile due to the object files being too
new, so only look at files which may contain haskell code.
2009-05-03 23:54:15 +00:00
Adam Vogt
ccb6ff92f2 Add lib to ghc searchpath with recompilation check 2009-03-21 23:29:07 +00:00
Adam Vogt
e944a6c8d3 Remove tabs from ManageHook.hs 2009-07-10 01:14:24 +00:00
Adam Vogt
eb1e29c8bb Set infix 0 --> to reduce parentheses in ManageHooks
What was previously:
> (appName ?= x <&&> classname ?= y) --> (doFloat <+> doIgnore)

Can now be:
> appName ?= x <&&> classname ?= y --> doFloat <+> doIgnore
2009-07-10 01:13:08 +00:00
Adam Vogt
66e7715ea6 Pester the user with one (not two) xmessages on config errors 2009-03-21 23:37:36 +00:00
Wouter Swierstra
d9d3e40112 Minor bugfix in the creation of new StackSets. 2009-05-03 15:43:21 +00:00
Spencer Janssen
7385793c65 Avoid deadly cycle in man/xmonad.hs 2009-03-19 08:19:18 +00:00
wirtwolff
72885e7e24 X.Config.hs, ./man/xmonad.hs: update Event Hook doc 2009-02-09 18:38:37 +00:00
Spencer Janssen
a931776e54 Use records to document Tall's arguments 2009-02-21 23:06:28 +00:00
Joachim Breitner
61568318d6 Fix possible head []
This seems to be a rare case, but I just got hit by it.
2009-01-06 19:20:26 +00:00
Spencer Janssen
3caa989e20 ManageHook.doShift: use shiftWin instead of shift 2009-02-19 04:14:58 +00:00
Spencer Janssen
09fd11d13b Express shift in terms of shiftWin 2009-02-17 23:53:43 +00:00
Don Stewart
f33681de49 Use standard -fforce-recomp instead of undocumented -no-recomp 2009-02-08 16:55:18 +00:00
Daniel Schoepe
bf8bfc66a5 Support for custom event hooks 2009-02-03 15:55:36 +00:00
Daniel Schoepe
4075e2d9d3 Make X an instance of Typeable 2009-01-28 21:54:06 +00:00
Spencer Janssen
78856e1a6f Add uninstallSignalHandlers, use in spawn 2009-01-22 00:26:43 +00:00
Spencer Janssen
4222dd9ad3 Create a new session for forked processes 2009-01-22 00:04:23 +00:00
Spencer Janssen
34a547ce57 TAG 0.8.1 2009-01-18 08:39:10 +00:00
Spencer Janssen
353e7cd681 Close stdin in spawned processes 2009-01-17 04:00:24 +00:00
Spencer Janssen
72dece0769 Document spawnPID 2009-01-17 03:59:07 +00:00
Spencer Janssen
6e1c5e9b49 Asynchronously recompile/restart xmonad on mod-q 2009-01-17 03:53:00 +00:00
Spencer Janssen
bf8ba79090 Add --restart, a command line flag to cause a running xmonad process to restart 2009-01-17 03:49:59 +00:00
Spencer Janssen
5edfb1d262 Bump version to 0.8.1 2009-01-16 22:36:21 +00:00
Spencer Janssen
0fecae0abc Remove doubleFork, handle SIGCHLD
This is a rather big change.  Rather than make spawned processes become
children of init, we handle them in xmonad.  As a side effect of this change,
we never need to use waitForProcess in any contrib module -- in fact, doing so
will raise an exception.  The main benefit to handling SIGCHLD is that xmonad
can now be started with 'exec', and will correctly clean up after inherited
child processes.
2009-01-16 20:47:42 +00:00
gwern0
26f4f734f9 Main.hs: escape / in Haddocks
This lets haddocks for Main.hs, at least, to build with 2.3.0.
2008-12-07 02:09:15 +00:00
Daniel Schoepe
5e7df396b9 More flexible userCode function 2009-01-10 22:18:52 +00:00
Spencer Janssen
314ba78335 Call logHook as the very last action in windows 2008-12-09 23:37:00 +00:00
Spencer Janssen
7aa78ecc75 Accept inferior crossing events. This patch enables fmouse-focus-follows-screen 2008-12-05 04:51:30 +00:00
Spencer Janssen
ba8e26458e Tile all windows at once 2008-11-18 07:44:47 +00:00
Spencer Janssen
c627e8cc4d Factor rational rect scaling into a separate function 2008-11-18 07:28:49 +00:00
Spencer Janssen
04f894275d Change screen focus by clicking on the root window.
This is a modification of a patch from Joachim Breitner.
2008-11-06 22:40:31 +00:00
Spencer Janssen
edb752136f Fix #192. 2008-10-21 22:00:59 +00:00
Adam Vogt
2b463a632f select base < 4 for building on ghc 6.10 2008-10-13 21:45:09 +00:00
Joachim Breitner
ca122dd2cb add killWindow function
This is required to kill anything that is not focused, without
having to focus it first.
2008-10-05 00:18:04 +00:00
Devin Mullins
77657b65f9 add'l documentation 2008-09-27 23:46:39 +00:00
Spencer Janssen
28c57a837a Regression: ungrab buttons on *non* root windows 2008-10-07 21:43:51 +00:00
Spencer Janssen
afda20b56d Partial fix for #40
Improvements:
 - clicking on the root will change focus to that screen
 - moving the mouse from a window on a screen to an empty screen changes focus
   to that screen
The only remaining issue is that moving the mouse between two empty screens
does not change focus.  In order to solve this, we'd have to select motion events
on the root window, which is potentially expensive.
2008-10-07 21:20:53 +00:00
Spencer Janssen
0cc7b12fd0 Track mouse position via events received 2008-10-07 20:39:53 +00:00
Spencer Janssen
15a78ae715 Fix haddock 2008-10-07 09:46:41 +00:00
Spencer Janssen
18444799e0 Move screen locating code into pointScreen 2008-10-07 09:42:07 +00:00
Spencer Janssen
cc60fa73ad Make pointWithin a top-level binding 2008-10-07 09:02:29 +00:00
gwern0
8881e2ac78 sp README, CONFIG, STYLE, TODO 2008-09-13 02:44:57 +00:00
Spencer Janssen
533031e3d6 Use the same X11 dependency as xmonad-contrib 2008-09-21 06:15:08 +00:00
Spencer Janssen
76d4af15e4 Export focusUp' and focusDown' -- work entirely on stacks 2008-09-11 21:48:03 +00:00
Devin Mullins
74c6dd2721 add W.shiftMaster, fix float/tile-reordering bug 2008-09-11 05:39:09 +00:00
Spencer Janssen
b605fd9fce Spelling. Any bets on how long this has been there? 2008-09-05 19:52:11 +00:00
Spencer Janssen
85202ebd47 Bump version to 0.8 2008-09-05 19:42:25 +00:00
Spencer Janssen
328c660ce7 Remove obsolete comments about darcs X11 2008-09-05 19:49:15 +00:00
Spencer Janssen
b185a439b1 Recommend latest packages rather than specific versions 2008-09-05 19:48:37 +00:00
Spencer Janssen
0016e06984 Also remove -optl from the executable section 2008-08-20 21:00:23 +00:00
Spencer Janssen
339b2d0097 -optl-Wl,-s is not needed with recent Cabal versions 2008-08-20 20:41:02 +00:00
Malebria
5f4d63ba71 Haddock links 2008-06-01 21:25:15 +00:00
Malebria
942572c830 Haddock syntax for enumeration 2008-06-01 20:49:51 +00:00
Spencer Janssen
46ac2ca24b I prefer the spencerjanssen@gmail.com address now 2008-07-14 20:26:50 +00:00
Trevor Elliott
3830d7a571 Raise windows in the floating layer when moving or resizing 2008-05-21 21:50:57 +00:00
Devin Mullins
5b3eaf663a add currentTag convenience function 2008-05-11 22:42:58 +00:00
Spencer Janssen
c93b7c7c3b Make Mirror a newtype 2008-05-08 10:46:40 +00:00
Spencer Janssen
42dee4768e Comments 2008-05-07 01:31:22 +00:00
Spencer Janssen
e847b350ed Break long line 2008-05-07 01:26:08 +00:00
Spencer Janssen
cccbfa21e4 Style 2008-05-07 01:25:19 +00:00
Spencer Janssen
870b3ad282 Simplify 2008-05-07 01:13:09 +00:00
Spencer Janssen
ab30d76578 Overhaul Choose, fixes issue 183 2008-05-06 22:08:09 +00:00
Klaus Weidner
d8d636e573 Remember if focus changes were caused by mouse actions or by key commands
If the user used the mouse to change window focus (moving into or clicking on a
window), this should be handled differently than focus changes due to keyboard
commands. Specifically, it's inappropriate to discard window enter/leave events
while the mouse is moving. This fixes the bug where a fast mouse motion across
multiple windows resulted in the wrong window keeping focus.

It's also helpful information for contrib modules such as UpdatePointer - it's
supposed to move the mouse pointer only in response to keyboard actions, not if
the user was moving the mouse.
2008-05-02 17:56:03 +00:00
Spencer Janssen
ba3987f299 Wibble 2008-05-06 20:38:40 +00:00
Ivan N. Veselov
5a19425e79 Added doShift function for more user-friendly hooks 2008-05-06 18:57:57 +00:00
Don Stewart
28431e18c8 use named colours. fixes startup failure on the XO 2008-05-02 21:01:49 +00:00
Spencer Janssen
43c2d26cdb Set focus *after* revealing windows 2008-04-07 22:25:59 +00:00
Spencer Janssen
c24016882e Reveal windows after moving/resizing them.
This should reduce the number of repaints for newly visible windows.
2008-04-07 22:07:56 +00:00
Spencer Janssen
9dae87c537 Hide newly created but non-visible windows (fixes bug #172) 2008-04-30 01:40:12 +00:00
Don Stewart
b67026dd02 formatting, eta expansion 2008-04-18 18:43:37 +00:00
Lukas Mai
aa58eea6dc XMonad.ManageHook: add 'appName', another name for 'resource' 2008-04-06 01:20:06 +00:00
Lukas Mai
7db13a2a45 XMonad.ManageHook: make 'title' locale-aware; haddock cleanup
The code for 'title' was stolen from getname.patch (bug #44).
2008-04-06 01:13:38 +00:00
Lukas Mai
029e668dbc XMonad.Main: call setlocale on startup 2008-04-06 01:12:34 +00:00
robreim
6f61c83623 floats always use current screen (with less bugs) 2008-04-05 13:50:09 +00:00
Lukas Mai
bcbccbfafc XMonad.Operations: applySizeHint reshuffle
Make applySizeHints take window borders into account. Move old functionality
to applySizeHintsContents. Add new mkAdjust function that generates a custom
autohinter for a window.
2008-04-04 21:56:15 +00:00
Lukas Mai
04c8d62361 XMonad.Layout: documentation cleanup 2008-04-04 21:54:44 +00:00
Spencer Janssen
4890116e49 Remove gaps from the example config 2008-03-29 23:29:59 +00:00
Spencer Janssen
708084dd48 Remove gaps 2008-03-25 09:15:26 +00:00
17 changed files with 625 additions and 379 deletions

4
CONFIG
View File

@@ -51,9 +51,9 @@ Ok, looks good.
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.
are used.
To load succesfully, both 'xmonad' and 'ghc' must be in your $PATH
To load successfully, 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:

30
Main.hs
View File

@@ -16,10 +16,12 @@ module Main (main) where
import XMonad
import Control.Monad (unless)
import System.IO
import System.Info
import System.Environment
import System.Posix.Process (executeFile)
import System.Exit (exitFailure)
import Paths_xmonad (version)
import Data.Version (showVersion)
@@ -32,13 +34,15 @@ import qualified Properties
-- for xmonad, and if it doesn't find one, just launches the default.
main :: IO ()
main = do
installSignalHandlers -- important to ignore SIGCHLD to avoid zombies
args <- getArgs
let launch = catchIO buildLaunch >> xmonad defaultConfig
case args of
[] -> launch
["--resume", _] -> launch
["--help"] -> usage
["--recompile"] -> recompile True >> return ()
["--recompile"] -> recompile True >>= flip unless exitFailure
["--restart"] -> sendRestart >> return ()
["--version"] -> putStrLn ("xmonad " ++ showVersion version)
#ifdef TESTING
("--run-tests":_) -> Properties.main
@@ -54,20 +58,27 @@ usage = do
" --help Print this message" :
" --version Print the version number" :
" --recompile Recompile your ~/.xmonad/xmonad.hs" :
" --restart Request a running xmonad process to restart" :
#ifdef TESTING
" --run-tests Run the test suite" :
#endif
[]
-- | Build "~/.xmonad/xmonad.hs" with ghc, then execute it. If there are no
-- | Build "~\/.xmonad\/xmonad.hs" with ghc, then execute it. If there are no
-- errors, this function does not return. An exception is raised in any of
-- these cases:
--
-- * ghc missing
-- * ~/.xmonad/xmonad.hs missing
--
-- * both "~\/.xmonad\/xmonad.hs" and "~\/.xmonad\/xmonad-$arch-$os" 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
--
-- * Missing XMonad\/XMonadContrib modules due to ghc upgrade
--
buildLaunch :: IO ()
buildLaunch = do
@@ -76,3 +87,14 @@ buildLaunch = do
args <- getArgs
executeFile (dir ++ "/xmonad-"++arch++"-"++os) False args Nothing
return ()
sendRestart :: IO ()
sendRestart = do
dpy <- openDisplay ""
rw <- rootWindow dpy $ defaultScreen dpy
xmonad_restart <- internAtom dpy "XMONAD_RESTART" False
allocaXEvent $ \e -> do
setEventType e clientMessage
setClientMessageEvent e rw xmonad_restart 32 0 currentTime
sendEvent dpy rw False structureNotifyMask e
sync dpy False

37
README
View File

@@ -24,18 +24,18 @@ For the full story, read on.
Building:
Building is quite straightforward, and requries a basic Haskell toolchain.
Building is quite straightforward, and requires 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
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.
We'll now walk through the complete list of toolchain dependencies.
* 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
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:
@@ -46,7 +46,7 @@ Building:
apt-get install ghc6
It shouldn't be necessary to compile GHC from source -- every common
It shouldn't be necessary to compile GHC from source -- every common
system has a pre-build binary version.
* X11 libraries:
@@ -60,7 +60,7 @@ Building:
Typically you need: libXinerama libXext libX11
* Cabal
xmonad requires a recent version of Cabal, >= 1.2.0. If you're using
GHC 6.8, then it comes bundled with the right version. If you're
using GHC 6.6.x, you'll need to build and install Cabal from hackage
@@ -80,11 +80,11 @@ Building:
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.4.1
mtl http://hackage.haskell.org/cgi-bin/hackage-scripts/package/mtl
unix http://hackage.haskell.org/cgi-bin/hackage-scripts/package/unix
X11 http://hackage.haskell.org/cgi-bin/hackage-scripts/package/X11
* Build xmonad:
* Build xmonad:
Once you've got all the dependencies in place (which should be
straightforward), build xmonad:
@@ -97,19 +97,6 @@ Building:
------------------------------------------------------------------------
Notes for using the darcs version
If you're building the darcs version of xmonad, be sure to also
use the darcs version of the X11 library, which is developed
concurrently with xmonad.
darcs get http://darcs.haskell.org/X11
Not using X11 from darcs is the most common reason for the
darcs version of xmonad to fail to build.
------------------------------------------------------------------------
Running xmonad:
Add:
@@ -141,14 +128,14 @@ XMonadContrib
Other useful programs:
A nicer xterm replacment, that supports resizing better:
A nicer xterm replacement, that supports resizing better:
urxvt http://software.schmorp.de/pkg/rxvt-unicode.html
For custom status bars:
dzen http://gotmor.googlepages.com/dzen
xmobar http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmobar
xmobar http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmobar
For a program dispatch menu:

4
STYLE
View File

@@ -2,7 +2,7 @@
== Coding guidelines for contributing to
== xmonad and the xmonad contributed extensions
* Comment every top level function (particularly exported funtions), and
* Comment every top level function (particularly exported functions), and
provide a type signature; use Haddock syntax in the comments.
* Follow the coding style of the other modules.
@@ -15,7 +15,7 @@
* Tabs are illegal. Use 4 spaces for indenting.
* Any pure function added to the core should have QuickCheck properties
precisely defining its behaviour.
precisely defining its behavior.
* New modules should identify the author, and be submitted under
the same license as xmonad (BSD3 license or freer).

4
TODO
View File

@@ -1,7 +1,7 @@
- Write down invariants for the window life cycle, especially:
- When are borders set? Prove that the current handling is sufficient.
- current floating layer handling is unoptimal. FocusUp should raise,
- current floating layer handling is nonoptimal. FocusUp should raise,
for example
- Issues still with stacking order.
@@ -15,7 +15,7 @@
* double check README build instructions
* test core with 6.6 and 6.8
* bump xmonad.cabal version and X11 version
* upload X11 and xmonad to hackage
* 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
* confirm template config is type correct

View File

@@ -26,21 +26,23 @@ module XMonad.Config (defaultConfig) where
--
import XMonad.Core as XMonad hiding
(workspaces,manageHook,numlockMask,keys,logHook,startupHook,borderWidth,mouseBindings
,defaultGaps,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor
,focusFollowsMouse)
,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse
,handleEventHook)
import qualified XMonad.Core as XMonad
(workspaces,manageHook,numlockMask,keys,logHook,startupHook,borderWidth,mouseBindings
,defaultGaps,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor
,focusFollowsMouse)
,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse
,handleEventHook)
import XMonad.Layout
import XMonad.Operations
import XMonad.ManageHook
import qualified XMonad.StackSet as W
import Data.Bits ((.|.))
import Data.Monoid
import qualified Data.Map as M
import System.Exit
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
-- | The default number of workspaces (virtual screens) and their names.
-- By default we use numeric strings, but any string may be used as a
@@ -86,23 +88,8 @@ borderWidth = 1
-- | Border colors for unfocused and focused windows, respectively.
--
normalBorderColor, focusedBorderColor :: String
normalBorderColor = "#dddddd"
focusedBorderColor = "#ff0000"
-- | Default offset of drawable screen boundaries from each physical
-- screen. Anything non-zero here will leave a gap of that many pixels
-- on the given edge, on the that screen. A useful gap at top of screen
-- for a menu bar (e.g. 15)
--
-- An example, to set a top gap on monitor 1, and a gap on the bottom of
-- monitor 2, you'd use a list of geometries like so:
--
-- > defaultGaps = [(18,0,0,0),(0,18,0,0)] -- 2 gaps on 2 monitors
--
-- Fields are: top, bottom, left, right.
--
defaultGaps :: [(Int,Int,Int,Int)]
defaultGaps = [(0,0,0,0)] -- 15 for default dzen font
normalBorderColor = "gray" -- "#dddddd"
focusedBorderColor = "red" -- "#ff0000" don't use hex, not <24 bit safe
------------------------------------------------------------------------
-- Window rules
@@ -126,7 +113,9 @@ manageHook = composeAll
-- | Perform an arbitrary action on each internal state change or X event.
-- Examples include:
--
-- * do nothing
--
-- * log the state to stdout
--
-- See the 'DynamicLog' extension for examples.
@@ -134,6 +123,15 @@ manageHook = composeAll
logHook :: X ()
logHook = return ()
------------------------------------------------------------------------
-- Event handling
-- | Defines a custom handler function for X Events. The function should
-- return (All True) if the default handler is to be run afterwards.
-- To combine event hooks, use mappend or mconcat from Data.Monoid.
handleEventHook :: Event -> X All
handleEventHook _ = return (All True)
-- | Perform an arbitrary action at xmonad startup.
startupHook :: X ()
startupHook = return ()
@@ -216,11 +214,11 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
, ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
-- toggle the status bar gap
, ((modMask , xK_b ), modifyGap (\i n -> let x = (XMonad.defaultGaps conf ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap
--, ((modMask , xK_b ), modifyGap (\i n -> let x = (XMonad.defaultGaps conf ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap
-- quit, or restart
, ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit xmonad
, ((modMask , xK_q ), restart "xmonad" True) -- %! Restart xmonad
, ((modMask , xK_q ), spawn "xmonad --recompile && xmonad --restart") -- %! Restart xmonad
]
++
-- mod-[1..9] %! Switch to workspace N
@@ -240,11 +238,13 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
mouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList $
-- mod-button1 %! Set the window to floating mode and move by dragging
[ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w))
[ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w
>> windows W.shiftMaster))
-- mod-button2 %! Raise the window to the top of the stack
, ((modMask, button2), (\w -> focus w >> windows W.swapMaster))
, ((modMask, button2), (\w -> focus w >> windows W.shiftMaster))
-- 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
>> windows W.shiftMaster))
-- you may also bind events to the mouse scroll wheel (button4 and button5)
]
@@ -252,7 +252,6 @@ mouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList $
defaultConfig = XConfig
{ XMonad.borderWidth = borderWidth
, XMonad.workspaces = workspaces
, XMonad.defaultGaps = defaultGaps
, XMonad.layoutHook = layout
, XMonad.terminal = terminal
, XMonad.normalBorderColor = normalBorderColor
@@ -264,4 +263,5 @@ defaultConfig = XConfig
, XMonad.startupHook = startupHook
, XMonad.mouseBindings = mouseBindings
, XMonad.manageHook = manageHook
, XMonad.handleEventHook = handleEventHook
, XMonad.focusFollowsMouse = focusFollowsMouse }

View File

@@ -9,11 +9,11 @@
-- Copyright : (c) Spencer Janssen 2007
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : sjanssen@cse.unl.edu
-- Maintainer : spencerjanssen@gmail.com
-- Stability : unstable
-- Portability : not portable, uses cunning newtype deriving
--
-- The X monad, a state monad transformer over IO, for the window
-- The 'X' monad, a state monad transformer over 'IO', for the window
-- manager state, and support routines.
--
-----------------------------------------------------------------------------
@@ -24,29 +24,36 @@ module XMonad.Core (
XConf(..), XConfig(..), LayoutClass(..),
Layout(..), readsLayout, Typeable, Message,
SomeMessage(..), fromMessage, LayoutMessages(..),
runX, catchX, userCode, io, catchIO, doubleFork,
runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,
withDisplay, withWindowSet, isRoot, runOnWorkspaces,
getAtom, spawn, getXMonadDir, recompile, trace, whenJust, whenX,
getAtom, spawn, spawnPID, getXMonadDir, recompile, trace, whenJust, whenX,
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, ManageHook, Query(..), runQuery
) where
import XMonad.StackSet hiding (modify)
import Prelude hiding ( catch )
import Control.Exception (catch, bracket, throw, Exception(ExitException))
import Control.Exception (catch, try, bracket, throw, finally, Exception(ExitException))
import Control.Applicative
import Control.Monad.State
import Control.Monad.Reader
import System.FilePath
import System.IO
import System.Info
import System.Posix.Process (executeFile, forkProcess, getProcessStatus, createSession)
import System.Posix.Process (executeFile, forkProcess, getAnyProcessStatus, createSession)
import System.Posix.Signals
import System.Posix.IO
import System.Posix.Types (ProcessID)
import System.Process
import System.Directory
import System.Exit
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras (Event)
import Data.Typeable
import Data.List ((\\))
import Data.Maybe (isJust)
import Data.Monoid
import Data.Maybe (fromMaybe)
import qualified Data.Map as M
import qualified Data.Set as S
@@ -69,6 +76,10 @@ data XConf = XConf
-- ^ a mapping of key presses to actions
, buttonActions :: !(M.Map (KeyMask, Button) (Window -> X ()))
-- ^ a mapping of button presses to actions
, mouseFocused :: !Bool -- ^ was refocus caused by mouse action?
, mousePosition :: !(Maybe (Position, Position))
-- ^ position of the mouse according to
-- the event currently being processed
}
-- todo, better name
@@ -78,8 +89,10 @@ data XConfig l = XConfig
, terminal :: !String -- ^ The preferred terminal application. Default: \"xterm\"
, layoutHook :: !(l Window) -- ^ The available layouts
, manageHook :: !ManageHook -- ^ The action to run when a new window is opened
, handleEventHook :: !(Event -> X All) -- ^ Handle an X event, returns (All True) if the default handler
-- should also be run afterwards. mappend should be used for combining
-- event hooks in most cases.
, 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 ()))
@@ -102,24 +115,22 @@ type WorkspaceId = String
-- | Physical screen indices
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) -- ^ gaps on the sides of the screen that shouldn't be tiled, usually for status bars
} deriving (Eq,Show, Read)
-- | The 'Rectangle' with screen dimensions
data ScreenDetail = SD { screenRect :: !Rectangle } deriving (Eq,Show, Read)
------------------------------------------------------------------------
-- | The X monad, ReaderT and StateT transformers over IO
-- | The X monad, 'ReaderT' and 'StateT' transformers over 'IO'
-- encapsulating the window manager configuration and state,
-- respectively.
--
-- 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.
-- 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)
deriving (Functor, Monad, MonadIO, MonadState XState, MonadReader XConf, Typeable)
#endif
instance Applicative X where
@@ -143,12 +154,12 @@ 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
-- | 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
-- | 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
@@ -161,9 +172,14 @@ catchX job errcase = do
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 ())
-- 'catchX' should be used at all callsites of user customized code.
userCode :: X a -> X (Maybe a)
userCode a = catchX (Just `liftM` a) (return Nothing)
-- | Same as userCode but with a default argument to return instead of using
-- Maybe, provided for convenience.
userCodeDef :: a -> X a -> X a
userCodeDef def a = fromMaybe def `liftM` userCode a
-- ---------------------------------------------------------------------
-- Convenient wrappers to state
@@ -330,30 +346,33 @@ instance Message LayoutMessages
-- ---------------------------------------------------------------------
-- | General utilities
--
-- Lift an IO action into the X monad
-- 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
-- | 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 :: MonadIO m => IO () -> m ()
catchIO f = io (f `catch` \e -> hPrint stderr e >> hFlush stderr)
-- | spawn. Launch an external application
-- | spawn. Launch an external application. Specifically, it double-forks and
-- runs the 'String' you pass as a command to /bin/sh.
spawn :: MonadIO m => String -> m ()
spawn x = doubleFork $ executeFile "/bin/sh" False ["-c", x] Nothing
spawn x = spawnPID x >> return ()
-- | 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 ()
-- | Like 'spawn', but returns the 'ProcessID' of the launched application
spawnPID :: MonadIO m => String -> m ProcessID
spawnPID x = io . forkProcess . finally nullStdin $ do
uninstallSignalHandlers
createSession
executeFile "/bin/sh" False ["-c", x] Nothing
where
nullStdin = do
fd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
dupTo fd stdInput
closeFd fd
-- | This is basically a map function, running a function in the X monad on
-- | This is basically a map function, running a function in the 'X' monad on
-- each workspace with the output of that function being the modified workspace.
runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X ()
runOnWorkspaces job = do
@@ -369,8 +388,11 @@ getXMonadDir = io $ getAppUserDataDirectory "xmonad"
-- | 'recompile force', recompile @~\/.xmonad\/xmonad.hs@ when any of the
-- following apply:
-- * force is True
--
-- * 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.
@@ -379,24 +401,31 @@ getXMonadDir = io $ getAppUserDataDirectory "xmonad"
-- GHC indicates failure with a non-zero exit code, an xmessage displaying
-- that file is spawned.
--
-- False is returned if there are compilation errors.
-- 'False' is returned if there are compilation errors.
--
recompile :: MonadIO m => Bool -> m Bool
recompile force = io $ do
dir <- getXMonadDir
let binn = "xmonad-"++arch++"-"++os
bin = dir ++ "/" ++ binn
base = dir ++ "/" ++ "xmonad"
bin = dir </> binn
base = dir </> "xmonad"
err = base ++ ".errors"
src = base ++ ".hs"
lib = dir </> "lib"
libTs <- mapM getModTime . Prelude.filter isSource =<< allFiles lib
srcT <- getModTime src
binT <- getModTime bin
if (force || srcT > binT)
if force || any (binT <) (srcT : libTs)
then do
-- temporarily disable SIGCHLD ignoring:
uninstallSignalHandlers
status <- bracket (openFile err WriteMode) hClose $ \h -> do
waitForProcess =<< runProcess "ghc" ["--make", "xmonad.hs", "-i", "-no-recomp", "-v0", "-o",binn] (Just dir)
waitForProcess =<< runProcess "ghc" ["--make", "xmonad.hs", "-i", "-ilib", "-fforce-recomp", "-v0", "-o",binn] (Just dir)
Nothing Nothing Nothing (Just h)
-- re-enable SIGCHLD:
installSignalHandlers
-- now, if it fails, run xmessage to let the user know:
when (status /= ExitSuccess) $ do
ghcErr <- readFile err
@@ -406,20 +435,43 @@ recompile force = io $ do
-- nb, the ordering of printing, then forking, is crucial due to
-- lazy evaluation
hPutStrLn stderr msg
doubleFork $ executeFile "xmessage" True ["-default", "okay", msg] Nothing
forkProcess $ executeFile "xmessage" True ["-default", "okay", msg] Nothing
return ()
return (status == ExitSuccess)
else return True
where getModTime f = catch (Just <$> getModificationTime f) (const $ return Nothing)
isSource = flip elem [".hs",".lhs",".hsc"]
allFiles t = do
let prep = map (t</>) . Prelude.filter (`notElem` [".",".."])
cs <- prep <$> catch (getDirectoryContents t) (\_ -> return [])
ds <- filterM doesDirectoryExist cs
concat . ((cs \\ ds):) <$> mapM allFiles ds
-- | Conditionally run an action, using a @Maybe a@ to decide.
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
-- | 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
-- | 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
-- | Ignore SIGPIPE to avoid termination when a pipe is full, and SIGCHLD to
-- avoid zombie processes, and clean up any extant zombie processes.
installSignalHandlers :: MonadIO m => m ()
installSignalHandlers = io $ do
installHandler openEndedPipe Ignore Nothing
installHandler sigCHLD Ignore Nothing
try $ fix $ \more -> do
x <- getAnyProcessStatus False False
when (isJust x) more
return ()
uninstallSignalHandlers :: MonadIO m => m ()
uninstallSignalHandlers = io $ do
installHandler sigCHLD Default Nothing
return ()

View File

@@ -7,7 +7,7 @@
-- Copyright : (c) Spencer Janssen 2007
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : sjanssen@cse.unl.edu
-- Maintainer : spencerjanssen@gmail.com
-- Stability : unstable
-- Portability : not portable, Typeable deriving, mtl, posix
--
@@ -16,8 +16,9 @@
-----------------------------------------------------------------------------
module XMonad.Layout (
ChangeLayout(..), Choose, (|||), Resize(..), IncMasterN(..),
Full(..), Tall(..), Mirror(..), mirrorRect, splitVertically,
Full(..), Tall(..), Mirror(..),
Resize(..), IncMasterN(..), Choose, (|||), ChangeLayout(..),
mirrorRect, splitVertically,
splitHorizontally, splitHorizontallyBy, splitVerticallyBy,
tile
@@ -33,31 +34,27 @@ import Control.Monad
import Data.Maybe (fromMaybe)
------------------------------------------------------------------------
-- | Builtin basic layout algorithms:
--
-- > fullscreen mode
-- > tall mode
--
-- The latter algorithms support the following operations:
--
-- > Shrink
-- > Expand
--
-- | Change the size of the master pane.
data Resize = Shrink | Expand deriving Typeable
-- | You can also increase the number of clients in the master pane
-- | 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.
-- | Simple fullscreen mode. Renders the focused window fullscreen.
data Full a = Full deriving (Show, Read)
instance LayoutClass Full a
-- | The builtin tiling mode of xmonad, and its operations.
data Tall a = Tall !Int !Rational !Rational deriving (Show, Read)
-- | The builtin tiling mode of xmonad. Supports 'Shrink', 'Expand' and
-- 'IncMasterN'.
data Tall a = Tall { tallNMaster :: !Int -- ^ The default number of windows in the master pane (default: 1)
, tallRatioIncrement :: !Rational -- ^ Percent of screen to increment by when resizing panes (default: 3/100)
, tallRatio :: !Rational } -- ^ Default proportion of screen occupied by master pane (default: 1/2)
deriving (Show, Read)
-- TODO should be capped [0..1] ..
-- a nice pure layout, lots of properties for the layout, and its messages, in Properties.hs
@@ -76,20 +73,18 @@ instance LayoutClass Tall a where
description _ = "Tall"
-- | tile. Compute the positions for windows using the default 2 pane tiling algorithm.
-- | Compute the positions for windows using the default two-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]
-- The screen is divided 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.
tile
:: Rational -- ^ @frac@, what proportion of the screen to devote to the master area
-> Rectangle -- ^ @r@, the rectangle representing the screen
-> Int -- ^ @nmaster@, the number of windows in the master pane
-> Int -- ^ @n@, the total number of windows to tile
-> [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
@@ -118,10 +113,9 @@ splitHorizontallyBy f (Rectangle sx sy sw sh) =
splitVerticallyBy f = (mirrorRect *** mirrorRect) . splitHorizontallyBy f . mirrorRect
------------------------------------------------------------------------
-- | Mirror a layout, compute its 90 degree rotated form.
-- | Mirror a layout, compute its 90 degree rotated form.
data Mirror l a = Mirror (l a) deriving (Show, Read)
newtype Mirror l a = Mirror (l a) deriving (Show, Read)
instance LayoutClass l a => LayoutClass (Mirror l) a where
runLayout (W.Workspace i (Mirror l) ms) r = (map (second mirrorRect) *** fmap Mirror)
@@ -129,7 +123,7 @@ instance LayoutClass l a => LayoutClass (Mirror l) a where
handleMessage (Mirror l) = fmap (fmap Mirror) . handleMessage l
description (Mirror l) = "Mirror "++ description l
-- | Mirror a rectangle
-- | Mirror a rectangle.
mirrorRect :: Rectangle -> Rectangle
mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw)
@@ -137,8 +131,6 @@ mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw)
-- LayoutClass selection manager
-- Layouts that transition between other layouts
-- | 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)
@@ -146,47 +138,73 @@ instance Message ChangeLayout
-- | The layout choice combinator
(|||) :: (LayoutClass l a, LayoutClass r a) => l a -> r a -> Choose l r a
(|||) = flip SLeft
(|||) = Choose L
infixr 5 |||
data Choose l r a = SLeft (r a) (l a)
| SRight (l a) (r a) deriving (Read, Show)
-- | A layout that allows users to switch between various layout options.
data Choose l r a = Choose LR (l a) (r a) deriving (Read, Show)
-- | Are we on the left or right sub-layout?
data LR = L | R deriving (Read, Show, Eq)
data NextNoWrap = NextNoWrap deriving (Eq, Show, Typeable)
instance Message NextNoWrap
-- This has lots of pseudo duplicated code, we must find a better way
-- | A small wrapper around handleMessage, as it is tedious to write
-- SomeMessage repeatedly.
handle :: (LayoutClass l a, Message m) => l a -> m -> X (Maybe (l a))
handle l m = handleMessage l (SomeMessage m)
-- | A smart constructor that takes some potential modifications, returns a
-- new structure if any fields have changed, and performs any necessary cleanup
-- on newly non-visible layouts.
choose :: (LayoutClass l a, LayoutClass r a)
=> Choose l r a-> LR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a))
choose (Choose d _ _) d' Nothing Nothing | d == d' = return Nothing
choose (Choose d l r) d' ml mr = f lr
where
(l', r') = (fromMaybe l ml, fromMaybe r mr)
lr = case (d, d') of
(L, R) -> (hide l' , return r')
(R, L) -> (return l', hide r' )
(_, _) -> (return l', return r')
f (x,y) = fmap Just $ liftM2 (Choose d') x y
hide x = fmap (fromMaybe x) $ handle x Hide
instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where
runLayout (W.Workspace i (SLeft r l) ms) =
fmap (second . fmap $ SLeft r) . runLayout (W.Workspace i l ms)
runLayout (W.Workspace i (SRight l r) ms) =
fmap (second . fmap $ SRight l) . runLayout (W.Workspace i r ms)
runLayout (W.Workspace i (Choose L l r) ms) =
fmap (second . fmap $ flip (Choose L) $ r) . runLayout (W.Workspace i l ms)
runLayout (W.Workspace i (Choose R l r) ms) =
fmap (second . fmap $ Choose R l) . runLayout (W.Workspace i r ms)
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)
description (Choose L l _) = description l
description (Choose R _ r) = description r
handleMessage lr m | Just NextLayout <- fromMessage m = do
mlr <- handleMessage lr $ SomeMessage NextNoWrap
maybe (handleMessage lr $ SomeMessage FirstLayout) (return . Just) mlr
mlr' <- handle lr NextNoWrap
maybe (handle lr 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 c@(Choose d l r) m | Just NextNoWrap <- fromMessage m =
case d of
L -> do
ml <- handle l NextNoWrap
case ml of
Just _ -> choose c L ml Nothing
Nothing -> choose c R Nothing =<< handle r FirstLayout
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')
R -> choose c R Nothing =<< handle r NextNoWrap
-- 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
handleMessage c@(Choose _ l _) m | Just FirstLayout <- fromMessage m = do
flip (choose c L) Nothing =<< handle l FirstLayout
handleMessage c@(Choose d l r) m | Just ReleaseResources <- fromMessage m =
join $ liftM2 (choose c d) (handle l ReleaseResources) (handle r ReleaseResources)
handleMessage c@(Choose d l r) m = do
ml' <- case d of
L -> handleMessage l m
R -> return Nothing
mr' <- case d of
L -> return Nothing
R -> handleMessage r m
choose c d ml' mr'

View File

@@ -1,11 +1,11 @@
{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, ForeignFunctionInterface #-}
----------------------------------------------------------------------------
-- |
-- Module : XMonad.Main
-- Copyright : (c) Spencer Janssen 2007
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : sjanssen@cse.unl.edu
-- Maintainer : spencerjanssen@gmail.com
-- Stability : unstable
-- Portability : not portable, uses mtl, X11, posix
--
@@ -22,9 +22,12 @@ import qualified Data.Set as S
import Control.Monad.Reader
import Control.Monad.State
import Data.Maybe (fromMaybe)
import Data.Monoid (getAll)
import Foreign.C
import Foreign.Ptr
import System.Environment (getArgs)
import System.Posix.Signals
import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
import Graphics.X11.Xlib.Extras
@@ -37,19 +40,44 @@ import XMonad.Operations
import System.IO
------------------------------------------------------------------------
-- Locale support
#include <locale.h>
foreign import ccall unsafe "locale.h setlocale"
c_setlocale :: CInt -> Ptr CChar -> IO (Ptr CChar)
------------------------------------------------------------------------
-- |
-- The main entry point
--
xmonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
xmonad initxmc = do
-- ignore SIGPIPE
installHandler openEndedPipe Ignore Nothing
-- setup locale information from environment
withCString "" $ c_setlocale (#const LC_ALL)
-- ignore SIGPIPE and SIGCHLD
installSignalHandlers
-- 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
-- If another WM is running, a BadAccess error will be returned. The
-- default error handler will write the exception to stderr and exit with
-- an error.
selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask
.|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask
.|. buttonPressMask
sync dpy False -- sync to ensure all outstanding errors are delivered
-- turn off the default handler in favor of one that ignores all errors
-- (ugly, I know)
xSetErrorHandler -- in C, I'm too lazy to write the binding: dons
xinesc <- getCleanedScreenInfo dpy
nbc <- do v <- initColor dpy $ normalBorderColor xmc
~(Just nbc_) <- initColor dpy $ normalBorderColor Default.defaultConfig
@@ -64,7 +92,7 @@ xmonad initxmc = do
let layout = layoutHook xmc
lreads = readsLayout layout
initialWinset = new layout (workspaces xmc) $ zipWith SD xinesc gaps
initialWinset = new layout (workspaces xmc) $ map SD xinesc
maybeRead reads' s = case reads' s of
[(x, "")] -> Just x
@@ -76,8 +104,6 @@ xmonad initxmc = do
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
@@ -85,20 +111,15 @@ xmonad initxmc = do
, normalBorder = nbc
, focusedBorder = fbc
, keyActions = keys xmc xmc
, buttonActions = mouseBindings xmc xmc }
, buttonActions = mouseBindings xmc xmc
, mouseFocused = False
, mousePosition = Nothing }
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
@@ -122,11 +143,27 @@ xmonad initxmc = do
userCode $ startupHook initxmc
-- main loop, for all you HOF/recursion fans out there.
forever_ $ handle =<< io (nextEvent dpy e >> getEvent e)
forever_ $ prehandle =<< io (nextEvent dpy e >> getEvent e)
return ()
where forever_ a = a >> forever_ a
where
forever_ a = a >> forever_ a
-- if the event gives us the position of the pointer, set mousePosition
prehandle e = let mouse = do guard (ev_event_type e `elem` evs)
return (fromIntegral (ev_x_root e)
,fromIntegral (ev_y_root e))
in local (\c -> c { mousePosition = mouse }) (handleWithHook e)
evs = [ keyPress, keyRelease, enterNotify, leaveNotify
, buttonPress, buttonRelease]
-- | Runs handleEventHook from the configuration and runs the default handler
-- function if it returned True.
handleWithHook :: Event -> X ()
handleWithHook e = do
evHook <- asks (handleEventHook . config)
whenX (userCodeDef True $ getAll `fmap` evHook e) (handle e)
-- ---------------------------------------------------------------------
-- | Event handler. Map X events onto calls into Operations.hs, which
@@ -146,7 +183,7 @@ handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
s <- io $ keycodeToKeysym dpy code 0
mClean <- cleanMask m
ks <- asks keyActions
userCode $ whenJust (M.lookup (mClean, s) ks) id
userCodeDef () $ whenJust (M.lookup (mClean, s) ks) id
-- manage a new window
handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
@@ -200,16 +237,16 @@ handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })
-- 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
mact <- asks (M.lookup (m, b) . buttonActions)
case mact of
(Just act) | isr -> act $ ev_subwindow e
_ -> focus w
broadcastMessage e -- Always send button events.
-- entered a normal window: focus it if focusFollowsMouse is set to
-- True in the user's config.
handle e@(CrossingEvent {ev_window = w, ev_event_type = t})
| t == enterNotify && ev_mode e == notifyNormal
&& ev_detail e /= notifyInferior
= whenX (asks $ focusFollowsMouse . config) (focus w)
-- left a window, check if we need to focus root
@@ -249,7 +286,13 @@ 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)
| t == propertyNotify && a == wM_NAME = userCodeDef () =<< asks (logHook . config)
handle e@ClientMessageEvent { ev_message_type = mt } = do
a <- getAtom "XMONAD_RESTART"
if (mt == a)
then restart "xmonad" True
else broadcastMessage e
handle e = broadcastMessage e -- trace (eventName e) -- ignoring

View File

@@ -6,7 +6,7 @@
-- Copyright : (c) Spencer Janssen 2007
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : sjanssen@cse.unl.edu
-- Maintainer : spencerjanssen@gmail.com
-- Stability : unstable
-- Portability : not portable, uses cunning newtype deriving
--
@@ -18,15 +18,18 @@
module XMonad.ManageHook where
import Prelude hiding (catch)
import XMonad.Core
import Graphics.X11.Xlib.Extras
import Graphics.X11.Xlib (Display,Window)
import Graphics.X11.Xlib (Display, Window, internAtom, wM_NAME)
import Control.Exception (bracket, catch)
import Control.Monad.Reader
import Data.Maybe
import Data.Monoid
import qualified XMonad.StackSet as W
import XMonad.Operations (floatLocation, reveal)
-- | Lift an 'X' action to a 'Query'.
liftX :: X a -> Query a
liftX = Query . lift
@@ -34,39 +37,59 @@ liftX = Query . lift
idHook :: ManageHook
idHook = doF id
-- | Compose two 'ManageHook's
-- | Compose two 'ManageHook's.
(<+>) :: ManageHook -> ManageHook -> ManageHook
(<+>) = mappend
-- | Compose the list of 'ManageHook's
-- | Compose the list of 'ManageHook's.
composeAll :: [ManageHook] -> ManageHook
composeAll = mconcat
-- | 'p --> x'. If 'p' returns 'True', execute the 'ManageHook'.
infix 0 -->
-- | @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'.
-- | @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.
-- | '&&' lifted to a 'Monad'.
(<&&>) :: Monad m => m Bool -> m Bool -> m Bool
(<&&>) = liftM2 (&&)
-- | 'p <||> q'. '||' lifted to a Monad.
-- | '||' 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)
-- | Return the window title.
title :: Query String
title = ask >>= \w -> liftX $ do
d <- asks display
let
getProp =
(internAtom d "_NET_WM_NAME" False >>= getTextProperty d w)
`catch` \_ -> getTextProperty d w wM_NAME
extract prop = do l <- wcTextPropertyToTextList d prop
return $ if null l then "" else head l
io $ bracket getProp (xFree . tp_value) extract `catch` \_ -> return ""
-- | A query that can return an arbitrary X property of type String,
-- | Return the application name.
appName :: Query String
appName = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resName $ io $ getClassHint d w)
-- | Backwards compatible alias for 'appName'.
resource :: Query String
resource = appName
-- | Return the resource class.
className :: Query String
className = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resClass $ io $ getClassHint d w)
-- | A query that can return an arbitrary X property of type 'String',
-- identified by name.
stringProperty :: String -> Query String
stringProperty p = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap (fromMaybe "") $ getStringProperty d w p)
@@ -88,3 +111,7 @@ 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)
-- | Move the window to a given workspace
doShift :: WorkspaceId -> ManageHook
doShift i = doF . W.shiftWin i =<< ask

View File

@@ -23,7 +23,7 @@ import XMonad.Layout (Full(..))
import qualified XMonad.StackSet as W
import Data.Maybe
import Data.Monoid (appEndo)
import Data.Monoid (Endo(..))
import Data.List (nub, (\\), find)
import Data.Bits ((.|.), (.&.), complement)
import Data.Ratio
@@ -57,7 +57,7 @@ manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
let isFixedSize = sh_min_size sh /= Nothing && sh_min_size sh == sh_max_size sh
isTransient <- isJust <$> io (getTransientForHint d w)
(sc, rr) <- floatLocation w
rr <- snd `fmap` floatLocation w
-- ensure that float windows don't go over the edge of the screen
let adjust (W.RationalRect x y wid h) | x + wid > 1 || y + h > 1 || x < 0 || y < 0
= W.RationalRect (0.5 - wid/2) (0.5 - h/2) wid h
@@ -65,10 +65,10 @@ manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
f ws | isFixedSize || isTransient = W.float w (adjust rr) . W.insertUp w . W.view i $ ws
| otherwise = W.insertUp w ws
where i = fromMaybe (W.tag . W.workspace . W.current $ ws) $ W.lookupWorkspace sc ws
where i = W.tag $ W.workspace $ W.current ws
mh <- asks (manageHook . config)
g <- fmap appEndo (runQuery mh w) `catchX` return id
g <- fmap appEndo $ userCodeDef (Endo id) (runQuery mh w)
windows (g . f)
-- | unmanage. A window no longer exists, remove it from the window
@@ -77,23 +77,14 @@ manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
unmanage :: Window -> X ()
unmanage = windows . W.delete
-- | Modify the size of the status gap at the top of the current screen
-- Taking a function giving the current screen, and current geometry.
modifyGap :: (Int -> (Int,Int,Int,Int) -> (Int,Int,Int,Int)) -> X ()
modifyGap f = do
windows $ \ws@(W.StackSet { W.current = c@(W.Screen { W.screenDetail = sd }) }) ->
let n = fromIntegral . W.screen $ c
g = f n . statusGap $ sd
in ws { W.current = c { W.screenDetail = sd { statusGap = g } } }
-- | Kill the currently focused client. If we do kill it, we'll get a
-- | Kill the specified window. If we do kill it, we'll get a
-- delete notify back from X.
--
-- There are two ways to delete a window. Either just kill it, or if it
-- supports the delete protocol, send a delete event (e.g. firefox)
--
kill :: X ()
kill = withDisplay $ \d -> withFocused $ \w -> do
killWindow :: Window -> X ()
killWindow w = withDisplay $ \d -> do
wmdelt <- atom_WM_DELETE_WINDOW ; wmprot <- atom_WM_PROTOCOLS
protocols <- io $ getWMProtocols d w
@@ -104,6 +95,10 @@ kill = withDisplay $ \d -> withFocused $ \w -> do
sendEvent d w False noEventMask ev
else killClient d w >> return ()
-- | Kill the currently focused client.
kill :: X ()
kill = withFocused killWindow
-- ---------------------------------------------------------------------
-- Managing windows
@@ -112,10 +107,11 @@ windows :: (WindowSet -> WindowSet) -> X ()
windows f = do
XState { windowset = old } <- get
let oldvisible = concatMap (W.integrate' . W.stack . W.workspace) $ W.current old : W.visible old
newwindows = W.allWindows ws \\ W.allWindows old
ws = f old
XConf { display = d , normalBorder = nbc, focusedBorder = fbc } <- ask
mapM_ setInitialProperties (W.allWindows ws \\ W.allWindows old)
mapM_ setInitialProperties newwindows
whenJust (W.peek old) $ \otherw -> io $ setWindowBorder d otherw nbc
modify (\s -> s { windowset = ws })
@@ -128,53 +124,58 @@ windows f = do
-- for each workspace, layout the currently visible workspaces
let allscreens = W.screens ws
summed_visible = scanl (++) [] $ map (W.integrate' . W.stack . W.workspace) allscreens
visible <- fmap concat $ forM (zip allscreens summed_visible) $ \ (w, vis) -> do
rects <- fmap concat $ forM (zip allscreens summed_visible) $ \ (w, vis) -> do
let wsp = W.workspace w
this = W.view n ws
n = W.tag wsp
flt = filter (flip M.member (W.floating ws)) (W.index this)
tiled = (W.stack . W.workspace . W.current $ this)
>>= W.filter (`M.notMember` W.floating ws)
>>= W.filter (`notElem` vis)
(SD (Rectangle sx sy sw sh)
(gt,gb,gl,gr)) = W.screenDetail w
viewrect = Rectangle (sx + fromIntegral gl) (sy + fromIntegral gt)
(sw - fromIntegral (gl + gr)) (sh - fromIntegral (gt + gb))
viewrect = screenRect $ W.screenDetail w
-- just the tiled windows:
-- now tile the windows on this workspace, modified by the gap
(rs, ml') <- runLayout wsp { W.stack = tiled } viewrect `catchX`
runLayout wsp { W.stack = tiled, W.layout = Layout Full } viewrect
mapM_ (uncurry tileWindow) rs
updateLayout n ml'
-- now the floating windows:
-- move/resize the floating windows, if there are any
forM_ flt $ \fw -> whenJust (M.lookup fw (W.floating ws)) $
\(W.RationalRect rx ry rw rh) -> do
tileWindow fw $ Rectangle
(sx + floor (toRational sw*rx)) (sy + floor (toRational sh*ry))
(floor (toRational sw*rw)) (floor (toRational sh*rh))
let m = W.floating ws
flt = [(fw, scaleRationalRect viewrect r)
| fw <- filter (flip M.member m) (W.index this)
, Just r <- [M.lookup fw m]]
vs = flt ++ rs
let vs = flt ++ map fst rs
io $ restackWindows d vs
io $ restackWindows d (map fst vs)
-- return the visible windows for this workspace:
return vs
let visible = map fst rects
mapM_ (uncurry tileWindow) rects
whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc
setTopFocus
asks (logHook . config) >>= userCode
-- hide every window that was potentially visible before, but is not
-- given a position by a layout now.
mapM_ hide (nub oldvisible \\ visible)
mapM_ hide (nub (oldvisible ++ newwindows) \\ visible)
mapM_ reveal visible
setTopFocus
-- all windows that are no longer in the windowset are marked as
-- withdrawn, it is important to do this after the above, otherwise 'hide'
-- will overwrite withdrawnState with iconicState
mapM_ (flip setWMState withdrawnState) (W.allWindows old \\ W.allWindows ws)
clearEvents enterWindowMask
isMouseFocused <- asks mouseFocused
unless isMouseFocused $ clearEvents enterWindowMask
asks (logHook . config) >>= userCodeDef ()
-- | Produce the actual rectangle from a screen and a ratio on that screen.
scaleRationalRect :: Rectangle -> W.RationalRect -> Rectangle
scaleRationalRect (Rectangle sx sy sw sh) (W.RationalRect rx ry rw rh)
= Rectangle (sx + scale sw rx) (sy + scale sh ry) (scale sw rw) (scale sh rh)
where scale s r = floor (toRational s * r)
-- | setWMState. set the WM_STATE property
setWMState :: Window -> Int -> X ()
@@ -218,7 +219,7 @@ setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do
io $ setWindowBorder d w nb
-- | 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.
--
-- This is our 'view' operation (MVC), in that it pretty prints our model
-- with X calls.
@@ -244,11 +245,10 @@ tileWindow w r = withDisplay $ \d -> do
| otherwise = x - bw*2
io $ moveResizeWindow d w (rect_x r) (rect_y r)
(least $ rect_width r) (least $ rect_height r)
reveal w
-- ---------------------------------------------------------------------
-- | Returns True if the first rectangle is contained within, but not equal
-- | Returns 'True' if the first rectangle is contained within, but not equal
-- to the second.
containedIn :: Rectangle -> Rectangle -> Bool
containedIn r1@(Rectangle x1 y1 w1 h1) r2@(Rectangle x2 y2 w2 h2)
@@ -276,9 +276,7 @@ rescreen = do
windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->
let (xs, ys) = splitAt (length xinesc) $ map W.workspace (v:vs) ++ hs
(a:as) = zipWith3 W.Screen xs [0..] $ zipWith SD xinesc gs
sgs = map (statusGap . W.screenDetail) (v:vs)
gs = take (length xinesc) (sgs ++ repeat (0,0,0,0))
(a:as) = zipWith3 W.Screen xs [0..] $ map SD xinesc
in ws { W.current = a
, W.visible = as
, W.hidden = ys }
@@ -305,9 +303,17 @@ setTopFocus = withWindowSet $ maybe (setFocusX =<< asks theRoot) setFocusX . W.p
-- This happens if X notices we've moved the mouse (and perhaps moved
-- the mouse to a new screen).
focus :: Window -> X ()
focus w = withWindowSet $ \s -> do
if W.member w s then when (W.peek s /= Just w) $ windows (W.focusWindow w)
else whenX (isRoot w) $ setFocusX w
focus w = local (\c -> c { mouseFocused = True }) $ withWindowSet $ \s -> do
let stag = W.tag . W.workspace
curr = stag $ W.current s
mnew <- maybe (return Nothing) (fmap (fmap stag) . uncurry pointScreen)
=<< asks mousePosition
root <- asks theRoot
case () of
_ | W.member w s && W.peek s /= Just w -> windows (W.focusWindow w)
| Just new <- mnew, w == root && curr /= new
-> windows (W.view new)
| otherwise -> return ()
-- | Call X to set the keyboard focus details.
setFocusX :: Window -> X ()
@@ -327,7 +333,7 @@ setFocusX w = withWindowSet $ \ws -> do
------------------------------------------------------------------------
-- Message handling
-- | Throw a message to the current LayoutClass possibly modifying how we
-- | Throw a message to the current 'LayoutClass' possibly modifying how we
-- layout the windows, then refresh.
sendMessage :: Message a => a -> X ()
sendMessage a = do
@@ -367,15 +373,15 @@ setLayout l = do
------------------------------------------------------------------------
-- Utilities
-- | Return workspace visible on screen 'sc', or Nothing.
-- | Return workspace visible on screen 'sc', or 'Nothing'.
screenWorkspace :: ScreenId -> X (Maybe WorkspaceId)
screenWorkspace sc = withWindowSet $ return . W.lookupWorkspace sc
-- | Apply an X operation to the currently focused window, if there is one.
-- | Apply an 'X' operation to the currently focused window, if there is one.
withFocused :: (Window -> X ()) -> X ()
withFocused f = withWindowSet $ \w -> whenJust (W.peek w) f
-- | True if window is under management by us
-- | 'True' if window is under management by us
isClient :: Window -> X Bool
isClient w = withWindowSet $ return . W.member w
@@ -392,7 +398,7 @@ 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 (Maybe Pixel)
initColor dpy c = C.handle (\_ -> return Nothing) $
(Just . color_pixel . fst) <$> allocNamedColor dpy colormap c
@@ -421,10 +427,9 @@ floatLocation w = withDisplay $ \d -> do
ws <- gets windowset
wa <- io $ getWindowAttributes d w
bw <- fi <$> asks (borderWidth . config)
sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
-- XXX horrible
let sc = fromMaybe (W.current ws) $ find (pointWithin (fi $ wa_x wa) (fi $ wa_y wa) . screenRect . W.screenDetail) $ W.screens ws
sr = screenRect . W.screenDetail $ sc
let sr = screenRect . W.screenDetail $ sc
rr = W.RationalRect ((fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr))
((fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr))
(fi (wa_width wa + bw*2) % fi (rect_width sr))
@@ -432,11 +437,20 @@ floatLocation w = withDisplay $ \d -> do
return (W.screen $ sc, rr)
where fi x = fromIntegral x
pointWithin :: Integer -> Integer -> Rectangle -> Bool
pointWithin x y r = x >= fi (rect_x r) &&
x < fi (rect_x r) + fi (rect_width r) &&
y >= fi (rect_y r) &&
y < fi (rect_y r) + fi (rect_height r)
-- | Given a point, determine the screen (if any) that contains it.
pointScreen :: Position -> Position
-> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
pointScreen x y = withWindowSet $ return . find p . W.screens
where p = pointWithin x y . screenRect . W.screenDetail
-- | @pointWithin x y r@ returns 'True' if the @(x, y)@ co-ordinate is within
-- @r@.
pointWithin :: Position -> Position -> Rectangle -> Bool
pointWithin x y r = x >= rect_x r &&
x < rect_x r + fromIntegral (rect_width r) &&
y >= rect_y r &&
y < rect_y r + fromIntegral (rect_height r)
-- | Make a tiled window floating, using its suggested rectangle
float :: Window -> X ()
@@ -493,8 +507,8 @@ mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
mouseDrag (\ex ey -> do
io $ resizeWindow d w `uncurry`
applySizeHints sh (ex - fromIntegral (wa_x wa),
ey - fromIntegral (wa_y wa)))
applySizeHintsContents sh (ex - fromIntegral (wa_x wa),
ey - fromIntegral (wa_y wa)))
(float w)
-- ---------------------------------------------------------------------
@@ -502,10 +516,26 @@ mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
type D = (Dimension, Dimension)
-- | Given a window, build an adjuster function that will reduce the given
-- dimensions according to the window's border width and size hints.
mkAdjust :: Window -> X (D -> D)
mkAdjust w = withDisplay $ \d -> liftIO $ do
sh <- getWMNormalHints d w
bw <- fmap (fromIntegral . wa_border_width) $ getWindowAttributes d w
return $ applySizeHints bw sh
-- | Reduce the dimensions if needed to comply to the given SizeHints, taking
-- window borders into account.
applySizeHints :: Integral a => Dimension -> SizeHints -> (a, a) -> D
applySizeHints bw sh =
tmap (+ 2 * bw) . applySizeHintsContents sh . tmap (subtract $ 2 * fromIntegral bw)
where
tmap f (x, y) = (f x, f y)
-- | Reduce the dimensions if needed to comply to the given SizeHints.
applySizeHints :: Integral a => SizeHints -> (a,a) -> D
applySizeHints sh (w,h) = applySizeHints' sh (fromIntegral $ max 1 w,
fromIntegral $ max 1 h)
applySizeHintsContents :: Integral a => SizeHints -> (a, a) -> D
applySizeHintsContents sh (w, h) =
applySizeHints' sh (fromIntegral $ max 1 w, fromIntegral $ max 1 h)
-- | XXX comment me
applySizeHints' :: SizeHints -> D -> D

View File

@@ -31,18 +31,18 @@ module XMonad.StackSet (
-- * Xinerama operations
-- $xinerama
lookupWorkspace,
screens, workspaces, allWindows,
screens, workspaces, allWindows, currentTag,
-- * Operations on the current stack
-- $stackOperations
peek, index, integrate, integrate', differentiate,
focusUp, focusDown, focusMaster, focusWindow,
focusUp, focusDown, focusUp', focusDown', focusMaster, focusWindow,
tagMember, renameTag, ensureTags, member, findTag, mapWorkspace, mapLayout,
-- * Modifying the stackset
-- $modifyStackset
insertUp, delete, delete', filter,
-- * Setting the master window
-- $settingMW
swapUp, swapDown, swapMaster, modify, modify', float, sink, -- needed by users
swapUp, swapDown, swapMaster, shiftMaster, modify, modify', float, sink, -- needed by users
-- * Composite operations
-- $composite
shift, shiftWin,
@@ -52,7 +52,7 @@ module XMonad.StackSet (
) where
import Prelude hiding (filter)
import Data.Maybe (listToMaybe,fromJust,isJust)
import Data.Maybe (listToMaybe,isJust)
import qualified Data.List as L (deleteBy,find,splitAt,filter,nub)
import Data.List ( (\\) )
import qualified Data.Map as M (Map,insert,delete,empty)
@@ -111,7 +111,7 @@ import qualified Data.Map as M (Map,insert,delete,empty)
-- receive keyboard events), other workspaces may be passively
-- viewable. We thus need to track which virtual workspaces are
-- associated (viewed) on which physical screens. To keep track of
-- this, StackSet keeps separate lists of visible but non-focused
-- this, 'StackSet' keeps separate lists of visible but non-focused
-- workspaces, and non-visible workspaces.
-- $focus
@@ -194,7 +194,8 @@ abort x = error $ "xmonad: StackSet: " ++ x
-- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.
--
new :: (Integral s) => l -> [i] -> [sd] -> StackSet i l a s sd
new l wids m | not (null wids) && length m <= length wids = StackSet cur visi unseen M.empty
new l wids m | not (null wids) && length m <= length wids && not (null m)
= StackSet cur visi unseen M.empty
where (seen,unseen) = L.splitAt (length m) $ map (\i -> Workspace i l Nothing) wids
(cur:visi) = [ Screen i s sd | (i, s, sd) <- zip3 seen [0..] m ]
-- now zip up visibles with their screen id
@@ -202,7 +203,7 @@ new _ _ _ = abort "non-positive argument to StackSet.new"
-- |
-- /O(w)/. Set focus to the workspace with index \'i\'.
-- If the index is out of range, return the original StackSet.
-- If the index is out of range, return the original 'StackSet'.
--
-- Xinerama: If the workspace is not visible on any Xinerama screen, it
-- becomes the current screen. If it is in the visible list, it becomes
@@ -210,7 +211,7 @@ new _ _ _ = abort "non-positive argument to StackSet.new"
view :: (Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd
view i s
| i == tag (workspace (current s)) = s -- current
| i == currentTag s = s -- current
| Just x <- L.find ((i==).tag.workspace) (visible s)
-- if it is visible, it is just raised
@@ -252,7 +253,7 @@ greedyView w ws
-- $xinerama
-- | Find the tag of the workspace visible on Xinerama screen 'sc'.
-- Nothing if screen is out of bounds.
-- 'Nothing' if screen is out of bounds.
lookupWorkspace :: Eq s => s -> StackSet i l a s sd -> Maybe i
lookupWorkspace sc w = listToMaybe [ tag i | Screen i s _ <- current w : visible w, s == sc ]
@@ -269,7 +270,7 @@ with :: b -> (Stack a -> b) -> StackSet i l a s sd -> b
with dflt f = maybe dflt f . stack . workspace . current
-- |
-- Apply a function, and a default value for Nothing, to modify the current stack.
-- Apply a function, and a default value for 'Nothing', to modify the current stack.
--
modify :: Maybe (Stack a) -> (Stack a -> Maybe (Stack a)) -> StackSet i l a s sd -> StackSet i l a s sd
modify d f s = s { current = (current s)
@@ -284,13 +285,13 @@ modify' f = modify Nothing (Just . f)
-- |
-- /O(1)/. Extract the focused element of the current stack.
-- Return Just that element, or Nothing for an empty stack.
-- Return 'Just' that element, or 'Nothing' for an empty stack.
--
peek :: StackSet i l a s sd -> Maybe a
peek = with Nothing (return . focus)
-- |
-- /O(n)/. Flatten a Stack into a list.
-- /O(n)/. Flatten a 'Stack' into a list.
--
integrate :: Stack a -> [a]
integrate (Stack x l r) = reverse l ++ x : r
@@ -310,7 +311,7 @@ differentiate (x:xs) = Just $ Stack x [] xs
-- |
-- /O(n)/. 'filter p s' returns the elements of 's' such that 'p' evaluates to
-- True. Order is preserved, and focus moves as described for 'delete'.
-- 'True'. Order is preserved, and focus moves as described for 'delete'.
--
filter :: (a -> Bool) -> Stack a -> Maybe (Stack a)
filter p (Stack f ls rs) = case L.filter p (f:rs) of
@@ -342,15 +343,19 @@ index = with [] integrate
--
focusUp, focusDown, swapUp, swapDown :: StackSet i l a s sd -> StackSet i l a s sd
focusUp = modify' focusUp'
focusDown = modify' (reverseStack . focusUp' . reverseStack)
focusDown = modify' focusDown'
swapUp = modify' swapUp'
swapDown = modify' (reverseStack . swapUp' . reverseStack)
focusUp', swapUp' :: Stack a -> Stack a
-- | Variants of 'focusUp' and 'focusDown' that work on a
-- 'Stack' rather than an entire 'StackSet'.
focusUp', focusDown' :: Stack a -> Stack a
focusUp' (Stack t (l:ls) rs) = Stack l ls (t:rs)
focusUp' (Stack t [] rs) = Stack x xs [] where (x:xs) = reverse (t:rs)
focusDown' = reverseStack . focusUp' . reverseStack
swapUp' :: Stack a -> Stack a
swapUp' (Stack t (l:ls) rs) = Stack t ls (l:rs)
swapUp' (Stack t [] rs) = Stack t (reverse rs) []
@@ -368,23 +373,27 @@ focusWindow w s | Just w == peek s = s
n <- findTag w 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'.
screens :: StackSet i l a s sd -> [Screen i l a s sd]
screens s = current s : visible s
-- | Get a list of all workspaces in the StackSet.
-- | Get a list of all workspaces in the 'StackSet'.
workspaces :: StackSet i l a s sd -> [Workspace i l a]
workspaces s = workspace (current s) : map workspace (visible s) ++ hidden s
-- | Get a list of all windows in the StackSet in no particular order
-- | Get a list of all windows in the 'StackSet' in no particular order
allWindows :: Eq a => StackSet i l a s sd -> [a]
allWindows = L.nub . concatMap (integrate' . stack) . workspaces
-- | Is the given tag present in the StackSet?
-- | Get the tag of the currently focused workspace.
currentTag :: StackSet i l a s sd -> i
currentTag = tag . workspace . current
-- | Is the given tag present in the 'StackSet'?
tagMember :: Eq i => i -> StackSet i l a s sd -> Bool
tagMember t = elem t . map tag . workspaces
-- | Rename a given tag if present in the StackSet.
-- | Rename a given tag if present in the 'StackSet'.
renameTag :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd
renameTag o n = mapWorkspace rename
where rename w = if tag w == o then w { tag = n } else w
@@ -399,27 +408,27 @@ ensureTags l allt st = et allt (map tag (workspaces st) \\ allt) st
et (i:is) [] s = et is [] (s { hidden = Workspace i l Nothing : hidden s })
et (i:is) (r:rs) s = et is rs $ renameTag r i s
-- | Map a function on all the workspaces in the StackSet.
-- | Map a function on all the workspaces in the 'StackSet'.
mapWorkspace :: (Workspace i l a -> Workspace i l a) -> StackSet i l a s sd -> StackSet i l a s sd
mapWorkspace f s = s { current = updScr (current s)
, visible = map updScr (visible s)
, hidden = map f (hidden s) }
where updScr scr = scr { workspace = f (workspace scr) }
-- | Map a function on all the layouts in the StackSet.
-- | Map a function on all the layouts in the 'StackSet'.
mapLayout :: (l -> l') -> StackSet i l a s sd -> StackSet i l' a s sd
mapLayout f (StackSet v vs hs m) = StackSet (fScreen v) (map fScreen vs) (map fWorkspace hs) m
where
fScreen (Screen ws s sd) = Screen (fWorkspace ws) s sd
fWorkspace (Workspace t l s) = Workspace t (f l) s
-- | /O(n)/. Is a window in the StackSet?
-- | /O(n)/. Is a window in the 'StackSet'?
member :: Eq a => a -> StackSet i l a s sd -> Bool
member a s = isJust (findTag a s)
-- | /O(1) on current window, O(n) in general/.
-- Return Just the workspace tag of the given window, or Nothing
-- if the window is not in the StackSet.
-- Return 'Just' the workspace tag of the given window, or 'Nothing'
-- if the window is not in the 'StackSet'.
findTag :: Eq a => a -> StackSet i l a s sd -> Maybe i
findTag a s = listToMaybe
[ tag w | w <- workspaces s, has a (stack w) ]
@@ -454,21 +463,25 @@ insertUp a s = if member a s then s else insert
-- /O(1) on current window, O(n) in general/. Delete window 'w' if it exists.
-- There are 4 cases to consider:
--
-- * delete on an Nothing workspace leaves it Nothing
-- * delete on an 'Nothing' workspace leaves it Nothing
--
-- * otherwise, try to move focus to the down
--
-- * otherwise, try to move focus to the up
-- * otherwise, you've got an empty workspace, becomes Nothing
--
-- * otherwise, you've got an empty workspace, becomes 'Nothing'
--
-- Behaviour with respect to the master:
--
-- * deleting the master window resets it to the newly focused window
--
-- * otherwise, delete doesn't affect the master.
--
delete :: (Ord a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd
delete w = sink w . delete' w
-- | Only temporarily remove the window from the stack, thereby not destroying special
-- information saved in the Stackset
-- information saved in the 'Stackset'
delete' :: (Eq a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd
delete' w s = s { current = removeFromScreen (current s)
, visible = map removeFromScreen (visible s)
@@ -479,7 +492,7 @@ delete' w s = s { current = removeFromScreen (current s)
------------------------------------------------------------------------
-- | Given a window, and its preferred rectangle, set it as floating
-- A floating window should already be managed by the StackSet.
-- A floating window should already be managed by the 'StackSet'.
float :: Ord a => a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
float w r s = s { floating = M.insert w r (floating s) }
@@ -500,6 +513,15 @@ swapMaster = modify' $ \c -> case c of
-- natural! keep focus, move current to the top, move top to current.
-- | /O(s)/. Set the master window to the focused window.
-- The other windows are kept in order and shifted down on the stack, as if you
-- just hit mod-shift-k a bunch of times.
-- Focus stays with the item moved.
shiftMaster :: StackSet i l a s sd -> StackSet i l a s sd
shiftMaster = modify' $ \c -> case c of
Stack _ [] _ -> c -- already master.
Stack t ls rs -> Stack t [] (reverse ls ++ rs)
-- | /O(s)/. Set focus to the master window.
focusMaster :: StackSet i l a s sd -> StackSet i l a s sd
focusMaster = modify' $ \c -> case c of
@@ -517,10 +539,7 @@ focusMaster = modify' $ \c -> case c of
-- element on the current stack, the original stackSet is returned.
--
shift :: (Ord a, Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd
shift n s | n `tagMember` s && n /= curtag = maybe s go (peek s)
| otherwise = s
where go w = view curtag . insertUp w . view n . delete' w $ s
curtag = tag (workspace (current s))
shift n s = maybe s (\w -> shiftWin n w s) (peek s)
-- | /O(n)/. shiftWin. Searches for the specified window 'w' on all workspaces
-- of the stackSet and moves it to stack 'n', leaving it as the focused
@@ -528,14 +547,12 @@ shift n s | n `tagMember` s && n /= curtag = maybe s go (peek s)
-- focused element on that workspace.
-- The actual focused workspace doesn't change. If the window is not
-- found in the stackSet, the original stackSet is returned.
-- TODO how does this duplicate 'shift's behaviour?
shiftWin :: (Ord a, Eq a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
shiftWin n w s | from == Nothing = s -- not found
| n `tagMember` s && (Just n) /= from = go
| otherwise = s
where from = findTag w s
go = on n (insertUp w) . on (fromJust from) (delete' w) $ s
curtag = tag (workspace (current s))
on i f = view curtag . f . view i
shiftWin n w s = case findTag w s of
Just from | n `tagMember` s && n /= from -> go from s
_ -> s
where go from = onWorkspace n (insertUp w) . onWorkspace from (delete' w)
onWorkspace :: (Eq i, Eq s) => i -> (StackSet i l a s sd -> StackSet i l a s sd)
-> (StackSet i l a s sd -> StackSet i l a s sd)
onWorkspace n f s = view (currentTag s) . f . view n $ s

View File

@@ -1,15 +1,17 @@
./" man page created by David Lazar on April 24, 2007
./" uses ``tmac.an'' macro set
.TH xmonad 1 "18 April 07" xmonad\-1.0 "xmonad manual"
.TH xmonad 1 "8 September 09"\
___RELEASE___\
"xmonad manual"
.SH NAME
xmonad \- a tiling window manager
.SH DESCRIPTION
.PP
\fBxmonad\fR is a minimalist tiling window manager for X, written in Haskell. Windows are managed using automatic layout algorithms, which can be dynamically reconfigured. At any time windows are arranged so as to maximise the use of screen real estate. All features of the window manager are accessible purely from the keyboard: a mouse is entirely optional. \fBxmonad\fR is configured in Haskell, and custom layout algorithms may be implemented by the user in config files. A principle of \fBxmonad\fR is predictability: the user should know in advance precisely the window arrangement that will result from any action.
\fBxmonad\fR is a minimalist tiling window manager for X, written in Haskell. Windows are managed using automatic layout algorithms, which can be dynamically reconfigured. At any time windows are arranged so as to maximize the use of screen real estate. All features of the window manager are accessible purely from the keyboard: a mouse is entirely optional. \fBxmonad\fR is configured in Haskell, and custom layout algorithms may be implemented by the user in config files. A principle of \fBxmonad\fR is predictability: the user should know in advance precisely the window arrangement that will result from any action.
.PP
By default, \fBxmonad\fR provides three layout algorithms: tall, wide and fullscreen. In tall or wide mode, windows are tiled and arranged to prevent overlap and maximise screen use. Sets of windows are grouped together on virtual screens, and each screen retains its own layout, which may be reconfigured dynamically. Multiple physical monitors are supported via Xinerama, allowing simultaneous display of a number of screens.
By default, \fBxmonad\fR provides three layout algorithms: tall, wide and fullscreen. In tall or wide mode, windows are tiled and arranged to prevent overlap and maximize screen use. Sets of windows are grouped together on virtual screens, and each screen retains its own layout, which may be reconfigured dynamically. Multiple physical monitors are supported via Xinerama, allowing simultaneous display of a number of screens.
.PP
By utilising the expressivity of a modern functional language with a rich static type system, \fBxmonad\fR provides a complete, featureful window manager in less than 1200 lines of code, with an emphasis on correctness and robustness. Internal properties of the window manager are checked using a combination of static guarantees provided by the type system, and type-based automated testing. A benefit of this is that the code is simple to understand, and easy to modify.
By utilizing the expressivity of a modern functional language with a rich static type system, \fBxmonad\fR provides a complete, featureful window manager in less than 1200 lines of code, with an emphasis on correctness and robustness. Internal properties of the window manager are checked using a combination of static guarantees provided by the type system, and type-based automated testing. A benefit of this is that the code is simple to understand, and easy to modify.
.SH USAGE
.PP
\fBxmonad\fR places each window into a "workspace". Each workspace can have any number of windows, which you can cycle though with mod-j and mod-k. Windows are either displayed full screen, tiled horizontally, or tiled vertically. You can toggle the layout mode with mod-space, which will cycle through the available modes.
@@ -23,6 +25,8 @@ When running with multiple monitors (Xinerama), each screen has exactly 1 worksp
.TP
\fB--recompile
Recompiles your configuration in ~/.xmonad/xmonad.hs
\fB--restart
Causes the currently running xmonad process to restart
.TP
\fB--version
Display version of \fBxmonad\fR.
@@ -31,10 +35,23 @@ ___KEYBINDINGS___
.SH EXAMPLES
To use \fBxmonad\fR as your window manager add:
.RS
xmonad
exec xmonad
.RE
to your \fI~/.xinitrc\fR file
.SH CUSTOMIZATION
\fBxmonad\fR is customized in ~/.xmonad/xmonad.hs, and then restarting with mod-q.
.PP
You can find many extensions to the core feature set in the xmonad-contrib package, available through your package manager or from http://xmonad.org/.
.SS "Modular Configuration"
As of \fBxmonad-0.9\fR, any additional Haskell modules may be placed in \fI~/.xmonad/lib/\fR are available in GHC's searchpath. Hierarchical modules are supported: for example, the file \fI~/.xmonad/lib/XMonad/Stack/MyAdditions.hs\fR could contain:
.RS
.nf
module XMonad.Stack.MyAdditions (function1) where
function1 = error "function1: Not implemented yet!"
.fi
.RE
.PP
Your xmonad.hs may then \fBimport XMonad.Stack.MyAdditions\fR as if that module was contained within \fBxmonad\fR or \fBxmonad-contrib\fR.
.SH BUGS
Probably. If you find any, please report them: http://code.google.com/p/xmonad/issues/list

View File

@@ -8,6 +8,7 @@
--
import XMonad
import Data.Monoid
import System.Exit
import qualified XMonad.StackSet as W
@@ -18,6 +19,10 @@ import qualified Data.Map as M
--
myTerminal = "xterm"
-- Whether focus follows the mouse pointer.
myFocusFollowsMouse :: Bool
myFocusFollowsMouse = True
-- Width of the window border in pixels.
--
myBorderWidth = 1
@@ -60,92 +65,79 @@ myWorkspaces = ["1","2","3","4","5","6","7","8","9"]
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 $
myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList $
-- launch a terminal
[ ((modMask .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf)
[ ((modm .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf)
-- launch dmenu
, ((modMask, xK_p ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"")
, ((modm, xK_p ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"")
-- launch gmrun
, ((modMask .|. shiftMask, xK_p ), spawn "gmrun")
, ((modm .|. shiftMask, xK_p ), spawn "gmrun")
-- close focused window
, ((modMask .|. shiftMask, xK_c ), kill)
-- close focused window
, ((modm .|. shiftMask, xK_c ), kill)
-- Rotate through the available layout algorithms
, ((modMask, xK_space ), sendMessage NextLayout)
, ((modm, xK_space ), sendMessage NextLayout)
-- Reset the layouts on the current workspace to default
, ((modMask .|. shiftMask, xK_space ), setLayout $ XMonad.layoutHook conf)
, ((modm .|. shiftMask, xK_space ), setLayout $ XMonad.layoutHook conf)
-- Resize viewed windows to the correct size
, ((modMask, xK_n ), refresh)
, ((modm, xK_n ), refresh)
-- Move focus to the next window
, ((modMask, xK_Tab ), windows W.focusDown)
, ((modm, xK_Tab ), windows W.focusDown)
-- Move focus to the next window
, ((modMask, xK_j ), windows W.focusDown)
, ((modm, xK_j ), windows W.focusDown)
-- Move focus to the previous window
, ((modMask, xK_k ), windows W.focusUp )
, ((modm, xK_k ), windows W.focusUp )
-- Move focus to the master window
, ((modMask, xK_m ), windows W.focusMaster )
, ((modm, xK_m ), windows W.focusMaster )
-- Swap the focused window and the master window
, ((modMask, xK_Return), windows W.swapMaster)
, ((modm, xK_Return), windows W.swapMaster)
-- Swap the focused window with the next window
, ((modMask .|. shiftMask, xK_j ), windows W.swapDown )
, ((modm .|. shiftMask, xK_j ), windows W.swapDown )
-- Swap the focused window with the previous window
, ((modMask .|. shiftMask, xK_k ), windows W.swapUp )
, ((modm .|. shiftMask, xK_k ), windows W.swapUp )
-- Shrink the master area
, ((modMask, xK_h ), sendMessage Shrink)
, ((modm, xK_h ), sendMessage Shrink)
-- Expand the master area
, ((modMask, xK_l ), sendMessage Expand)
, ((modm, xK_l ), sendMessage Expand)
-- Push window back into tiling
, ((modMask, xK_t ), withFocused $ windows . W.sink)
, ((modm, xK_t ), withFocused $ windows . W.sink)
-- Increment the number of windows in the master area
, ((modMask , xK_comma ), sendMessage (IncMasterN 1))
, ((modm , xK_comma ), sendMessage (IncMasterN 1))
-- Deincrement the number of windows in the master area
, ((modMask , xK_period), sendMessage (IncMasterN (-1)))
, ((modm , 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))
-- Toggle the status bar gap
-- Use this binding with avoidStruts from Hooks.ManageDocks.
-- See also the statusBar function from Hooks.DynamicLog.
--
-- , ((modm , xK_b ), sendMessage ToggleStruts)
-- Quit xmonad
, ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess))
, ((modm .|. shiftMask, xK_q ), io (exitWith ExitSuccess))
-- Restart xmonad
, ((modMask , xK_q ), restart "xmonad" True)
, ((modm , xK_q ), spawn "xmonad --recompile; xmonad --restart")
]
++
@@ -153,7 +145,7 @@ myKeys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
-- mod-[1..9], Switch to workspace N
-- mod-shift-[1..9], Move client to workspace N
--
[((m .|. modMask, k), windows $ f i)
[((m .|. modm, k), windows $ f i)
| (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]
, (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
++
@@ -162,7 +154,7 @@ myKeys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
-- 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))
[((m .|. modm, 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)]]
@@ -170,16 +162,18 @@ myKeys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
------------------------------------------------------------------------
-- Mouse bindings: default actions bound to mouse events
--
myMouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList $
myMouseBindings (XConfig {XMonad.modMask = modm}) = M.fromList $
-- mod-button1, Set the window to floating mode and move by dragging
[ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w))
[ ((modm, button1), (\w -> focus w >> mouseMoveWindow w
>> windows W.shiftMaster))
-- mod-button2, Raise the window to the top of the stack
, ((modMask, button2), (\w -> focus w >> windows W.swapMaster))
, ((modm, button2), (\w -> focus w >> windows W.shiftMaster))
-- mod-button3, Set the window to floating mode and resize by dragging
, ((modMask, button3), (\w -> focus w >> mouseResizeWindow w))
, ((modm, button3), (\w -> focus w >> mouseResizeWindow w
>> windows W.shiftMaster))
-- you may also bind events to the mouse scroll wheel (button4 and button5)
]
@@ -230,10 +224,16 @@ myManageHook = composeAll
, resource =? "desktop_window" --> doIgnore
, resource =? "kdesktop" --> doIgnore ]
-- Whether focus follows the mouse pointer.
myFocusFollowsMouse :: Bool
myFocusFollowsMouse = True
------------------------------------------------------------------------
-- Event handling
-- * EwmhDesktops users should change this to ewmhDesktopsEventHook
--
-- Defines a custom handler function for X Events. The function should
-- return (All True) if the default handler is to be run afterwards. To
-- combine event hooks use mappend or mconcat from Data.Monoid.
--
myEventHook = mempty
------------------------------------------------------------------------
-- Status bars and logging
@@ -265,9 +265,9 @@ myStartupHook = return ()
main = xmonad defaults
-- A structure containing your configuration settings, overriding
-- fields in the default config. Any you don't override, will
-- 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 {
@@ -280,7 +280,6 @@ defaults = defaultConfig {
workspaces = myWorkspaces,
normalBorderColor = myNormalBorderColor,
focusedBorderColor = myFocusedBorderColor,
defaultGaps = myDefaultGaps,
-- key bindings
keys = myKeys,
@@ -289,6 +288,7 @@ defaults = defaultConfig {
-- hooks, layouts
layoutHook = myLayout,
manageHook = myManageHook,
handleEventHook = myEventHook,
logHook = myLogHook,
startupHook = myStartupHook
}

View File

@@ -378,6 +378,9 @@ prop_findIndex (x :: T) =
prop_allWindowsMember w (x :: T) = (w `elem` allWindows x) ==> member w x
prop_currentTag (x :: T) =
currentTag x == tag (workspace (current x))
-- ---------------------------------------------------------------------
-- 'insert'
@@ -525,6 +528,18 @@ prop_shift_reversible i (x :: T) =
y = swapMaster x
n = tag (workspace $ current y)
------------------------------------------------------------------------
-- shiftMaster
-- focus/local/idempotent same as swapMaster:
prop_shift_master_focus (x :: T) = peek x == (peek $ shiftMaster x)
prop_shift_master_local (x :: T) = hidden_spaces x == hidden_spaces (shiftMaster x)
prop_shift_master_idempotent (x :: T) = shiftMaster (shiftMaster x) == shiftMaster x
-- ordering is constant modulo the focused window:
prop_shift_master_ordering (x :: T) = case peek x of
Nothing -> True
Just m -> L.delete m (index x) == L.delete m (index $ shiftMaster x)
-- ---------------------------------------------------------------------
-- shiftWin
@@ -895,6 +910,7 @@ main = do
,("findTag" , mytest prop_findIndex)
,("allWindows/member" , mytest prop_allWindowsMember)
,("currentTag" , mytest prop_currentTag)
,("insert: invariant" , mytest prop_insertUp_I)
,("insert/new" , mytest prop_insert_empty)
@@ -929,6 +945,11 @@ main = do
,("swapUp is local" , mytest prop_swap_left_local)
,("swapDown is local" , mytest prop_swap_right_local)
,("shiftMaster id on focus", mytest prop_shift_master_focus)
,("shiftMaster is local", mytest prop_shift_master_local)
,("shiftMaster is idempotent", mytest prop_shift_master_idempotent)
,("shiftMaster preserves ordering", mytest prop_shift_master_ordering)
,("shift: invariant" , mytest prop_shift_I)
,("shift is reversible" , mytest prop_shift_reversible)
,("shiftWin: invariant" , mytest prop_shift_win_I)

View File

@@ -20,6 +20,13 @@ import Text.Regex.Posix
import Data.Char
import Data.List
import Distribution.PackageDescription.Parse
import Distribution.Verbosity
import Distribution.Package
import Distribution.PackageDescription
import Text.PrettyPrint.HughesPJ
import Distribution.Text
trim :: String -> String
trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
@@ -42,6 +49,9 @@ replace :: Eq a => a -> a -> [a] -> [a]
replace x y = map (\a -> if a == x then y else a)
main = do
releaseName <- ((' ':) . (++" \\") . show . disp . package . packageDescription) `liftM` readPackageDescription normal "xmonad.cabal"
troffBindings <- (concatMap troff . allBindings) `liftM` readFile "./XMonad/Config.hs"
let sed = unlines . replace "___KEYBINDINGS___" troffBindings . lines
let sed = unlines . replace "___RELEASE___\\" releaseName . replace "___KEYBINDINGS___" troffBindings . lines
readFile "./man/xmonad.1.in" >>= return . sed >>= writeFile "./man/xmonad.1"

View File

@@ -1,5 +1,5 @@
name: xmonad
version: 0.7
version: 0.9
homepage: http://xmonad.org
synopsis: A tiling window manager
description:
@@ -18,11 +18,13 @@ license-file: LICENSE
author: Spencer Janssen
maintainer: xmonad@haskell.org
extra-source-files: README TODO CONFIG STYLE tests/loc.hs tests/Properties.hs
man/xmonad.1.in man/xmonad.1 man/xmonad.html man/xmonad.hs
man/xmonad.1.in man/xmonad.1 man/xmonad.html
util/GenerateManpage.hs
cabal-version: >= 1.2
build-type: Simple
data-files: man/xmonad.hs
flag small_base
description: Choose the new smaller, split-up base package.
@@ -41,12 +43,12 @@ library
XMonad.StackSet
if flag(small_base)
build-depends: base >= 3, containers, directory, process
build-depends: base < 4 && >=3, containers, directory, process, filepath
else
build-depends: base < 3
build-depends: X11>=1.4.1, mtl, unix
build-depends: X11>=1.4.6.1, mtl, unix
ghc-options: -funbox-strict-fields -Wall -optl-Wl,-s
ghc-options: -funbox-strict-fields -Wall
ghc-prof-options: -prof -auto-all
extensions: CPP
@@ -64,7 +66,7 @@ executable xmonad
XMonad.Operations
XMonad.StackSet
ghc-options: -funbox-strict-fields -Wall -optl-Wl,-s
ghc-options: -funbox-strict-fields -Wall
ghc-prof-options: -prof -auto-all
extensions: CPP