mirror of
https://github.com/xmonad/xmonad.git
synced 2025-08-03 13:41:54 -07:00
Compare commits
38 Commits
Author | SHA1 | Date | |
---|---|---|---|
|
4be3b39cd2 | ||
|
75889ab62e | ||
|
792add376e | ||
|
87c50a911f | ||
|
d16aa9975e | ||
|
f34642cbac | ||
|
008c3638a5 | ||
|
f5c40e9e12 | ||
|
bd82cc9150 | ||
|
a025912ab7 | ||
|
19c1759b35 | ||
|
92acd1eb74 | ||
|
db9f39d6af | ||
|
ebcd67efac | ||
|
387a253f62 | ||
|
4c83e8e097 | ||
|
ae59a5184f | ||
|
fa8fe9aca4 | ||
|
673c3e9ed9 | ||
|
6ba45cdb38 | ||
|
b995b430bc | ||
|
ba482a4611 | ||
|
684907bc77 | ||
|
ad4136df26 | ||
|
defe0c282e | ||
|
c7bdac1a7e | ||
|
17799f131a | ||
|
8cd66aa380 | ||
|
32ba0d4a0d | ||
|
77b3f62610 | ||
|
f3b07eb5dc | ||
|
4372c256ed | ||
|
34239a79de | ||
|
5866db4f0f | ||
|
46d039cde5 | ||
|
dd22717961 | ||
|
0beeb4164b | ||
|
0b435028ff |
3
Main.hs
3
Main.hs
@@ -17,7 +17,6 @@ module Main (main) where
|
||||
import XMonad
|
||||
|
||||
import Control.Monad (unless)
|
||||
import System.IO
|
||||
import System.Info
|
||||
import System.Environment
|
||||
import System.Posix.Process (executeFile)
|
||||
@@ -44,6 +43,7 @@ main = do
|
||||
("--resume":_) -> launch
|
||||
["--help"] -> usage
|
||||
["--recompile"] -> recompile True >>= flip unless exitFailure
|
||||
["--replace"] -> launch
|
||||
["--restart"] -> sendRestart >> return ()
|
||||
["--version"] -> putStrLn $ unwords shortVersion
|
||||
["--verbose-version"] -> putStrLn . unwords $ shortVersion ++ longVersion
|
||||
@@ -66,6 +66,7 @@ usage = do
|
||||
" --help Print this message" :
|
||||
" --version Print the version number" :
|
||||
" --recompile Recompile your ~/.xmonad/xmonad.hs" :
|
||||
" --replace Replace the running window manager with xmonad" :
|
||||
" --restart Request a running xmonad process to restart" :
|
||||
#ifdef TESTING
|
||||
" --run-tests Run the test suite" :
|
||||
|
2
TODO
2
TODO
@@ -16,6 +16,8 @@
|
||||
* test core with 6.6 and 6.8
|
||||
* bump xmonad.cabal version and X11 version
|
||||
* 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 tour.html and intro.html are up to date, and mention all core bindings
|
||||
* confirm template config is type correct
|
||||
|
@@ -165,7 +165,7 @@ keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
|
||||
keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
|
||||
-- launching and killing programs
|
||||
[ ((modMask .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal
|
||||
, ((modMask, xK_p ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu
|
||||
, ((modMask, xK_p ), spawn "dmenu_run") -- %! Launch dmenu
|
||||
, ((modMask .|. shiftMask, xK_p ), spawn "gmrun") -- %! Launch gmrun
|
||||
, ((modMask .|. shiftMask, xK_c ), kill) -- %! Close the focused window
|
||||
|
||||
@@ -202,7 +202,7 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
|
||||
|
||||
-- quit, or restart
|
||||
, ((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
|
||||
@@ -220,15 +220,15 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
|
||||
-- | Mouse bindings: default actions bound to mouse events
|
||||
--
|
||||
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
|
||||
[ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w
|
||||
>> windows W.shiftMaster))
|
||||
[ ((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.shiftMaster))
|
||||
, ((modMask, button2), windows . (W.shiftMaster .) . W.focusWindow)
|
||||
-- mod-button3 %! Set the window to floating mode and resize by dragging
|
||||
, ((modMask, button3), (\w -> focus w >> mouseResizeWindow w
|
||||
>> windows W.shiftMaster))
|
||||
, ((modMask, button3), \w -> focus w >> mouseResizeWindow w
|
||||
>> windows W.shiftMaster)
|
||||
-- you may also bind events to the mouse scroll wheel (button4 and button5)
|
||||
]
|
||||
|
||||
|
@@ -1,7 +1,5 @@
|
||||
{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving,
|
||||
MultiParamTypeClasses, TypeSynonymInstances, CPP #-}
|
||||
-- required for deriving Typeable
|
||||
{-# OPTIONS_GHC -fglasgow-exts #-}
|
||||
MultiParamTypeClasses, TypeSynonymInstances, CPP, DeriveDataTypeable #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@@ -27,14 +25,15 @@ module XMonad.Core (
|
||||
StateExtension(..), ExtensionClass(..),
|
||||
runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,
|
||||
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
|
||||
) where
|
||||
|
||||
import XMonad.StackSet hiding (modify)
|
||||
|
||||
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.Monad.State
|
||||
import Control.Monad.Reader
|
||||
@@ -64,11 +63,11 @@ data XState = XState
|
||||
, mapped :: !(S.Set Window) -- ^ the Set of mapped windows
|
||||
, waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents
|
||||
, dragging :: !(Maybe (Position -> Position -> X (), X ()))
|
||||
, numlockMask :: !KeyMask -- ^ The numlock modifier
|
||||
, numberlockMask :: !KeyMask -- ^ The numlock modifier
|
||||
, extensibleState :: !(M.Map String (Either String StateExtension))
|
||||
-- ^ 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.
|
||||
}
|
||||
|
||||
@@ -135,9 +134,7 @@ data ScreenDetail = SD { screenRect :: !Rectangle } deriving (Eq,Show, Read)
|
||||
-- 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, Typeable)
|
||||
#endif
|
||||
|
||||
instance Applicative X where
|
||||
pure = return
|
||||
@@ -149,9 +146,7 @@ instance (Monoid a) => Monoid (X a) where
|
||||
|
||||
type ManageHook = Query (Endo WindowSet)
|
||||
newtype Query a = Query (ReaderT Window X a)
|
||||
#ifndef __HADDOCK__
|
||||
deriving (Functor, Monad, MonadReader Window, MonadIO)
|
||||
#endif
|
||||
|
||||
runQuery :: Query a -> Window -> X a
|
||||
runQuery (Query m) w = runReaderT m w
|
||||
@@ -171,8 +166,8 @@ catchX :: X a -> X a -> X a
|
||||
catchX job errcase = do
|
||||
st <- get
|
||||
c <- ask
|
||||
(a, s') <- io $ runX c st job `catch` \e -> case e of
|
||||
ExitException {} -> throw e
|
||||
(a, s') <- io $ runX c st job `catch` \e -> case fromException e of
|
||||
Just x -> throw e `const` (x `asTypeOf` ExitSuccess)
|
||||
_ -> do hPrint stderr e; runX c st errcase
|
||||
put s'
|
||||
return a
|
||||
@@ -386,19 +381,25 @@ io = liftIO
|
||||
-- | Lift an 'IO' action into the 'X' monad. If the action results in an 'IO'
|
||||
-- exception, log the exception to stderr and continue normal execution.
|
||||
catchIO :: 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
|
||||
-- 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 x = spawnPID x >> return ()
|
||||
|
||||
-- | Like 'spawn', but returns the 'ProcessID' of the launched application
|
||||
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
|
||||
createSession
|
||||
executeFile "/bin/sh" False ["-c", x] Nothing
|
||||
x
|
||||
where
|
||||
nullStdin = do
|
||||
fd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
|
||||
@@ -426,9 +427,11 @@ getXMonadDir = io $ getAppUserDataDirectory "xmonad"
|
||||
--
|
||||
-- * 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
|
||||
-- GHC indicates failure with a non-zero exit code, an xmessage displaying
|
||||
@@ -452,7 +455,7 @@ recompile force = io $ do
|
||||
then do
|
||||
-- temporarily disable SIGCHLD ignoring:
|
||||
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)
|
||||
Nothing Nothing Nothing (Just h)
|
||||
|
||||
@@ -464,7 +467,8 @@ recompile force = io $ do
|
||||
ghcErr <- readFile err
|
||||
let msg = unlines $
|
||||
["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
|
||||
-- lazy evaluation
|
||||
hPutStrLn stderr msg
|
||||
@@ -472,11 +476,11 @@ recompile force = io $ do
|
||||
return ()
|
||||
return (status == ExitSuccess)
|
||||
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"]
|
||||
allFiles t = do
|
||||
let prep = map (t</>) . Prelude.filter (`notElem` [".",".."])
|
||||
cs <- prep <$> catch (getDirectoryContents t) (\_ -> return [])
|
||||
cs <- prep <$> catch (getDirectoryContents t) (\(SomeException _) -> return [])
|
||||
ds <- filterM doesDirectoryExist cs
|
||||
concat . ((cs \\ ds):) <$> mapM allFiles ds
|
||||
|
||||
@@ -499,7 +503,8 @@ installSignalHandlers :: MonadIO m => m ()
|
||||
installSignalHandlers = io $ do
|
||||
installHandler openEndedPipe Ignore Nothing
|
||||
installHandler sigCHLD Ignore Nothing
|
||||
try $ fix $ \more -> do
|
||||
(try :: IO a -> IO (Either SomeException a))
|
||||
$ fix $ \more -> do
|
||||
x <- getAnyProcessStatus False False
|
||||
when (isJust x) more
|
||||
return ()
|
||||
|
@@ -1,5 +1,4 @@
|
||||
{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances, DeriveDataTypeable #-}
|
||||
|
||||
-- --------------------------------------------------------------------------
|
||||
-- |
|
||||
@@ -53,7 +52,8 @@ instance LayoutClass Full a
|
||||
-- '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)
|
||||
, tallRatio :: !Rational -- ^ Default proportion of screen occupied by master pane (default: 1/2)
|
||||
}
|
||||
deriving (Show, Read)
|
||||
-- TODO should be capped [0..1] ..
|
||||
|
||||
@@ -125,7 +125,7 @@ instance LayoutClass l a => LayoutClass (Mirror l) a where
|
||||
|
||||
-- | Mirror a 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
|
||||
@@ -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
|
||||
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) =
|
||||
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
|
||||
|
||||
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
|
||||
|
||||
handleMessage c@(Choose d l r) m | Just ReleaseResources <- fromMessage m =
|
||||
|
@@ -18,6 +18,7 @@ module XMonad.Main (xmonad) where
|
||||
import Control.Arrow (second)
|
||||
import Data.Bits
|
||||
import Data.List ((\\))
|
||||
import Data.Function
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
import Control.Monad.Reader
|
||||
@@ -67,6 +68,10 @@ xmonad initxmc = do
|
||||
|
||||
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
|
||||
-- default error handler will write the exception to stderr and exit with
|
||||
-- an error.
|
||||
@@ -89,7 +94,6 @@ xmonad initxmc = do
|
||||
return (fromMaybe fbc_ v)
|
||||
|
||||
hSetBuffering stdout NoBuffering
|
||||
args <- getArgs
|
||||
|
||||
let layout = layoutHook xmc
|
||||
lreads = readsLayout layout
|
||||
@@ -121,7 +125,7 @@ xmonad initxmc = do
|
||||
|
||||
st = XState
|
||||
{ windowset = initialWinset
|
||||
, numlockMask = 0
|
||||
, numberlockMask = 0
|
||||
, mapped = S.empty
|
||||
, waitingUnmap = M.empty
|
||||
, dragging = Nothing
|
||||
@@ -151,12 +155,10 @@ xmonad initxmc = do
|
||||
userCode $ startupHook initxmc
|
||||
|
||||
-- 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 ()
|
||||
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)
|
||||
@@ -295,8 +297,9 @@ handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
|
||||
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 = userCodeDef () =<< asks (logHook . config)
|
||||
handle event@(PropertyEvent { ev_event_type = t, ev_atom = a })
|
||||
| t == propertyNotify && a == wM_NAME = asks (logHook . config) >>= userCodeDef () >>
|
||||
broadcastMessage event
|
||||
|
||||
handle e@ClientMessageEvent { ev_message_type = mt } = do
|
||||
a <- getAtom "XMONAD_RESTART"
|
||||
@@ -338,7 +341,7 @@ setNumlockMask = do
|
||||
then return (setBit 0 (fromIntegral m))
|
||||
else return (0 :: KeyMask)
|
||||
| (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
|
||||
grabKeys :: X ()
|
||||
@@ -363,3 +366,36 @@ grabButtons = do
|
||||
ems <- extraModifiers
|
||||
ba <- asks buttonActions
|
||||
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
|
||||
|
@@ -22,7 +22,7 @@ import Prelude hiding (catch)
|
||||
import XMonad.Core
|
||||
import Graphics.X11.Xlib.Extras
|
||||
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 Data.Maybe
|
||||
import Data.Monoid
|
||||
@@ -34,22 +34,24 @@ liftX :: X a -> Query a
|
||||
liftX = Query . lift
|
||||
|
||||
-- | The identity hook that returns the WindowSet unchanged.
|
||||
idHook :: ManageHook
|
||||
idHook = doF id
|
||||
idHook :: Monoid m => m
|
||||
idHook = mempty
|
||||
|
||||
-- | Infix 'mappend'. Compose two 'ManageHook' from right to left.
|
||||
(<+>) :: Monoid m => m -> m -> m
|
||||
(<+>) = mappend
|
||||
|
||||
-- | Compose the list of 'ManageHook's.
|
||||
composeAll :: [ManageHook] -> ManageHook
|
||||
composeAll :: Monoid m => [m] -> m
|
||||
composeAll = mconcat
|
||||
|
||||
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
|
||||
--
|
||||
-- > (-->) :: 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'.
|
||||
(=?) :: Eq a => Query a -> a -> Query Bool
|
||||
@@ -72,10 +74,10 @@ title = ask >>= \w -> liftX $ do
|
||||
let
|
||||
getProp =
|
||||
(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
|
||||
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.
|
||||
appName :: Query String
|
||||
@@ -101,7 +103,7 @@ getStringProperty d w p = do
|
||||
return $ fmap (map (toEnum . fromIntegral)) md
|
||||
|
||||
-- | Modify the 'WindowSet' with a pure function.
|
||||
doF :: (WindowSet -> WindowSet) -> ManageHook
|
||||
doF :: (s -> s) -> Query (Endo s)
|
||||
doF = return . Endo
|
||||
|
||||
-- | Move the window to the floating layer.
|
||||
|
@@ -1,5 +1,4 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
|
||||
|
||||
-- --------------------------------------------------------------------------
|
||||
@@ -33,9 +32,8 @@ import qualified Data.Set as S
|
||||
import Control.Applicative
|
||||
import Control.Monad.Reader
|
||||
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 Graphics.X11.Xlib
|
||||
import Graphics.X11.Xinerama (getScreenInfo)
|
||||
@@ -201,7 +199,7 @@ reveal :: Window -> X ()
|
||||
reveal w = withDisplay $ \d -> do
|
||||
setWMState w normalState
|
||||
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
|
||||
clientMask :: EventMask
|
||||
@@ -211,7 +209,7 @@ clientMask = structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
|
||||
setInitialProperties :: Window -> X ()
|
||||
setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do
|
||||
setWMState w iconicState
|
||||
io $ selectInput d w $ clientMask
|
||||
io $ selectInput d w clientMask
|
||||
bw <- asks (borderWidth . config)
|
||||
io $ setWindowBorderWidth d w bw
|
||||
-- we must initially set the color of new windows, to maintain invariants
|
||||
@@ -321,14 +319,13 @@ setFocusX w = withWindowSet $ \ws -> do
|
||||
dpy <- asks display
|
||||
|
||||
-- clear mouse button grab and border on other windows
|
||||
forM_ (W.current ws : W.visible ws) $ \wk -> do
|
||||
forM_ (W.index (W.view (W.tag (W.workspace wk)) ws)) $ \otherw -> do
|
||||
forM_ (W.current ws : W.visible ws) $ \wk ->
|
||||
forM_ (W.index (W.view (W.tag (W.workspace wk)) ws)) $ \otherw ->
|
||||
setButtonGrab True otherw
|
||||
|
||||
-- If we ungrab buttons on the root window, we lose our mouse bindings.
|
||||
whenX (not <$> isRoot w) $ setButtonGrab False w
|
||||
io $ do setInputFocus dpy w revertToPointerRoot 0
|
||||
-- raiseWindow dpy w
|
||||
io $ setInputFocus dpy w revertToPointerRoot 0
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- Message handling
|
||||
@@ -339,7 +336,7 @@ sendMessage :: Message a => a -> X ()
|
||||
sendMessage a = do
|
||||
w <- W.workspace . W.current <$> gets windowset
|
||||
ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
|
||||
whenJust ml' $ \l' -> do
|
||||
whenJust ml' $ \l' ->
|
||||
windows $ \ws -> ws { W.current = (W.current ws)
|
||||
{ W.workspace = (W.workspace $ W.current ws)
|
||||
{ W.layout = l' }}}
|
||||
@@ -389,18 +386,18 @@ isClient w = withWindowSet $ return . W.member w
|
||||
-- (numlock and capslock)
|
||||
extraModifiers :: X [KeyMask]
|
||||
extraModifiers = do
|
||||
nlm <- gets numlockMask
|
||||
nlm <- gets numberlockMask
|
||||
return [0, nlm, lockMask, nlm .|. lockMask ]
|
||||
|
||||
-- | Strip numlock\/capslock from a mask
|
||||
cleanMask :: KeyMask -> X KeyMask
|
||||
cleanMask km = do
|
||||
nlm <- gets numlockMask
|
||||
nlm <- gets numberlockMask
|
||||
return (complement (nlm .|. lockMask) .&. km)
|
||||
|
||||
-- | Get the 'Pixel' value for a named color
|
||||
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
|
||||
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_height wa + bw*2) % fi (rect_height sr))
|
||||
|
||||
return (W.screen $ sc, rr)
|
||||
return (W.screen sc, rr)
|
||||
where fi x = fromIntegral x
|
||||
|
||||
-- | 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
|
||||
sh <- io $ getWMNormalHints d w
|
||||
io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
|
||||
mouseDrag (\ex ey -> do
|
||||
mouseDrag (\ex ey ->
|
||||
io $ resizeWindow d w `uncurry`
|
||||
applySizeHintsContents sh (ex - fromIntegral (wa_x wa),
|
||||
ey - fromIntegral (wa_y wa)))
|
||||
|
@@ -52,7 +52,7 @@ module XMonad.StackSet (
|
||||
) where
|
||||
|
||||
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 Data.List ( (\\) )
|
||||
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)
|
||||
|
||||
-- |
|
||||
-- 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 master window is by convention the top-most item.
|
||||
-- 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 w s | Just w == peek s = s
|
||||
| otherwise = maybe s id $ do
|
||||
| otherwise = fromMaybe s $ do
|
||||
n <- findTag w s
|
||||
return $ until ((Just w ==) . peek) focusUp (view n s)
|
||||
|
||||
|
68
man/HCAR.tex
Normal file
68
man/HCAR.tex
Normal 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}
|
@@ -57,6 +57,9 @@ These flags are:
|
||||
--restart
|
||||
: Causes the currently running _xmonad_ process to restart
|
||||
|
||||
--replace
|
||||
: Replace the current window manager with xmonad
|
||||
|
||||
--version
|
||||
: Display version of _xmonad_
|
||||
|
||||
|
@@ -14,7 +14,7 @@ import Data.Ratio
|
||||
import Data.Maybe
|
||||
import System.Environment
|
||||
import Control.Exception (assert)
|
||||
import qualified Control.Exception as C
|
||||
import qualified Control.Exception.Extensible as C
|
||||
import Control.Monad
|
||||
import Test.QuickCheck hiding (promote)
|
||||
import System.IO.Unsafe
|
||||
@@ -613,13 +613,13 @@ prop_lookup_visible (x :: T) =
|
||||
|
||||
-- and help out hpc
|
||||
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
|
||||
_ = x :: Int
|
||||
|
||||
-- new should fail with an abort
|
||||
prop_new_abort x = unsafePerformIO $ C.catch f
|
||||
(\e -> return $ show e == "xmonad: StackSet: non-positive argument to StackSet.new" )
|
||||
(\(C.SomeException e) -> return $ show e == "xmonad: StackSet: non-positive argument to StackSet.new" )
|
||||
where
|
||||
f = new undefined{-layout-} [] [] `seq` return False
|
||||
|
||||
|
@@ -5,9 +5,9 @@ main = do foo <- getContents
|
||||
let actual_loc = filter (not.null) $ filter isntcomment $
|
||||
map (dropWhile (==' ')) $ lines foo
|
||||
loc = length actual_loc
|
||||
putStrLn $ show loc
|
||||
print loc
|
||||
-- uncomment the following to check for mistakes in isntcomment
|
||||
-- putStr $ unlines $ actual_loc
|
||||
-- print actual_loc
|
||||
|
||||
isntcomment ('-':'-':_) = False
|
||||
isntcomment ('{':'-':_) = False -- pragmas
|
||||
|
@@ -34,7 +34,7 @@ import Distribution.PackageDescription
|
||||
import Text.PrettyPrint.HughesPJ
|
||||
import Distribution.Text
|
||||
|
||||
import Text.Pandoc
|
||||
import Text.Pandoc -- works with 1.6
|
||||
|
||||
releaseDate = "25 October 09"
|
||||
|
||||
@@ -76,19 +76,24 @@ main = do
|
||||
. lines
|
||||
<$> readFile "./man/xmonad.1.markdown"
|
||||
|
||||
Right template <- getDefaultTemplate Nothing "man"
|
||||
writeFile "./man/xmonad.1"
|
||||
. (manHeader ++)
|
||||
. writeMan writeOpts
|
||||
. writeMan writeOpts{ writerStandalone = True, writerTemplate = template }
|
||||
$ parsed
|
||||
putStrLn "Documentation created: man/xmonad.1"
|
||||
|
||||
Right template <- getDefaultTemplate Nothing "html"
|
||||
writeFile "./man/xmonad.1.html"
|
||||
. writeHtmlString writeOpts
|
||||
{ writerHeader = "<h1>"++releaseName++"</h1>"++
|
||||
"<p>Section: xmonad manual (1)<br>"++
|
||||
{ writerVariables =
|
||||
[("include-before"
|
||||
,"<h1>"++releaseName++"</h1>"++
|
||||
"<p>Section: xmonad manual (1)<br/>"++
|
||||
"Updated: "++releaseDate++"</p>"++
|
||||
"<hr>"
|
||||
"<hr/>")]
|
||||
, writerStandalone = True
|
||||
, writerTemplate = template
|
||||
, writerTableOfContents = True }
|
||||
$ parsed
|
||||
putStrLn "Documentation created: man/xmonad.1.html"
|
||||
|
19
xmonad.cabal
19
xmonad.cabal
@@ -1,5 +1,5 @@
|
||||
name: xmonad
|
||||
version: 0.9.1
|
||||
version: 0.10
|
||||
homepage: http://xmonad.org
|
||||
synopsis: A tiling window manager
|
||||
description:
|
||||
@@ -43,12 +43,18 @@ library
|
||||
XMonad.StackSet
|
||||
|
||||
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
|
||||
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-prof-options: -prof -auto-all
|
||||
extensions: CPP
|
||||
|
||||
@@ -66,7 +72,12 @@ executable xmonad
|
||||
XMonad.Operations
|
||||
XMonad.StackSet
|
||||
|
||||
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
|
||||
extensions: CPP
|
||||
|
||||
@@ -76,4 +87,4 @@ executable xmonad
|
||||
build-depends: QuickCheck < 2
|
||||
ghc-options: -Werror
|
||||
if flag(testing) && flag(small_base)
|
||||
build-depends: random
|
||||
build-depends: filepath, process, directory, mtl, unix, X11, base, containers, random, extensible-exceptions
|
||||
|
Reference in New Issue
Block a user