38 Commits

Author SHA1 Message Date
Adam Vogt
4be3b39cd2 Assume locale is utf8 for spawn.
This adds the utf8-string dependency so that users no longer need to encode
strings they (possibly indirectly) pass to spawn. This is the expected
behavior, since each Char in String should be an actual character.

For systems that do not use utf8 this does not help. Fixing this by using iconv
or similar libraries may be done later.
2011-11-18 18:29:20 +00:00
Adam Vogt
75889ab62e Correct recompile keybinding (issue 126)
Thanks reenberg for pointing out the previous patch incorrectly warns about a
missing xmonad when the config has an error.

Also changed is "type" which as a shell builtin is more likely to exist than
"which".
2011-11-17 04:25:22 +00:00
Adam Vogt
792add376e Warn with xmessage when xmonad cannot be found for recompile (issue 126) 2010-03-30 00:33:10 +00:00
Daniel Wagner
87c50a911f change the default mod+p binding to keep up with changes to dmenu 2011-10-13 16:25:09 +00:00
Daniel Wagner
d16aa9975e recognize the --replace option 2011-08-09 19:52:50 +00:00
Adam Vogt
f34642cbac Break a long line 2011-06-09 04:24:24 +00:00
Jens Petersen
008c3638a5 output error code when xmonad.hs compile fails without any error output
Currently if there is no ghc on the path say for some reason,
xmonad.error is empty.  This patch makes
it output the exitcode code when the compile process fails
without any error output.  (It might be easier just to spawn
a shell to get "ghc: command not found" output for free.)
2011-04-26 06:23:41 +00:00
Adam Vogt
f5c40e9e12 Remove -fglasgow-exts for deriving Data/Typeable needed with ghc-6.6
This gets rid of a warning with ghc-7.0.2, and -XDeriveDataTypeable seems to
have been added with 6.8, which should be far back enough:
http://www.haskell.org/ghc/docs/6.8-latest/html/users_guide/deriving.html#deriving-typeable
2011-06-08 23:04:15 +00:00
Adam Vogt
bd82cc9150 Expose instances to haddock
While haddock may have choked on -XGeneralizedNewtypeDeriving before, this is
no longer the case. Also this doesn't change the results with a recent haddock
(2.9.2)
2011-06-08 22:56:13 +00:00
Adam Vogt
a025912ab7 Haddock formatting for a type (-->) 2011-05-24 01:51:35 +00:00
Brandon S Allbery KF8NH
19c1759b35 Generalize types of ManageHook functions, so they can be reused 2011-02-24 00:30:21 +00:00
gwern0
92acd1eb74 HCAR.tex: update per Janis's final version 2011-05-22 18:37:55 +00:00
gwern0
db9f39d6af HCAR.text: mention 2 features added since last HCAR
Prompted by Janis's usual request for updated HCARs
2011-04-11 16:45:19 +00:00
Adam Vogt
ebcd67efac Correct misleading documentation on Stack (thanks sdrodge)
`Possibly empty' applies only to `Maybe (Stack a)', not `Stack a' described
there, so this is easier to understand.
2011-03-28 00:19:30 +00:00
gwern0
387a253f62 HCAR.tex: apply Janis Voigtlaender's HCAR changes 2010-11-09 20:50:22 +00:00
Adam Vogt
4c83e8e097 Bump version to 0.10
This doesn't mean it's ready for this number release, but at least
contrib/core incompatibilities introduced since 0.9 will be avoided.
2011-01-15 18:07:15 +00:00
Adam Vogt
ae59a5184f Update util/GenerateManpage for pandoc 1.6 2010-12-31 16:31:18 +00:00
Adam Vogt
fa8fe9aca4 Update util/GenerateManpage to be pandoc-1.4 compatible 2010-04-03 18:13:54 +00:00
gwern0
673c3e9ed9 HCAR.tex: update from May
- there were no significant changes to xmonad-core
- description of 2 new modules not mentioned in HCAR
2010-10-12 01:09:15 +00:00
Adam Vogt
6ba45cdb38 Update comments describing `recompile' 2010-04-03 18:11:15 +00:00
Adam Vogt
b995b430bc Note things to update each release. 2010-03-22 15:06:22 +00:00
gwern0
ba482a4611 XMonad.Core: escape slashes, ln module 2010-06-20 17:57:41 +00:00
Tomas Janousek
684907bc77 fix haddock comment being assigned to constructor instead of field 2010-04-15 17:39:36 +00:00
gwern0
ad4136df26 HCAr.tex: update with additions and versions 2010-05-02 20:13:21 +00:00
gwern0
defe0c282e +original HCAR entry 2010-05-02 20:02:52 +00:00
Spencer Janssen
c7bdac1a7e Less refreshing in mouse-2 binding (thanks aavogt) 2010-05-03 15:50:17 +00:00
Daniel Schoepe
17799f131a Replaced custom forever_ by library function 2009-01-14 21:55:56 +00:00
Tomas Janousek
8cd66aa380 reveal: don't insert non-clients into the set of mapped windows
In xmonad-core, this fixes a small bug that caused doIgnored windows to get
into `mapped' and never being removed from there.

In the context of xmonad-contrib, this fixes a tremendous memory leak that
could be triggered by using MouseResizableTile and UrgencyHook at the same
time. MRT would create dummy windows that would get added to `mapped' by the
reveal call in `windows'. As these were not removed (removal from `mapped' is
filtered by `isClient'), they'd stay there forever and due to an inefficiency
in UrgencyHook would eat up all memory sooner or later.
2010-03-27 21:42:43 +00:00
gwern0
32ba0d4a0d loc.hs: hlintify 2010-02-13 23:15:37 +00:00
Spencer Janssen
77b3f62610 Various clean-ups suggested by HLint 2010-02-14 02:57:50 +00:00
Spencer Janssen
f3b07eb5dc Make the --replace docs consistent 2010-02-13 00:26:47 +00:00
Adam Vogt
4372c256ed Add --replace flag with documentation (issue 99). 2009-12-20 18:35:29 +00:00
Adam Vogt
34239a79de Fix compile error when using base-3 (thanks bogner). 2010-02-11 06:39:38 +00:00
Daniel Schoepe
5866db4f0f Broadcast PropertyChange events (needed for layouts with decoration) 2010-01-13 20:40:17 +00:00
Adam Vogt
46d039cde5 Rename numlockMask to numberlockMask to help users of the template config.
Without the change, the errors are like:

>     [ unrelated error messages ]
>     No constructor has all these fields: `numlockMask',
>       `terminal', [every other field set]

With the change:

>     `numlockMask' is not a record selector
>     [ context where numlockMask is named ]
2010-01-18 16:22:56 +00:00
Adam Vogt
dd22717961 Correct warnings with ghc-6.12
Changes include:
  - compatibility with base-4 or 3 (base-2 untested) by using
    extensible-exceptions. This adds an additional dependency for users of
    ghc<6.10)
  - list all dependencies again when -ftesting (change in Cabal-1.8.0.2)
  - remove unnecessary imports
  - suppress -fwarn-unused-do-bind, with appropriate Cabal-1.8 workaround,
    described here:
    http://www.haskell.org/pipermail/xmonad/2010-January/009554.html
2010-01-18 18:15:32 +00:00
Spencer Janssen
0beeb4164b Add xfork: a forkProcess that works around process global state 2009-12-23 06:16:23 +00:00
Spencer Janssen
0b435028ff TAG 0.9.1 2009-12-16 23:36:43 +00:00
15 changed files with 222 additions and 92 deletions

View File

@@ -17,7 +17,6 @@ module Main (main) where
import XMonad import XMonad
import Control.Monad (unless) import Control.Monad (unless)
import System.IO
import System.Info import System.Info
import System.Environment import System.Environment
import System.Posix.Process (executeFile) import System.Posix.Process (executeFile)
@@ -44,6 +43,7 @@ main = do
("--resume":_) -> launch ("--resume":_) -> launch
["--help"] -> usage ["--help"] -> usage
["--recompile"] -> recompile True >>= flip unless exitFailure ["--recompile"] -> recompile True >>= flip unless exitFailure
["--replace"] -> launch
["--restart"] -> sendRestart >> return () ["--restart"] -> sendRestart >> return ()
["--version"] -> putStrLn $ unwords shortVersion ["--version"] -> putStrLn $ unwords shortVersion
["--verbose-version"] -> putStrLn . unwords $ shortVersion ++ longVersion ["--verbose-version"] -> putStrLn . unwords $ shortVersion ++ longVersion
@@ -66,6 +66,7 @@ usage = do
" --help Print this message" : " --help Print this message" :
" --version Print the version number" : " --version Print the version number" :
" --recompile Recompile your ~/.xmonad/xmonad.hs" : " --recompile Recompile your ~/.xmonad/xmonad.hs" :
" --replace Replace the running window manager with xmonad" :
" --restart Request a running xmonad process to restart" : " --restart Request a running xmonad process to restart" :
#ifdef TESTING #ifdef TESTING
" --run-tests Run the test suite" : " --run-tests Run the test suite" :

2
TODO
View File

@@ -16,6 +16,8 @@
* test core with 6.6 and 6.8 * test core with 6.6 and 6.8
* bump xmonad.cabal version and X11 version * bump xmonad.cabal version and X11 version
* upload X11 and xmonad to Hackage * upload X11 and xmonad to Hackage
* update links to hackage in download.html
* update #xmonad topic
* check examples/text in user-facing Config.hs * check examples/text in user-facing Config.hs
* check tour.html and intro.html are up to date, and mention all core bindings * check tour.html and intro.html are up to date, and mention all core bindings
* confirm template config is type correct * confirm template config is type correct

View File

@@ -165,7 +165,7 @@ keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
-- launching and killing programs -- launching and killing programs
[ ((modMask .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal [ ((modMask .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal
, ((modMask, xK_p ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu , ((modMask, xK_p ), spawn "dmenu_run") -- %! Launch dmenu
, ((modMask .|. shiftMask, xK_p ), spawn "gmrun") -- %! Launch gmrun , ((modMask .|. shiftMask, xK_p ), spawn "gmrun") -- %! Launch gmrun
, ((modMask .|. shiftMask, xK_c ), kill) -- %! Close the focused window , ((modMask .|. shiftMask, xK_c ), kill) -- %! Close the focused window
@@ -202,7 +202,7 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
-- quit, or restart -- quit, or restart
, ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit xmonad , ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit xmonad
, ((modMask , xK_q ), spawn "xmonad --recompile && xmonad --restart") -- %! Restart xmonad , ((modMask , xK_q ), spawn "if type xmonad; then xmonad --recompile && xmonad --restart; else xmessage xmonad not in \\$PATH: \"$PATH\"; fi") -- %! Restart xmonad
] ]
++ ++
-- mod-[1..9] %! Switch to workspace N -- mod-[1..9] %! Switch to workspace N
@@ -220,15 +220,15 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
-- | Mouse bindings: default actions bound to mouse events -- | Mouse bindings: default actions bound to mouse events
-- --
mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
mouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList $ mouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList
-- mod-button1 %! Set the window to floating mode and move by dragging -- mod-button1 %! Set the window to floating mode and move by dragging
[ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w [ ((modMask, button1), \w -> focus w >> mouseMoveWindow w
>> windows W.shiftMaster)) >> windows W.shiftMaster)
-- mod-button2 %! Raise the window to the top of the stack -- mod-button2 %! Raise the window to the top of the stack
, ((modMask, button2), (\w -> focus w >> windows W.shiftMaster)) , ((modMask, button2), windows . (W.shiftMaster .) . W.focusWindow)
-- mod-button3 %! Set the window to floating mode and resize by dragging -- mod-button3 %! Set the window to floating mode and resize by dragging
, ((modMask, button3), (\w -> focus w >> mouseResizeWindow w , ((modMask, button3), \w -> focus w >> mouseResizeWindow w
>> windows W.shiftMaster)) >> windows W.shiftMaster)
-- you may also bind events to the mouse scroll wheel (button4 and button5) -- you may also bind events to the mouse scroll wheel (button4 and button5)
] ]
@@ -248,4 +248,4 @@ defaultConfig = XConfig
, XMonad.manageHook = manageHook , XMonad.manageHook = manageHook
, XMonad.handleEventHook = handleEventHook , XMonad.handleEventHook = handleEventHook
, XMonad.focusFollowsMouse = focusFollowsMouse , XMonad.focusFollowsMouse = focusFollowsMouse
} }

View File

@@ -1,7 +1,5 @@
{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving, {-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving,
MultiParamTypeClasses, TypeSynonymInstances, CPP #-} MultiParamTypeClasses, TypeSynonymInstances, CPP, DeriveDataTypeable #-}
-- required for deriving Typeable
{-# OPTIONS_GHC -fglasgow-exts #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
@@ -27,14 +25,15 @@ module XMonad.Core (
StateExtension(..), ExtensionClass(..), StateExtension(..), ExtensionClass(..),
runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers, runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,
withDisplay, withWindowSet, isRoot, runOnWorkspaces, withDisplay, withWindowSet, isRoot, runOnWorkspaces,
getAtom, spawn, spawnPID, getXMonadDir, recompile, trace, whenJust, whenX, getAtom, spawn, spawnPID, xfork, getXMonadDir, recompile, trace, whenJust, whenX,
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, ManageHook, Query(..), runQuery atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, ManageHook, Query(..), runQuery
) where ) where
import XMonad.StackSet hiding (modify) import XMonad.StackSet hiding (modify)
import Prelude hiding ( catch ) import Prelude hiding ( catch )
import Control.Exception (catch, try, bracket, throw, finally, Exception(ExitException)) import Codec.Binary.UTF8.String (encodeString)
import Control.Exception.Extensible (catch, fromException, try, bracket, throw, finally, SomeException(..))
import Control.Applicative import Control.Applicative
import Control.Monad.State import Control.Monad.State
import Control.Monad.Reader import Control.Monad.Reader
@@ -64,11 +63,11 @@ data XState = XState
, mapped :: !(S.Set Window) -- ^ the Set of mapped windows , mapped :: !(S.Set Window) -- ^ the Set of mapped windows
, waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents , waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents
, dragging :: !(Maybe (Position -> Position -> X (), X ())) , dragging :: !(Maybe (Position -> Position -> X (), X ()))
, numlockMask :: !KeyMask -- ^ The numlock modifier , numberlockMask :: !KeyMask -- ^ The numlock modifier
, extensibleState :: !(M.Map String (Either String StateExtension)) , extensibleState :: !(M.Map String (Either String StateExtension))
-- ^ stores custom state information. -- ^ stores custom state information.
-- --
-- The module XMonad.Utils.ExtensibleState in xmonad-contrib -- The module "XMonad.Utils.ExtensibleState" in xmonad-contrib
-- provides additional information and a simple interface for using this. -- provides additional information and a simple interface for using this.
} }
@@ -135,9 +134,7 @@ data ScreenDetail = SD { screenRect :: !Rectangle } deriving (Eq,Show, Read)
-- instantiated on 'XConf' and 'XState' automatically. -- instantiated on 'XConf' and 'XState' automatically.
-- --
newtype X a = X (ReaderT XConf (StateT XState IO) a) newtype X a = X (ReaderT XConf (StateT XState IO) a)
#ifndef __HADDOCK__
deriving (Functor, Monad, MonadIO, MonadState XState, MonadReader XConf, Typeable) deriving (Functor, Monad, MonadIO, MonadState XState, MonadReader XConf, Typeable)
#endif
instance Applicative X where instance Applicative X where
pure = return pure = return
@@ -149,9 +146,7 @@ instance (Monoid a) => Monoid (X a) where
type ManageHook = Query (Endo WindowSet) type ManageHook = Query (Endo WindowSet)
newtype Query a = Query (ReaderT Window X a) newtype Query a = Query (ReaderT Window X a)
#ifndef __HADDOCK__
deriving (Functor, Monad, MonadReader Window, MonadIO) deriving (Functor, Monad, MonadReader Window, MonadIO)
#endif
runQuery :: Query a -> Window -> X a runQuery :: Query a -> Window -> X a
runQuery (Query m) w = runReaderT m w runQuery (Query m) w = runReaderT m w
@@ -171,9 +166,9 @@ catchX :: X a -> X a -> X a
catchX job errcase = do catchX job errcase = do
st <- get st <- get
c <- ask c <- ask
(a, s') <- io $ runX c st job `catch` \e -> case e of (a, s') <- io $ runX c st job `catch` \e -> case fromException e of
ExitException {} -> throw e Just x -> throw e `const` (x `asTypeOf` ExitSuccess)
_ -> do hPrint stderr e; runX c st errcase _ -> do hPrint stderr e; runX c st errcase
put s' put s'
return a return a
@@ -386,19 +381,25 @@ 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. -- exception, log the exception to stderr and continue normal execution.
catchIO :: MonadIO m => IO () -> m () catchIO :: MonadIO m => IO () -> m ()
catchIO f = io (f `catch` \e -> hPrint stderr e >> hFlush stderr) catchIO f = io (f `catch` \(SomeException e) -> hPrint stderr e >> hFlush stderr)
-- | spawn. Launch an external application. Specifically, it double-forks and -- | spawn. Launch an external application. Specifically, it double-forks and
-- runs the 'String' you pass as a command to /bin/sh. -- runs the 'String' you pass as a command to \/bin\/sh.
--
-- Note this function assumes your locale uses utf8.
spawn :: MonadIO m => String -> m () spawn :: MonadIO m => String -> m ()
spawn x = spawnPID x >> return () spawn x = spawnPID x >> return ()
-- | Like 'spawn', but returns the 'ProcessID' of the launched application -- | Like 'spawn', but returns the 'ProcessID' of the launched application
spawnPID :: MonadIO m => String -> m ProcessID spawnPID :: MonadIO m => String -> m ProcessID
spawnPID x = io . forkProcess . finally nullStdin $ do spawnPID x = xfork $ executeFile "/bin/sh" False ["-c", encodeString x] Nothing
-- | A replacement for 'forkProcess' which resets default signal handlers.
xfork :: MonadIO m => IO () -> m ProcessID
xfork x = io . forkProcess . finally nullStdin $ do
uninstallSignalHandlers uninstallSignalHandlers
createSession createSession
executeFile "/bin/sh" False ["-c", x] Nothing x
where where
nullStdin = do nullStdin = do
fd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags fd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
@@ -426,9 +427,11 @@ getXMonadDir = io $ getAppUserDataDirectory "xmonad"
-- --
-- * the xmonad executable does not exist -- * the xmonad executable does not exist
-- --
-- * the xmonad executable is older than xmonad.hs -- * the xmonad executable is older than xmonad.hs or any file in
-- ~\/.xmonad\/lib
-- --
-- The -i flag is used to restrict recompilation to the xmonad.hs file only. -- The -i flag is used to restrict recompilation to the xmonad.hs file only,
-- and any files in the ~\/.xmonad\/lib directory.
-- --
-- Compilation errors (if any) are logged to ~\/.xmonad\/xmonad.errors. If -- Compilation errors (if any) are logged to ~\/.xmonad\/xmonad.errors. If
-- GHC indicates failure with a non-zero exit code, an xmessage displaying -- GHC indicates failure with a non-zero exit code, an xmessage displaying
@@ -452,7 +455,7 @@ recompile force = io $ do
then do then do
-- temporarily disable SIGCHLD ignoring: -- temporarily disable SIGCHLD ignoring:
uninstallSignalHandlers uninstallSignalHandlers
status <- bracket (openFile err WriteMode) hClose $ \h -> do status <- bracket (openFile err WriteMode) hClose $ \h ->
waitForProcess =<< runProcess "ghc" ["--make", "xmonad.hs", "-i", "-ilib", "-fforce-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) Nothing Nothing Nothing (Just h)
@@ -464,7 +467,8 @@ recompile force = io $ do
ghcErr <- readFile err ghcErr <- readFile err
let msg = unlines $ let msg = unlines $
["Error detected while loading xmonad configuration file: " ++ src] ["Error detected while loading xmonad configuration file: " ++ src]
++ lines ghcErr ++ ["","Please check the file for errors."] ++ lines (if null ghcErr then show status else ghcErr)
++ ["","Please check the file for errors."]
-- nb, the ordering of printing, then forking, is crucial due to -- nb, the ordering of printing, then forking, is crucial due to
-- lazy evaluation -- lazy evaluation
hPutStrLn stderr msg hPutStrLn stderr msg
@@ -472,11 +476,11 @@ recompile force = io $ do
return () return ()
return (status == ExitSuccess) return (status == ExitSuccess)
else return True else return True
where getModTime f = catch (Just <$> getModificationTime f) (const $ return Nothing) where getModTime f = catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing)
isSource = flip elem [".hs",".lhs",".hsc"] isSource = flip elem [".hs",".lhs",".hsc"]
allFiles t = do allFiles t = do
let prep = map (t</>) . Prelude.filter (`notElem` [".",".."]) let prep = map (t</>) . Prelude.filter (`notElem` [".",".."])
cs <- prep <$> catch (getDirectoryContents t) (\_ -> return []) cs <- prep <$> catch (getDirectoryContents t) (\(SomeException _) -> return [])
ds <- filterM doesDirectoryExist cs ds <- filterM doesDirectoryExist cs
concat . ((cs \\ ds):) <$> mapM allFiles ds concat . ((cs \\ ds):) <$> mapM allFiles ds
@@ -499,7 +503,8 @@ installSignalHandlers :: MonadIO m => m ()
installSignalHandlers = io $ do installSignalHandlers = io $ do
installHandler openEndedPipe Ignore Nothing installHandler openEndedPipe Ignore Nothing
installHandler sigCHLD Ignore Nothing installHandler sigCHLD Ignore Nothing
try $ fix $ \more -> do (try :: IO a -> IO (Either SomeException a))
$ fix $ \more -> do
x <- getAnyProcessStatus False False x <- getAnyProcessStatus False False
when (isJust x) more when (isJust x) more
return () return ()

View File

@@ -1,5 +1,4 @@
{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances, DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
-- -------------------------------------------------------------------------- -- --------------------------------------------------------------------------
-- | -- |
@@ -53,7 +52,8 @@ instance LayoutClass Full a
-- 'IncMasterN'. -- 'IncMasterN'.
data Tall a = Tall { tallNMaster :: !Int -- ^ The default number of windows in the master pane (default: 1) 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) , 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) , tallRatio :: !Rational -- ^ Default proportion of screen occupied by master pane (default: 1/2)
}
deriving (Show, Read) deriving (Show, Read)
-- TODO should be capped [0..1] .. -- TODO should be capped [0..1] ..
@@ -125,7 +125,7 @@ instance LayoutClass l a => LayoutClass (Mirror l) a where
-- | Mirror a rectangle. -- | Mirror a rectangle.
mirrorRect :: Rectangle -> Rectangle mirrorRect :: Rectangle -> Rectangle
mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw) mirrorRect (Rectangle rx ry rw rh) = Rectangle ry rx rh rw
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- LayoutClass selection manager -- LayoutClass selection manager
@@ -173,7 +173,7 @@ choose (Choose d l r) d' ml mr = f lr
instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where
runLayout (W.Workspace i (Choose L l r) ms) = runLayout (W.Workspace i (Choose L l r) ms) =
fmap (second . fmap $ flip (Choose L) $ r) . runLayout (W.Workspace i l ms) fmap (second . fmap $ flip (Choose L) r) . runLayout (W.Workspace i l ms)
runLayout (W.Workspace i (Choose R l r) ms) = runLayout (W.Workspace i (Choose R l r) ms) =
fmap (second . fmap $ Choose R l) . runLayout (W.Workspace i r ms) fmap (second . fmap $ Choose R l) . runLayout (W.Workspace i r ms)
@@ -194,7 +194,7 @@ instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where
R -> choose c R Nothing =<< handle r NextNoWrap R -> choose c R Nothing =<< handle r NextNoWrap
handleMessage c@(Choose _ l _) m | Just FirstLayout <- fromMessage m = do handleMessage c@(Choose _ l _) m | Just FirstLayout <- fromMessage m =
flip (choose c L) Nothing =<< handle l FirstLayout flip (choose c L) Nothing =<< handle l FirstLayout
handleMessage c@(Choose d l r) m | Just ReleaseResources <- fromMessage m = handleMessage c@(Choose d l r) m | Just ReleaseResources <- fromMessage m =

View File

@@ -18,6 +18,7 @@ module XMonad.Main (xmonad) where
import Control.Arrow (second) import Control.Arrow (second)
import Data.Bits import Data.Bits
import Data.List ((\\)) import Data.List ((\\))
import Data.Function
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
import Control.Monad.Reader import Control.Monad.Reader
@@ -67,6 +68,10 @@ xmonad initxmc = do
rootw <- rootWindow dpy dflt rootw <- rootWindow dpy dflt
args <- getArgs
when ("--replace" `elem` args) $ replace dpy dflt rootw
-- If another WM is running, a BadAccess error will be returned. The -- If another WM is running, a BadAccess error will be returned. The
-- default error handler will write the exception to stderr and exit with -- default error handler will write the exception to stderr and exit with
-- an error. -- an error.
@@ -89,7 +94,6 @@ xmonad initxmc = do
return (fromMaybe fbc_ v) return (fromMaybe fbc_ v)
hSetBuffering stdout NoBuffering hSetBuffering stdout NoBuffering
args <- getArgs
let layout = layoutHook xmc let layout = layoutHook xmc
lreads = readsLayout layout lreads = readsLayout layout
@@ -121,7 +125,7 @@ xmonad initxmc = do
st = XState st = XState
{ windowset = initialWinset { windowset = initialWinset
, numlockMask = 0 , numberlockMask = 0
, mapped = S.empty , mapped = S.empty
, waitingUnmap = M.empty , waitingUnmap = M.empty
, dragging = Nothing , dragging = Nothing
@@ -151,12 +155,10 @@ xmonad initxmc = do
userCode $ startupHook initxmc userCode $ startupHook initxmc
-- main loop, for all you HOF/recursion fans out there. -- main loop, for all you HOF/recursion fans out there.
forever_ $ prehandle =<< io (nextEvent dpy e >> getEvent e) forever $ prehandle =<< io (nextEvent dpy e >> getEvent e)
return () return ()
where where
forever_ a = a >> forever_ a
-- if the event gives us the position of the pointer, set mousePosition -- if the event gives us the position of the pointer, set mousePosition
prehandle e = let mouse = do guard (ev_event_type e `elem` evs) prehandle e = let mouse = do guard (ev_event_type e `elem` evs)
return (fromIntegral (ev_x_root e) return (fromIntegral (ev_x_root e)
@@ -295,8 +297,9 @@ handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
handle (ConfigureEvent {ev_window = w}) = whenX (isRoot w) rescreen handle (ConfigureEvent {ev_window = w}) = whenX (isRoot w) rescreen
-- property notify -- property notify
handle PropertyEvent { ev_event_type = t, ev_atom = a } handle event@(PropertyEvent { ev_event_type = t, ev_atom = a })
| t == propertyNotify && a == wM_NAME = userCodeDef () =<< asks (logHook . config) | t == propertyNotify && a == wM_NAME = asks (logHook . config) >>= userCodeDef () >>
broadcastMessage event
handle e@ClientMessageEvent { ev_message_type = mt } = do handle e@ClientMessageEvent { ev_message_type = mt } = do
a <- getAtom "XMONAD_RESTART" a <- getAtom "XMONAD_RESTART"
@@ -338,7 +341,7 @@ setNumlockMask = do
then return (setBit 0 (fromIntegral m)) then return (setBit 0 (fromIntegral m))
else return (0 :: KeyMask) else return (0 :: KeyMask)
| (m, kcs) <- ms, kc <- kcs, kc /= 0] | (m, kcs) <- ms, kc <- kcs, kc /= 0]
modify (\s -> s { numlockMask = foldr (.|.) 0 xs }) modify (\s -> s { numberlockMask = foldr (.|.) 0 xs })
-- | Grab the keys back -- | Grab the keys back
grabKeys :: X () grabKeys :: X ()
@@ -363,3 +366,36 @@ grabButtons = do
ems <- extraModifiers ems <- extraModifiers
ba <- asks buttonActions ba <- asks buttonActions
mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ ba) mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ ba)
-- | @replace@ to signals compliant window managers to exit.
replace :: Display -> ScreenNumber -> Window -> IO ()
replace dpy dflt rootw = do
-- check for other WM
wmSnAtom <- internAtom dpy ("WM_S" ++ show dflt) False
currentWmSnOwner <- xGetSelectionOwner dpy wmSnAtom
when (currentWmSnOwner /= 0) $ do
-- prepare to receive destroyNotify for old WM
selectInput dpy currentWmSnOwner structureNotifyMask
-- create off-screen window
netWmSnOwner <- allocaSetWindowAttributes $ \attributes -> do
set_override_redirect attributes True
set_event_mask attributes propertyChangeMask
let screen = defaultScreenOfDisplay dpy
visual = defaultVisualOfScreen screen
attrmask = cWOverrideRedirect .|. cWEventMask
createWindow dpy rootw (-100) (-100) 1 1 0 copyFromParent copyFromParent visual attrmask attributes
-- try to acquire wmSnAtom, this should signal the old WM to terminate
xSetSelectionOwner dpy wmSnAtom netWmSnOwner currentTime
-- SKIPPED: check if we acquired the selection
-- SKIPPED: send client message indicating that we are now the WM
-- wait for old WM to go away
fix $ \again -> do
evt <- allocaXEvent $ \event -> do
windowEvent dpy currentWmSnOwner structureNotifyMask event
get_EventType event
when (evt /= destroyNotify) again

View File

@@ -22,7 +22,7 @@ import Prelude hiding (catch)
import XMonad.Core import XMonad.Core
import Graphics.X11.Xlib.Extras import Graphics.X11.Xlib.Extras
import Graphics.X11.Xlib (Display, Window, internAtom, wM_NAME) import Graphics.X11.Xlib (Display, Window, internAtom, wM_NAME)
import Control.Exception (bracket, catch) import Control.Exception.Extensible (bracket, catch, SomeException(..))
import Control.Monad.Reader import Control.Monad.Reader
import Data.Maybe import Data.Maybe
import Data.Monoid import Data.Monoid
@@ -34,22 +34,24 @@ liftX :: X a -> Query a
liftX = Query . lift liftX = Query . lift
-- | The identity hook that returns the WindowSet unchanged. -- | The identity hook that returns the WindowSet unchanged.
idHook :: ManageHook idHook :: Monoid m => m
idHook = doF id idHook = mempty
-- | Infix 'mappend'. Compose two 'ManageHook' from right to left. -- | Infix 'mappend'. Compose two 'ManageHook' from right to left.
(<+>) :: Monoid m => m -> m -> m (<+>) :: Monoid m => m -> m -> m
(<+>) = mappend (<+>) = mappend
-- | Compose the list of 'ManageHook's. -- | Compose the list of 'ManageHook's.
composeAll :: [ManageHook] -> ManageHook composeAll :: Monoid m => [m] -> m
composeAll = mconcat composeAll = mconcat
infix 0 --> infix 0 -->
-- | @p --> x@. If @p@ returns 'True', execute the 'ManageHook'. -- | @p --> x@. If @p@ returns 'True', execute the 'ManageHook'.
(-->) :: Query Bool -> ManageHook -> ManageHook --
p --> f = p >>= \b -> if b then f else mempty -- > (-->) :: Monoid m => Query Bool -> Query m -> Query m -- a simpler type
(-->) :: (Monad m, Monoid a) => m Bool -> m a -> m a
p --> f = p >>= \b -> if b then f else return 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 (=?) :: Eq a => Query a -> a -> Query Bool
@@ -72,10 +74,10 @@ title = ask >>= \w -> liftX $ do
let let
getProp = getProp =
(internAtom d "_NET_WM_NAME" False >>= getTextProperty d w) (internAtom d "_NET_WM_NAME" False >>= getTextProperty d w)
`catch` \_ -> getTextProperty d w wM_NAME `catch` \(SomeException _) -> getTextProperty d w wM_NAME
extract prop = do l <- wcTextPropertyToTextList d prop extract prop = do l <- wcTextPropertyToTextList d prop
return $ if null l then "" else head l return $ if null l then "" else head l
io $ bracket getProp (xFree . tp_value) extract `catch` \_ -> return "" io $ bracket getProp (xFree . tp_value) extract `catch` \(SomeException _) -> return ""
-- | Return the application name. -- | Return the application name.
appName :: Query String appName :: Query String
@@ -101,7 +103,7 @@ getStringProperty d w p = do
return $ fmap (map (toEnum . fromIntegral)) md return $ fmap (map (toEnum . fromIntegral)) md
-- | Modify the 'WindowSet' with a pure function. -- | Modify the 'WindowSet' with a pure function.
doF :: (WindowSet -> WindowSet) -> ManageHook doF :: (s -> s) -> Query (Endo s)
doF = return . Endo doF = return . Endo
-- | Move the window to the floating layer. -- | Move the window to the floating layer.

View File

@@ -1,5 +1,4 @@
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
-- -------------------------------------------------------------------------- -- --------------------------------------------------------------------------
@@ -33,9 +32,8 @@ import qualified Data.Set as S
import Control.Applicative import Control.Applicative
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.State import Control.Monad.State
import qualified Control.Exception as C import qualified Control.Exception.Extensible as C
import System.IO
import System.Posix.Process (executeFile) import System.Posix.Process (executeFile)
import Graphics.X11.Xlib import Graphics.X11.Xlib
import Graphics.X11.Xinerama (getScreenInfo) import Graphics.X11.Xinerama (getScreenInfo)
@@ -201,7 +199,7 @@ reveal :: Window -> X ()
reveal w = withDisplay $ \d -> do reveal w = withDisplay $ \d -> do
setWMState w normalState setWMState w normalState
io $ mapWindow d w io $ mapWindow d w
modify (\s -> s { mapped = S.insert w (mapped s) }) whenX (isClient w) $ modify (\s -> s { mapped = S.insert w (mapped s) })
-- | The client events that xmonad is interested in -- | The client events that xmonad is interested in
clientMask :: EventMask clientMask :: EventMask
@@ -211,7 +209,7 @@ clientMask = structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
setInitialProperties :: Window -> X () setInitialProperties :: Window -> X ()
setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do
setWMState w iconicState setWMState w iconicState
io $ selectInput d w $ clientMask io $ selectInput d w clientMask
bw <- asks (borderWidth . config) bw <- asks (borderWidth . config)
io $ setWindowBorderWidth d w bw io $ setWindowBorderWidth d w bw
-- we must initially set the color of new windows, to maintain invariants -- we must initially set the color of new windows, to maintain invariants
@@ -321,14 +319,13 @@ setFocusX w = withWindowSet $ \ws -> do
dpy <- asks display dpy <- asks display
-- clear mouse button grab and border on other windows -- clear mouse button grab and border on other windows
forM_ (W.current ws : W.visible ws) $ \wk -> do forM_ (W.current ws : W.visible ws) $ \wk ->
forM_ (W.index (W.view (W.tag (W.workspace wk)) ws)) $ \otherw -> do forM_ (W.index (W.view (W.tag (W.workspace wk)) ws)) $ \otherw ->
setButtonGrab True otherw setButtonGrab True otherw
-- If we ungrab buttons on the root window, we lose our mouse bindings. -- If we ungrab buttons on the root window, we lose our mouse bindings.
whenX (not <$> isRoot w) $ setButtonGrab False w whenX (not <$> isRoot w) $ setButtonGrab False w
io $ do setInputFocus dpy w revertToPointerRoot 0 io $ setInputFocus dpy w revertToPointerRoot 0
-- raiseWindow dpy w
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- Message handling -- Message handling
@@ -339,7 +336,7 @@ sendMessage :: Message a => a -> X ()
sendMessage a = do sendMessage a = do
w <- W.workspace . W.current <$> gets windowset w <- W.workspace . W.current <$> gets windowset
ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
whenJust ml' $ \l' -> do whenJust ml' $ \l' ->
windows $ \ws -> ws { W.current = (W.current ws) windows $ \ws -> ws { W.current = (W.current ws)
{ W.workspace = (W.workspace $ W.current ws) { W.workspace = (W.workspace $ W.current ws)
{ W.layout = l' }}} { W.layout = l' }}}
@@ -389,18 +386,18 @@ isClient w = withWindowSet $ return . W.member w
-- (numlock and capslock) -- (numlock and capslock)
extraModifiers :: X [KeyMask] extraModifiers :: X [KeyMask]
extraModifiers = do extraModifiers = do
nlm <- gets numlockMask nlm <- gets numberlockMask
return [0, nlm, lockMask, nlm .|. lockMask ] return [0, nlm, lockMask, nlm .|. lockMask ]
-- | Strip numlock\/capslock from a mask -- | Strip numlock\/capslock from a mask
cleanMask :: KeyMask -> X KeyMask cleanMask :: KeyMask -> X KeyMask
cleanMask km = do cleanMask km = do
nlm <- gets numlockMask nlm <- gets numberlockMask
return (complement (nlm .|. lockMask) .&. km) 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 :: Display -> String -> IO (Maybe Pixel)
initColor dpy c = C.handle (\_ -> return Nothing) $ initColor dpy c = C.handle (\(C.SomeException _) -> return Nothing) $
(Just . color_pixel . fst) <$> allocNamedColor dpy colormap c (Just . color_pixel . fst) <$> allocNamedColor dpy colormap c
where colormap = defaultColormap dpy (defaultScreen dpy) where colormap = defaultColormap dpy (defaultScreen dpy)
@@ -439,7 +436,7 @@ floatLocation w = withDisplay $ \d -> do
(fi (wa_width wa + bw*2) % fi (rect_width sr)) (fi (wa_width wa + bw*2) % fi (rect_width sr))
(fi (wa_height wa + bw*2) % fi (rect_height sr)) (fi (wa_height wa + bw*2) % fi (rect_height sr))
return (W.screen $ sc, rr) return (W.screen sc, rr)
where fi x = fromIntegral x where fi x = fromIntegral x
-- | Given a point, determine the screen (if any) that contains it. -- | Given a point, determine the screen (if any) that contains it.
@@ -509,7 +506,7 @@ mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
wa <- io $ getWindowAttributes d w wa <- io $ getWindowAttributes d w
sh <- io $ getWMNormalHints d w sh <- io $ getWMNormalHints d w
io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa)) io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
mouseDrag (\ex ey -> do mouseDrag (\ex ey ->
io $ resizeWindow d w `uncurry` io $ resizeWindow d w `uncurry`
applySizeHintsContents sh (ex - fromIntegral (wa_x wa), applySizeHintsContents sh (ex - fromIntegral (wa_x wa),
ey - fromIntegral (wa_y wa))) ey - fromIntegral (wa_y wa)))

View File

@@ -52,7 +52,7 @@ module XMonad.StackSet (
) where ) where
import Prelude hiding (filter) import Prelude hiding (filter)
import Data.Maybe (listToMaybe,isJust) import Data.Maybe (listToMaybe,isJust,fromMaybe)
import qualified Data.List as L (deleteBy,find,splitAt,filter,nub) import qualified Data.List as L (deleteBy,find,splitAt,filter,nub)
import Data.List ( (\\) ) import Data.List ( (\\) )
import qualified Data.Map as M (Map,insert,delete,empty) import qualified Data.Map as M (Map,insert,delete,empty)
@@ -155,7 +155,7 @@ data RationalRect = RationalRect Rational Rational Rational Rational
deriving (Show, Read, Eq) deriving (Show, Read, Eq)
-- | -- |
-- A stack is a cursor onto a (possibly empty) window list. -- A stack is a cursor onto a window list.
-- The data structure tracks focus by construction, and -- The data structure tracks focus by construction, and
-- the master window is by convention the top-most item. -- the master window is by convention the top-most item.
-- Focus operations will not reorder the list that results from -- Focus operations will not reorder the list that results from
@@ -369,7 +369,7 @@ reverseStack (Stack t ls rs) = Stack t rs ls
-- --
focusWindow :: (Eq s, Eq a, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd focusWindow :: (Eq s, Eq a, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd
focusWindow w s | Just w == peek s = s focusWindow w s | Just w == peek s = s
| otherwise = maybe s id $ do | otherwise = fromMaybe s $ do
n <- findTag w s n <- findTag w s
return $ until ((Just w ==) . peek) focusUp (view n s) return $ until ((Just w ==) . peek) focusUp (view n s)

68
man/HCAR.tex Normal file
View File

@@ -0,0 +1,68 @@
% xmonad-Gx.tex
\begin{hcarentry}{xmonad}
\label{xmonad}
\report{Gwern Branwen}%05/10
\status{active development}
\makeheader
XMonad is a tiling window manager for X. Windows are arranged
automatically to tile the screen without gaps or overlap, maximizing
screen use. Window manager features are accessible from the keyboard; a
mouse is optional. XMonad is written, configured, and extensible in
Haskell. Custom layout algorithms, key bindings, and other extensions may
be written by the user in config files. Layouts are applied
dynamically, and different layouts may be used on each workspace.
Xinerama is fully supported, allowing windows to be tiled on several
physical screens.
Development since the last report has continued apace, with versions
0.8, 0.8.1, 0.9 and 0.9.1 released, with simultaneous releases of the
XMonadContrib library of customizations and extensions, which has now
grown to no less than 205 modules encompassing a dizzying array of features.
Details of changes between releases can be found in the release notes:
\begin{compactitem}
\item \url{http://haskell.org/haskellwiki/Xmonad/Notable_changes_since_0.7}
\item \url{http://haskell.org/haskellwiki/Xmonad/Notable_changes_since_0.8}
\item \url{http://haskell.org/haskellwiki/Xmonad/Notable_changes_since_0.9}
\item XMonad.Config.PlainConfig allows writing configs in a more 'normal' style, and not raw Haskell
\item Supports using local modules in xmonad.hs; for example: to use definitions from \~/.xmonad/lib/XMonad/Stack/MyAdditions.hs
\item xmonad --restart CLI option
\item xmonad --replace CLI option
\item XMonad.Prompt now has customizable keymaps
\item Actions.GridSelect - a GUI menu for selecting windows or workspaces \& substring search on window names
\item Actions.OnScreen
\item Extensions now can have state
\item Actions.SpawnOn - uses state to spawn applications on the workspace the user was originally on,
and not where the user happens to be
\item Markdown manpages and not man/troff
\item XMonad.Layout.ImageButtonDecoration \&\\ XMonad.Util.Image
\item XMonad.Layout.Groups
\item XMonad.Layout.ZoomRow
\item XMonad.Layout.Renamed
\item XMonad.Layout.Drawer
\item XMonad.Layout.FullScreen
\item XMonad.Hooks.ScreenCorners
\item XMonad.Actions.DynamicWorkspaceOrder
\item XMonad.Actions.WorkspaceNames
\item XMonad.Actions.DynamicWorkspaceGroups
\end{compactitem}
Binary packages of XMonad and XMonadContrib are available for all major Linux distributions.
\FurtherReading
\begin{compactitem}
\item Homepage:
\url{http://xmonad.org/}
\item Darcs source:
\texttt{darcs get} \url{http://code.haskell.org/xmonad}
\item IRC channel:
\verb+#xmonad @@ irc.freenode.org+
\item Mailing list:
\email{xmonad@@haskell.org}
\end{compactitem}
\end{hcarentry}

View File

@@ -57,6 +57,9 @@ These flags are:
--restart --restart
: Causes the currently running _xmonad_ process to restart : Causes the currently running _xmonad_ process to restart
--replace
: Replace the current window manager with xmonad
--version --version
: Display version of _xmonad_ : Display version of _xmonad_

View File

@@ -14,7 +14,7 @@ import Data.Ratio
import Data.Maybe import Data.Maybe
import System.Environment import System.Environment
import Control.Exception (assert) import Control.Exception (assert)
import qualified Control.Exception as C import qualified Control.Exception.Extensible as C
import Control.Monad import Control.Monad
import Test.QuickCheck hiding (promote) import Test.QuickCheck hiding (promote)
import System.IO.Unsafe import System.IO.Unsafe
@@ -613,13 +613,13 @@ prop_lookup_visible (x :: T) =
-- and help out hpc -- and help out hpc
prop_abort x = unsafePerformIO $ C.catch (abort "fail") prop_abort x = unsafePerformIO $ C.catch (abort "fail")
(\e -> return $ show e == "xmonad: StackSet: fail" ) (\(C.SomeException e) -> return $ show e == "xmonad: StackSet: fail" )
where where
_ = x :: Int _ = x :: Int
-- new should fail with an abort -- new should fail with an abort
prop_new_abort x = unsafePerformIO $ C.catch f prop_new_abort x = unsafePerformIO $ C.catch f
(\e -> return $ show e == "xmonad: StackSet: non-positive argument to StackSet.new" ) (\(C.SomeException e) -> return $ show e == "xmonad: StackSet: non-positive argument to StackSet.new" )
where where
f = new undefined{-layout-} [] [] `seq` return False f = new undefined{-layout-} [] [] `seq` return False

View File

@@ -5,9 +5,9 @@ main = do foo <- getContents
let actual_loc = filter (not.null) $ filter isntcomment $ let actual_loc = filter (not.null) $ filter isntcomment $
map (dropWhile (==' ')) $ lines foo map (dropWhile (==' ')) $ lines foo
loc = length actual_loc loc = length actual_loc
putStrLn $ show loc print loc
-- uncomment the following to check for mistakes in isntcomment -- uncomment the following to check for mistakes in isntcomment
-- putStr $ unlines $ actual_loc -- print actual_loc
isntcomment ('-':'-':_) = False isntcomment ('-':'-':_) = False
isntcomment ('{':'-':_) = False -- pragmas isntcomment ('{':'-':_) = False -- pragmas

View File

@@ -34,7 +34,7 @@ import Distribution.PackageDescription
import Text.PrettyPrint.HughesPJ import Text.PrettyPrint.HughesPJ
import Distribution.Text import Distribution.Text
import Text.Pandoc import Text.Pandoc -- works with 1.6
releaseDate = "25 October 09" releaseDate = "25 October 09"
@@ -76,19 +76,24 @@ main = do
. lines . lines
<$> readFile "./man/xmonad.1.markdown" <$> readFile "./man/xmonad.1.markdown"
Right template <- getDefaultTemplate Nothing "man"
writeFile "./man/xmonad.1" writeFile "./man/xmonad.1"
. (manHeader ++) . (manHeader ++)
. writeMan writeOpts . writeMan writeOpts{ writerStandalone = True, writerTemplate = template }
$ parsed $ parsed
putStrLn "Documentation created: man/xmonad.1" putStrLn "Documentation created: man/xmonad.1"
Right template <- getDefaultTemplate Nothing "html"
writeFile "./man/xmonad.1.html" writeFile "./man/xmonad.1.html"
. writeHtmlString writeOpts . writeHtmlString writeOpts
{ writerHeader = "<h1>"++releaseName++"</h1>"++ { writerVariables =
"<p>Section: xmonad manual (1)<br>"++ [("include-before"
,"<h1>"++releaseName++"</h1>"++
"<p>Section: xmonad manual (1)<br/>"++
"Updated: "++releaseDate++"</p>"++ "Updated: "++releaseDate++"</p>"++
"<hr>" "<hr/>")]
, writerStandalone = True , writerStandalone = True
, writerTemplate = template
, writerTableOfContents = True } , writerTableOfContents = True }
$ parsed $ parsed
putStrLn "Documentation created: man/xmonad.1.html" putStrLn "Documentation created: man/xmonad.1.html"

View File

@@ -1,5 +1,5 @@
name: xmonad name: xmonad
version: 0.9.1 version: 0.10
homepage: http://xmonad.org homepage: http://xmonad.org
synopsis: A tiling window manager synopsis: A tiling window manager
description: description:
@@ -43,12 +43,18 @@ library
XMonad.StackSet XMonad.StackSet
if flag(small_base) if flag(small_base)
build-depends: base < 4 && >=3, containers, directory, process, filepath build-depends: base < 5 && >=3, containers, directory, process, filepath, extensible-exceptions
else else
build-depends: base < 3 build-depends: base < 3
build-depends: X11>=1.5.0.0 && < 1.6, mtl, unix build-depends: X11>=1.5.0.0 && < 1.6, mtl, unix,
utf8-string >= 0.3 && < 0.4
if true
ghc-options: -funbox-strict-fields -Wall
if impl(ghc >= 6.12.1)
ghc-options: -fno-warn-unused-do-bind
ghc-options: -funbox-strict-fields -Wall
ghc-prof-options: -prof -auto-all ghc-prof-options: -prof -auto-all
extensions: CPP extensions: CPP
@@ -66,7 +72,12 @@ executable xmonad
XMonad.Operations XMonad.Operations
XMonad.StackSet XMonad.StackSet
ghc-options: -funbox-strict-fields -Wall if true
ghc-options: -funbox-strict-fields -Wall
if impl(ghc >= 6.12.1)
ghc-options: -fno-warn-unused-do-bind
ghc-prof-options: -prof -auto-all ghc-prof-options: -prof -auto-all
extensions: CPP extensions: CPP
@@ -76,4 +87,4 @@ executable xmonad
build-depends: QuickCheck < 2 build-depends: QuickCheck < 2
ghc-options: -Werror ghc-options: -Werror
if flag(testing) && flag(small_base) if flag(testing) && flag(small_base)
build-depends: random build-depends: filepath, process, directory, mtl, unix, X11, base, containers, random, extensible-exceptions