xmonad 0.12 → 0.13

raw patch · 14 files changed

+462/−152 lines, 14 filesdep ~X11dep ~directorynew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: X11, directory

API changes (from Hackage documentation)

Files

• CHANGES.md +69/−0
• README.md +6/−2
• TODO +0/−14
• man/xmonad.1 +2/−2
• man/xmonad.1.html +1/−1
• src/XMonad/Config.hs +1/−1
• src/XMonad/Core.hs +156/−23
• src/XMonad/Layout.hs +1/−1
• src/XMonad/Main.hs +63/−50
• src/XMonad/Operations.hs +128/−34
• src/XMonad/StackSet.hs +3/−3
• tests/Properties/Failure.hs +14/−10
• util/GenerateManpage.hs +4/−5
• xmonad.cabal +14/−6

@@ -1,5 +1,74 @@ # Change Log / Release Notes +## 0.13 (February 10, 2017)++### Breaking Changes++  * When restarting xmonad, resume state is no longer passed to the+    next process via the command line.  Instead, a temporary state+    file is created and xmonad's state is serialized to that file.++    When upgrading to 0.13 from a previous version, the `--resume`+    command line option will automatically migrate to a state file.++    This fixes issue #12.++### Enhancements++  * You can now control which directory xmonad uses for finding your+    configuration file and which one is used for storing the compiled+    version of your configuration.  In order of preference:++      1. New environment variables.  If you want to use these ensure+         you set the correct environment variable and also create the+         directory it references:++         - `XMONAD_CONFIG_DIR`+         - `XMONAD_CACHE_DIR`+         - `XMONAD_DATA_DIR`++      2. The `~/.xmonad` directory.++      3. XDG Base Directory Specification directories, if they exist:++         - `XDG_CONFIG_HOME/xmonad`+         - `XDG_CACHE_HOME/xmonad`+         - `XDG_DATA_HOME/xmonad`++    If none of these directories exist then one will be created using+    the following logic: If the relevant environment variable+    mentioned in step (1) above is set, the referent directory will be+    created and used.  Otherwise `~/.xmonad` will be created and used.++    This fixes a few issues, notably #7 and #56.++  * A custom build script can be used when xmonad is given the+    `--recompile` command line option.  If an executable named `build`+    exists in the xmonad configuration directory it will be called+    instead of `ghc`.  It takes one argument, the name of the+    executable binary it must produce.++    This fixes #8.  (One of two possible custom build solutions.  See+    the next entry for another solution.)++  * For users who build their xmonad configuration using tools such as+    cabal or stack, there is another option for executing xmonad.++    Instead of running the `xmonad` executable directly, arrange to+    have your login manager run your configuration binary instead.+    Then, in your binary, use the new `launch` command instead of+    `xmonad`.++    This will keep xmonad from using its configuration file+    checking/compiling code and directly start the window manager+    without `exec`ing any other binary.++    See the documentation for the `launch` function in `XMonad.Main`+    for more details.++    Fixes #8.  (Second way to have a custom build environment for+    XMonad.  See previous entry for another solution.)+ ## 0.12 (December 14, 2015)    * Compiles with GHC 7.10.2, 7.8.4, and 7.6.3

@@ -1,5 +1,7 @@ # xmonad: A Tiling Window Manager +[![Build Status](https://travis-ci.org/xmonad/xmonad.svg?branch=master)](https://travis-ci.org/xmonad/xmonad)+ [xmonad][] is a tiling window manager for X. Windows are arranged automatically to tile the screen without gaps or overlap, maximising screen use. Window manager features are accessible from the keyboard:@@ -62,7 +64,7 @@  ## Running xmonad -Add:+If you built XMonad using `cabal` then add:      exec $HOME/.cabal/bin/xmonad @@ -70,7 +72,7 @@  ## Configuring -See the `CONFIG` document.+See the [CONFIG][] document and the [example configuration file][example-config].  ## XMonadContrib @@ -115,3 +117,5 @@ [xmonadcontrib]: https://hackage.haskell.org/package/xmonad-contrib [xmc-prompt-shell]: https://hackage.haskell.org/package/xmonad-contrib/docs/XMonad-Prompt-Shell.html [platform]: http://haskell.org/platform/+[example-config]: https://github.com/xmonad/xmonad-testing/blob/master/example-config.hs+[config]: https://github.com/xmonad/xmonad/blob/master/CONFIG

@@ -1,14 +0,0 @@-= Release management =--* generate, and push website haddocks with xmonad-web/gen-docs.sh-* generate manpage, generate html manpage-* double check README build instructions-* bump xmonad.cabal version and X11 version-* update cabal "tested-with:" fields-* upload X11 and xmonad to Hackage-* 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-* update haskellwiki notable changes since x.x-* email announce

@@ -1,7 +1,7 @@-.TH xmonad 1 "31 December 2012" xmonad-0.12 "xmonad manual".\" Automatically generated by Pandoc 1.15.1+.TH xmonad 1 "31 December 2012" xmonad-0.13 "xmonad manual".\" Automatically generated by Pandoc 1.19.2.1 .\"-.hy .TH "" "" "" "" ""+.hy .SH Name .PP xmonad \- a tiling window manager

@@ -8,7 +8,7 @@   <style type="text/css">code{white-space: pre;}</style> </head> <body>-<h1>xmonad-0.12</h1><p>Section: xmonad manual (1)<br/>Updated: 31 December 2012</p><hr/>+<h1>xmonad-0.13</h1><p>Section: xmonad manual (1)<br/>Updated: 31 December 2012</p><hr/> <div id="TOC"> <ul> <li><a href="#name">Name</a></li>

@@ -320,9 +320,9 @@     "-- quit, or restart",     "mod-Shift-q  Quit xmonad",     "mod-q        Restart xmonad",-    "mod-[1..9]   Switch to workSpace N",     "",     "-- Workspaces & screens",+    "mod-[1..9]         Switch to workSpace N",     "mod-Shift-[1..9]   Move client to workspace N",     "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",

@@ -25,8 +25,10 @@     StateExtension(..), ExtensionClass(..),     runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,     withDisplay, withWindowSet, isRoot, runOnWorkspaces,-    getAtom, spawn, spawnPID, xfork, getXMonadDir, recompile, trace, whenJust, whenX,-    atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, ManageHook, Query(..), runQuery+    getAtom, spawn, spawnPID, xfork, recompile, trace, whenJust, whenX,+    getXMonadDir, getXMonadCacheDir, getXMonadDataDir, stateFileName,+    atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, withWindowAttributes,+    ManageHook, Query(..), runQuery   ) where  import XMonad.StackSet hiding (modify)@@ -41,6 +43,7 @@ import System.FilePath import System.IO import System.Info+import System.Posix.Env (getEnv) import System.Posix.Process (executeFile, forkProcess, getAnyProcessStatus, createSession) import System.Posix.Signals import System.Posix.IO@@ -49,7 +52,7 @@ import System.Directory import System.Exit import Graphics.X11.Xlib-import Graphics.X11.Xlib.Extras (Event)+import Graphics.X11.Xlib.Extras (getWindowAttributes, WindowAttributes, Event) import Data.Typeable import Data.List ((\\)) import Data.Maybe (isJust,fromMaybe)@@ -207,6 +210,12 @@ withWindowSet :: (WindowSet -> X a) -> X a withWindowSet f = gets windowset >>= f +-- | Safely access window attributes.+withWindowAttributes :: Display -> Window -> (WindowAttributes -> X ()) -> X ()+withWindowAttributes dpy win f = do+    wa <- userCode (io $ getWindowAttributes dpy win)+    catchX (whenJust wa f) (return ())+ -- | True if the given window is the root window isRoot :: Window -> X Bool isRoot w = (w==) <$> asks theRoot@@ -431,48 +440,153 @@              $ current ws : visible ws     modify $ \s -> s { windowset = ws { current = c, visible = v, hidden = h } } --- | Return the path to @~\/.xmonad@.+-- | Return the path to the xmonad configuration directory.  This+-- directory is where user configuration files are stored (e.g, the+-- xmonad.hs file).  You may also create a @lib@ subdirectory in the+-- configuration directory and the default recompile command will add+-- it to the GHC include path.+--+-- Several directories are considered.  In order of+-- preference:+--+--   1. The directory specified in the @XMONAD_CONFIG_DIR@ environment variable.+--   2. The @~\/.xmonad@ directory.+--   3. The @XDG_CONFIG_HOME/xmonad@ directory.+--+-- The first directory that exists will be used.  If none of the+-- directories exist then (1) will be used if it is set, otherwise (2)+-- will be used.  Either way, a directory will be created if necessary. getXMonadDir :: MonadIO m => m String-getXMonadDir = io $ getAppUserDataDirectory "xmonad"+getXMonadDir =+    findFirstDirWithEnv "XMONAD_CONFIG_DIR"+      [ getAppUserDataDirectory "xmonad"+      , getXdgDirectory XdgConfig "xmonad"+      ] --- | 'recompile force', recompile @~\/.xmonad\/xmonad.hs@ when any of the--- following apply:+-- | Return the path to the xmonad cache directory.  This directory is+-- used to store temporary files that can easily be recreated.  For+-- example, the XPrompt history file. --+-- Several directories are considered.  In order of preference:+--+--   1. The directory specified in the @XMONAD_CACHE_DIR@ environment variable.+--   2. The @~\/.xmonad@ directory.+--   3. The @XDG_CACHE_HOME/xmonad@ directory.+--+-- The first directory that exists will be used.  If none of the+-- directories exist then (1) will be used if it is set, otherwise (2)+-- will be used.  Either way, a directory will be created if necessary.+getXMonadCacheDir :: MonadIO m => m String+getXMonadCacheDir =+    findFirstDirWithEnv "XMONAD_CACHE_DIR"+      [ getAppUserDataDirectory "xmonad"+      , getXdgDirectory XdgCache "xmonad"+      ]++-- | Return the path to the xmonad data directory.  This directory is+-- used by XMonad to store data files such as the run-time state file+-- and the configuration binary generated by GHC.+--+-- Several directories are considered.  In order of preference:+--+--   1. The directory specified in the @XMONAD_DATA_DIR@ environment variable.+--   2. The @~\/.xmonad@ directory.+--   3. The @XDG_DATA_HOME/xmonad@ directory.+--+-- The first directory that exists will be used.  If none of the+-- directories exist then (1) will be used if it is set, otherwise (2)+-- will be used.  Either way, a directory will be created if necessary.+getXMonadDataDir :: MonadIO m => m String+getXMonadDataDir =+    findFirstDirWithEnv "XMONAD_DATA_DIR"+      [ getAppUserDataDirectory "xmonad"+      , getXdgDirectory XdgData "xmonad"+      ]++-- | Helper function that will find the first existing directory and+-- return its path.  If none of the directories can be found, create+-- and return the first from the list.  If the list is empty this+-- function returns the historical @~\/.xmonad@ directory.+findFirstDirOf :: MonadIO m => [IO FilePath] -> m FilePath+findFirstDirOf []        = findFirstDirOf [getAppUserDataDirectory "xmonad"]+findFirstDirOf possibles = do+    found <- go possibles++    case found of+      Just path -> return path+      Nothing   -> do+        primary <- io (head possibles)+        io (createDirectoryIfMissing True primary)+        return primary++  where+    go []     = return Nothing+    go (x:xs) = do+      dir    <- io x+      exists <- io (doesDirectoryExist dir)+      if exists then return (Just dir) else go xs++-- | Simple wrapper around @findFirstDirOf@ that allows the primary+-- path to be specified by an environment variable.+findFirstDirWithEnv :: MonadIO m => String -> [IO FilePath] -> m FilePath+findFirstDirWithEnv envName paths = do+    envPath' <- io (getEnv envName)++    case envPath' of+      Nothing      -> findFirstDirOf paths+      Just envPath -> findFirstDirOf (return envPath:paths)+++-- | Get the name of the file used to store the xmonad window state.+stateFileName :: (Functor m, MonadIO m) => m FilePath+stateFileName = (</> "xmonad.state") <$> getXMonadDataDir++-- | 'recompile force', recompile the xmonad configuration file when+-- any of the following apply:+-- --      * force is 'True' -- --      * the xmonad executable does not exist -- --      * the xmonad executable is older than xmonad.hs or any file in---        ~\/.xmonad\/lib+--        the @lib@ directory (under the configuration directory). -- -- The -i flag is used to restrict recompilation to the xmonad.hs file only,--- and any files in the ~\/.xmonad\/lib directory.+-- and any files in the aforementioned @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--- that file is spawned.+-- Compilation errors (if any) are logged to the @xmonad.errors@ file+-- in the xmonad data directory.  If GHC indicates failure with a+-- non-zero exit code, an xmessage displaying that file is spawned. -- -- 'False' is returned if there are compilation errors. -- recompile :: MonadIO m => Bool -> m Bool recompile force = io $ do-    dir <- getXMonadDir+    cfgdir  <- getXMonadDir+    datadir <- getXMonadDataDir     let binn = "xmonad-"++arch++"-"++os-        bin  = dir </> binn-        base = dir </> "xmonad"-        err  = base ++ ".errors"-        src  = base ++ ".hs"-        lib  = dir </> "lib"+        bin  = datadir </> binn+        err  = datadir </> "xmonad.errors"+        src  = cfgdir </> "xmonad.hs"+        lib  = cfgdir </> "lib"+        buildscript = cfgdir </> "build"+     libTs <- mapM getModTime . Prelude.filter isSource =<< allFiles lib     srcT <- getModTime src     binT <- getModTime bin-    if force || any (binT <) (srcT : libTs)++    useBuildscript <- do+      exists <- doesFileExist buildscript+      if exists then isExecutable buildscript else return False++    if force || useBuildscript || any (binT <) (srcT : libTs)       then do         -- temporarily disable SIGCHLD ignoring:         uninstallSignalHandlers-        status <- bracket (openFile err WriteMode) hClose $ \h ->-            waitForProcess =<< runProcess "ghc" ["--make", "xmonad.hs", "-i", "-ilib", "-fforce-recomp", "-main-is", "main", "-v0", "-o",binn] (Just dir)-                                    Nothing Nothing Nothing (Just h)+        status <- bracket (openFile err WriteMode) hClose $ \errHandle ->+            waitForProcess =<< if useBuildscript+                               then compileScript bin cfgdir buildscript errHandle+                               else compileGHC bin cfgdir errHandle          -- re-enable SIGCHLD:         installSignalHandlers@@ -487,17 +601,36 @@             -- nb, the ordering of printing, then forking, is crucial due to             -- lazy evaluation             hPutStrLn stderr msg-            forkProcess $ executeFile "xmessage" True ["-default", "okay", msg] Nothing+            forkProcess $ executeFile "xmessage" True ["-default", "okay", replaceUnicode msg] Nothing             return ()         return (status == ExitSuccess)       else return True  where getModTime f = E.catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing)        isSource = flip elem [".hs",".lhs",".hsc"] . takeExtension+       isExecutable f = E.catch (executable <$> getPermissions f) (\(SomeException _) -> return False)        allFiles t = do             let prep = map (t</>) . Prelude.filter (`notElem` [".",".."])             cs <- prep <$> E.catch (getDirectoryContents t) (\(SomeException _) -> return [])             ds <- filterM doesDirectoryExist cs             concat . ((cs \\ ds):) <$> mapM allFiles ds+       -- Replace some of the unicode symbols GHC uses in its output+       replaceUnicode = map $ \c -> case c of+           '\8226' -> '*'  -- •+           '\8216' -> '`'  -- ‘+           '\8217' -> '`'  -- ’+           _ -> c+       compileGHC bin dir errHandle =+         runProcess "ghc" ["--make"+                          , "xmonad.hs"+                          , "-i"+                          , "-ilib"+                          , "-fforce-recomp"+                          , "-main-is", "main"+                          , "-v0"+                          , "-o", bin+                          ] (Just dir) Nothing Nothing Nothing (Just errHandle)+       compileScript bin dir script errHandle =+         runProcess script [bin] (Just dir) Nothing Nothing Nothing (Just errHandle)  -- | Conditionally run an action, using a @Maybe a@ to decide. whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()

@@ -137,7 +137,7 @@ instance Message ChangeLayout  -- | The layout choice combinator-(|||) :: (LayoutClass l a, LayoutClass r a) => l a -> r a -> Choose l r a+(|||) :: l a -> r a -> Choose l r a (|||) = Choose L infixr 5 ||| 

@@ -13,10 +13,10 @@ -- ----------------------------------------------------------------------------- -module XMonad.Main (xmonad) where+module XMonad.Main (xmonad, launch) where  import System.Locale.SetLocale-import Control.Arrow (second)+import qualified Control.Exception.Extensible as E import Data.Bits import Data.List ((\\)) import Data.Function@@ -37,7 +37,7 @@ import XMonad.Operations  import System.IO-+import System.Directory import System.Info import System.Environment import System.Posix.Process (executeFile)@@ -59,33 +59,29 @@ xmonad conf = do     installSignalHandlers -- important to ignore SIGCHLD to avoid zombies -    let launch serializedWinset serializedExtState args = do+    let launch' args = do               catchIO buildLaunch               conf' @ XConfig { layoutHook = Layout l }                   <- handleExtraArgs conf args conf{ layoutHook = Layout (layoutHook conf) }-              withArgs [] $-                xmonadNoargs (conf' { layoutHook = l })-                              serializedWinset-                              serializedExtState+              withArgs [] $ launch (conf' { layoutHook = l })      args <- getArgs     case args of-        ("--resume": ws : xs : args') -> launch (Just ws) (Just xs) args'+        ("--resume": ws : xs : args') -> migrateState ws xs >> launch' args'         ["--help"]            -> usage         ["--recompile"]       -> recompile True >>= flip unless exitFailure         ["--restart"]         -> sendRestart         ["--version"]         -> putStrLn $ unwords shortVersion         ["--verbose-version"] -> putStrLn . unwords $ shortVersion ++ longVersion-        "--replace" : args'   -> do-                                  sendReplace-                                  launch Nothing Nothing args'-        _                     -> launch Nothing Nothing args+        "--replace" : args'   -> sendReplace >> launch' args'+        _                     -> launch' args  where     shortVersion = ["xmonad", showVersion version]     longVersion  = [ "compiled by", compilerName, showVersion compilerVersion                    , "for",  arch ++ "-" ++ os                    , "\nXinerama:", show compiledWithXinerama ] + usage :: IO () usage = do     self <- getProgName@@ -99,13 +95,13 @@         "  --restart                    Request a running xmonad process to restart" :         [] --- | 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:+-- | Build the xmonad configuration file 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 -----   * both "~\/.xmonad\/xmonad.hs" and "~\/.xmonad\/xmonad-$arch-$os" missing+--   * both the configuration file and executable are missing -- --   * xmonad.hs fails to compile --@@ -118,7 +114,7 @@ buildLaunch ::  IO () buildLaunch = do     recompile False-    dir  <- getXMonadDir+    dir  <- getXMonadDataDir     args <- getArgs     whoami <- getProgName     let compiledConfig = "xmonad-"++arch++"-"++os@@ -144,15 +140,28 @@     rootw  <- rootWindow dpy dflt     replace dpy dflt rootw ---- |--- The main entry point+-- | Entry point into xmonad for custom builds. ---xmonadNoargs :: (LayoutClass l Window, Read (l Window)) => XConfig l-    -> Maybe String -- ^ serialized windowset-    -> Maybe String -- ^ serialized extensible state-    -> IO ()-xmonadNoargs initxmc serializedWinset serializedExtstate = do+-- This function isn't meant to be called by the typical xmonad user+-- because it:+--+--   * Does not process any command line arguments.+--+--   * Therefore doesn't know how to restart a running xmonad.+--+--   * Does not compile your configuration file since it assumes it's+--     actually running from within your compiled configuration.+--+-- Unless you know what you are doing, you should probably be using+-- the 'xmonad' function instead.+--+-- However, if you are using a custom build environment (such as+-- stack, cabal, make, etc.) you will likely want to call this+-- function instead of 'xmonad'.  You probably also want to have a key+-- binding to the 'XMonad.Operations.restart` function that restarts+-- your custom binary with the resume flag set to @True@.+launch :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()+launch initxmc = do     -- setup locale information from environment     setLocale LC_ALL (Just "")     -- ignore SIGPIPE and SIGCHLD@@ -176,6 +185,7 @@     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.def                  return (fromMaybe nbc_ v)@@ -190,20 +200,7 @@         lreads = readsLayout layout         initialWinset = let padToLen n xs = take (max n (length xs)) $ xs ++ repeat ""             in new layout (padToLen (length xinesc) (workspaces xmc)) $ map SD xinesc-        maybeRead reads' s = case reads' s of-                                [(x, "")] -> Just x-                                _         -> Nothing -        winset = fromMaybe initialWinset $ do-                    s                    <- serializedWinset-                    ws                   <- maybeRead reads s-                    return . W.ensureTags layout (workspaces xmc)-                           $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws-        extState = fromMaybe M.empty $ do-                     dyns                        <- serializedExtstate-                     vals                        <- maybeRead reads dyns-                     return . M.fromList . map (second Left) $ vals-         cf = XConf             { display       = dpy             , config        = xmc@@ -218,15 +215,25 @@          st = XState             { windowset       = initialWinset-            , numberlockMask   = 0+            , numberlockMask  = 0             , mapped          = S.empty             , waitingUnmap    = M.empty             , dragging        = Nothing-            , extensibleState = extState+            , extensibleState = M.empty             }+     allocaXEvent $ \e ->         runX cf st $ do+            -- check for serialized state in a file.+            serializedSt <- do+                path <- stateFileName+                exists <- io (doesFileExist path)+                if exists then readStateFile initxmc else return Nothing +            -- restore extensibleState if we read it from a file.+            let extst = maybe M.empty extensibleState serializedSt+            modify (\s -> s {extensibleState = extst})+             setNumlockMask             grabKeys             grabButtons@@ -240,6 +247,7 @@             -- those windows.  Remove all windows that are no longer top-level             -- children of the root, they may have disappeared since             -- restarting.+            let winset = maybe initialWinset windowset serializedSt             windows . const . foldr W.delete winset $ W.allWindows winset \\ ws              -- manage the as-yet-unmanaged windows@@ -290,10 +298,10 @@  -- manage a new window handle (MapRequestEvent    {ev_window = w}) = withDisplay $ \dpy -> do-    wa <- io $ getWindowAttributes dpy w -- ignore override windows-    -- need to ignore mapping requests by managed windows not on the current workspace-    managed <- isClient w-    when (not (wa_override_redirect wa) && not managed) $ do manage w+    withWindowAttributes dpy w $ \wa -> do -- ignore override windows+      -- need to ignore mapping requests by managed windows not on the current workspace+      managed <- isClient w+      when (not (wa_override_redirect wa) && not managed) $ manage w  -- window destroyed, unmanage it -- window gone,      unmanage it@@ -356,7 +364,11 @@ -- True in the user's config. handle e@(CrossingEvent {ev_window = w, ev_event_type = t})     | t == enterNotify && ev_mode   e == notifyNormal-    = whenX (asks $ focusFollowsMouse . config) (focus w)+    = whenX (asks $ focusFollowsMouse . config) $ do+        dpy <- asks display+        root <- asks theRoot+        (_, _, w', _, _, _, _, _) <- io $ queryPointer dpy root+        when (w == w') (focus w)  -- left a window, check if we need to focus root handle e@(CrossingEvent {ev_event_type = t})@@ -367,8 +379,6 @@ -- configure a window handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do     ws <- gets windowset-    wa <- io $ getWindowAttributes dpy w-     bw <- asks (borderWidth . config)      if M.member w (floating ws)@@ -382,7 +392,7 @@                     , wc_sibling      = ev_above e                     , wc_stack_mode   = ev_detail e }                 when (member w ws) (float w)-        else io $ allocaXEvent $ \ev -> do+        else withWindowAttributes dpy w $ \wa -> io $ allocaXEvent $ \ev -> do                  setEventType ev configureNotify                  setConfigureEvent ev w w                      (wa_x wa) (wa_y wa) (wa_width wa)@@ -416,7 +426,7 @@ scan :: Display -> Window -> IO [Window] scan dpy rootw = do     (_, _, ws) <- queryTree dpy rootw-    filterM ok ws+    filterM (\w -> ok w `E.catch` skip) ws   -- TODO: scan for windows that are either 'IsViewable' or where WM_STATE ==   -- Iconic   where ok w = do wa <- getWindowAttributes dpy w@@ -427,6 +437,9 @@                             _          -> False                   return $ not (wa_override_redirect wa)                          && (wa_map_state wa == waIsViewable || ic)++        skip :: E.SomeException -> IO Bool+        skip _ = return False  setNumlockMask :: X () setNumlockMask = do

@@ -1,6 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}-+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} -- -------------------------------------------------------------------------- -- | -- Module      :  XMonad.Operations@@ -30,10 +29,13 @@ import qualified Data.Set as S  import Control.Applicative+import Control.Arrow (second) import Control.Monad.Reader import Control.Monad.State import qualified Control.Exception.Extensible as C +import System.IO+import System.Directory import System.Posix.Process (executeFile) import Graphics.X11.Xlib import Graphics.X11.Xinerama (getScreenInfo)@@ -111,7 +113,10 @@      mapM_ setInitialProperties newwindows -    whenJust (W.peek old) $ \otherw -> io $ setWindowBorder d otherw nbc+    whenJust (W.peek old) $ \otherw -> do+      nbs <- asks (normalBorderColor . config)+      setWindowBorderWithFallback d otherw nbs nbc+     modify (\s -> s { windowset = ws })      -- notify non visibility@@ -151,7 +156,9 @@      mapM_ (uncurry tileWindow) rects -    whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc+    whenJust (W.peek ws) $ \w -> do+      fbs <- asks (focusedBorderColor . config)+      setWindowBorderWithFallback d w fbs fbc      mapM_ reveal visible     setTopFocus@@ -181,6 +188,19 @@     a <- atom_WM_STATE     io $ changeProperty32 dpy w a a propModeReplace [fromIntegral v, fromIntegral none] +-- | Set the border color using the window's color map, if possible,+-- otherwise fallback to the color in @Pixel@.+setWindowBorderWithFallback :: Display -> Window -> String -> Pixel -> X ()+setWindowBorderWithFallback dpy w color basic = io $+    C.handle fallback $ do+      wa <- getWindowAttributes dpy w+      pixel <- color_pixel . fst <$> allocNamedColor dpy (wa_colormap wa) color+      setWindowBorder dpy w pixel+  where+    fallback :: C.SomeException -> IO ()+    fallback e = do hPrint stderr e >> hFlush stderr+                    setWindowBorder dpy w basic+ -- | hide. Hide a window by unmapping it, and setting Iconified. hide :: Window -> X () hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do@@ -233,10 +253,10 @@ -- | tileWindow. Moves and resizes w such that it fits inside the given -- rectangle, including its border. tileWindow :: Window -> Rectangle -> X ()-tileWindow w r = withDisplay $ \d -> do-    bw <- (fromIntegral . wa_border_width) <$> io (getWindowAttributes d w)+tileWindow w r = withDisplay $ \d -> withWindowAttributes d w $ \wa -> do     -- give all windows at least 1x1 pixels-    let least x | x <= bw*2  = 1+    let bw = fromIntegral $ wa_border_width wa+        least x | x <= bw*2  = 1                 | otherwise  = x - bw*2     io $ moveResizeWindow d w (rect_x r) (rect_y r)                               (least $ rect_width r) (least $ rect_height r)@@ -423,6 +443,69 @@  ------------------------------------------------------------------------ +-- | A type to help serialize xmonad's state to a file.+data StateFile = StateFile+  { sfWins :: W.StackSet  WorkspaceId String Window ScreenId ScreenDetail+  , sfExt  :: [(String, String)]+  } deriving (Show, Read)++-- | Write the current window state (and extensible state) to a file+-- so that xmonad can resume with that state intact.+writeStateToFile :: X ()+writeStateToFile = do+    let maybeShow (t, Right (PersistentExtension ext)) = Just (t, show ext)+        maybeShow (t, Left str) = Just (t, str)+        maybeShow _ = Nothing++        wsData   = W.mapLayout show . windowset+        extState = catMaybes . map maybeShow . M.toList . extensibleState++    path  <- stateFileName+    stateData <- gets (\s -> StateFile (wsData s) (extState s))+    catchIO (writeFile path $ show stateData)++-- | Read the state of a previous xmonad instance from a file and+-- return that state.+readStateFile :: (LayoutClass l Window, Read (l Window)) => XConfig l -> X (Maybe XState)+readStateFile xmc = do+    path <- stateFileName+    raw  <- userCode $ io (readFile path)++    return $ do+      sf <- maybeRead reads =<< raw++      let winset = W.ensureTags layout (workspaces xmc) $ W.mapLayout (fromMaybe layout . maybeRead lreads) (sfWins sf)+          extState = M.fromList . map (second Left) $ sfExt sf++      return XState { windowset       = winset+                    , numberlockMask  = 0+                    , mapped          = S.empty+                    , waitingUnmap    = M.empty+                    , dragging        = Nothing+                    , extensibleState = extState+                    }+  where+    layout = Layout (layoutHook xmc)+    lreads = readsLayout layout+    maybeRead reads' s = case reads' s of+                           [(x, "")] -> Just x+                           _         -> Nothing++-- | Migrate state from a previously running xmonad instance that used+-- the older @--resume@ technique.+{-# DEPRECATED migrateState "will be removed some point in the future." #-}+migrateState :: (Functor m, MonadIO m) => String -> String -> m ()+migrateState ws xs = do+    io (putStrLn "WARNING: --resume is no longer supported.")+    whenJust stateData $ \s -> do+      path <- stateFileName+      catchIO (writeFile path $ show s)+  where+    stateData = StateFile <$> maybeRead ws <*> maybeRead xs+    maybeRead s = case reads s of+                    [(x, "")] -> Just x+                    _         -> Nothing+ -- | @restart name resume@. Attempt to restart xmonad by executing the program -- @name@.  If @resume@ is 'True', restart with the current window state. -- When executing another window manager, @resume@ should be 'False'.@@ -430,13 +513,8 @@ restart prog resume = do     broadcastMessage ReleaseResources     io . flush =<< asks display-    let wsData = show . W.mapLayout show . windowset-        maybeShow (t, Right (PersistentExtension ext)) = Just (t, show ext)-        maybeShow (t, Left str) = Just (t, str)-        maybeShow _ = Nothing-        extState = return . show . catMaybes . map maybeShow . M.toList . extensibleState-    args <- if resume then gets (\s -> "--resume":wsData s:extState s) else return []-    catchIO (executeFile prog True args Nothing)+    when resume writeStateToFile+    catchIO (executeFile prog True [] Nothing)  ------------------------------------------------------------------------ -- | Floating layer support@@ -444,21 +522,28 @@ -- | Given a window, find the screen it is located on, and compute -- the geometry of that window wrt. that screen. floatLocation :: Window -> X (ScreenId, W.RationalRect)-floatLocation w = withDisplay $ \d -> do-    ws <- gets windowset-    wa <- io $ getWindowAttributes d w-    let bw = (fromIntegral . wa_border_width) wa-    sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)--    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))-                            (fi (wa_height wa + bw*2) % fi (rect_height sr))+floatLocation w =+    catchX go $ do+      -- Fallback solution if `go' fails.  Which it might, since it+      -- calls `getWindowAttributes'.+      sc <- W.current <$> gets windowset+      return (W.screen sc, W.RationalRect 0 0 1 1) -    return (W.screen sc, rr)   where fi x = fromIntegral x+        go = withDisplay $ \d -> do+          ws <- gets windowset+          wa <- io $ getWindowAttributes d w+          let bw = (fromIntegral . wa_border_width) wa+          sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) +          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))+                                  (fi (wa_height wa + bw*2) % fi (rect_height sr))++          return (W.screen sc, rr)+ -- | Given a point, determine the screen (if any) that contains it. pointScreen :: Position -> Position             -> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))@@ -507,7 +592,7 @@                     clearEvents pointerMotionMask                     return z --- | XXX comment me+-- | drag the window under the cursor with the mouse while it is dragged mouseMoveWindow :: Window -> X () mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do     io $ raiseWindow d w@@ -515,21 +600,26 @@     (_, _, _, ox', oy', _, _, _) <- io $ queryPointer d w     let ox = fromIntegral ox'         oy = fromIntegral oy'-    mouseDrag (\ex ey -> io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))-                                             (fromIntegral (fromIntegral (wa_y wa) + (ey - oy))))+    mouseDrag (\ex ey -> do+                  io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))+                                      (fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))+                  float w+              )               (float w) --- | XXX comment me+-- | resize the window under the cursor with the mouse while it is dragged mouseResizeWindow :: Window -> X () mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do     io $ raiseWindow d w     wa <- io $ getWindowAttributes d w     sh <- io $ getWMNormalHints d w     io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))-    mouseDrag (\ex ey ->+    mouseDrag (\ex ey -> do                  io $ resizeWindow d w `uncurry`                     applySizeHintsContents sh (ex - fromIntegral (wa_x wa),-                                               ey - fromIntegral (wa_y wa)))+                                               ey - fromIntegral (wa_y wa))+                 float w)+               (float w)  -- ---------------------------------------------------------------------@@ -542,8 +632,12 @@ 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+    wa <- C.try $ getWindowAttributes d w+    case wa of+         Left  err -> const (return id) (err :: C.SomeException)+         Right wa' ->+            let bw = fromIntegral $ wa_border_width wa'+            in  return $ applySizeHints bw sh  -- | Reduce the dimensions if needed to comply to the given SizeHints, taking -- window borders into account.

@@ -477,12 +477,12 @@ -- --   * 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 :: (Ord a) => a -> StackSet i l a s sd -> StackSet i l a s sd delete w = sink w . delete' w  -- | Only temporarily remove the window from the stack, thereby not destroying special -- information saved in the 'Stackset'-delete' :: (Eq a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd+delete' :: (Eq a) => a -> StackSet i l a s sd -> StackSet i l a s sd delete' w s = s { current = removeFromScreen        (current s)                 , visible = map removeFromScreen    (visible s)                 , hidden  = map removeFromWorkspace (hidden  s) }@@ -547,7 +547,7 @@ -- 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.-shiftWin :: (Ord a, Eq a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd+shiftWin :: (Ord a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd shiftWin n w s = case findTag w s of                     Just from | n `tagMember` s && n /= from -> go from s                     _                                        -> s

@@ -4,23 +4,27 @@  import qualified Control.Exception.Extensible as C import System.IO.Unsafe+import Data.List (isPrefixOf)  -- ------------------------------------------------------------------------ testing for failure---- and help out hpc-prop_abort x = unsafePerformIO $ C.catch (abort "fail")-                                         (\(C.SomeException e) -> return $  show e == "xmonad: StackSet: fail" )+-- testing for failure and help out hpc+--+-- Since base 4.9.0.0 `error` appends a stack trace. The tests below+-- use `isPrefixOf` to only test equality on the error message.+--+prop_abort :: Int -> Bool+prop_abort _ = unsafePerformIO $ C.catch (abort "fail") check    where-     _ = x :: Int+     check (C.SomeException e) =+       return $ "xmonad: StackSet: fail" `isPrefixOf` show e  -- new should fail with an abort-prop_new_abort x = unsafePerformIO $ C.catch f-                                         (\(C.SomeException e) -> return $ show e == "xmonad: StackSet: non-positive argument to StackSet.new" )+prop_new_abort :: Int -> Bool+prop_new_abort _ = unsafePerformIO $ C.catch f check    where      f = new undefined{-layout-} [] [] `seq` return False--     _ = x :: Int+     check (C.SomeException e) =+       return $ "xmonad: StackSet: non-positive argument to StackSet.new" `isPrefixOf` show e  -- TODO: Fix this? -- prop_view_should_fail = view {- with some bogus data -}

@@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleContexts #-}--- Unlike the rest of xmonad, this file is copyright under the terms of the--- GPL.+-- Unlike the rest of xmonad, this file is released under the GNU General+-- Public License version 2 or later.  -- -- Generates man/xmonad.1 from man/xmonad.1.in by filling the list of@@ -79,7 +79,7 @@     Right template <- getDefaultTemplate Nothing "man"     writeFile "./man/xmonad.1"         . (manHeader ++)-        . writeMan def{ writerStandalone = True, writerTemplate = template }+        . writeMan def{ writerTemplate = Just template }         $ parsed     putStrLn "Documentation created: man/xmonad.1" @@ -92,8 +92,7 @@                              "<p>Section: xmonad manual (1)<br/>"++                              "Updated: "++releaseDate++"</p>"++                              "<hr/>")]-            , writerStandalone = True-            , writerTemplate = template+            , writerTemplate = Just template             , writerTableOfContents = True }         $ parsed     putStrLn "Documentation created: man/xmonad.1.html"

@@ -1,5 +1,5 @@ name:               xmonad-version:            0.12+version:            0.13 homepage:           http://xmonad.org synopsis:           A tiling window manager description:@@ -17,7 +17,7 @@ license-file:       LICENSE author:             Spencer Janssen maintainer:         xmonad@haskell.org-extra-source-files: README.md CHANGES.md TODO CONFIG STYLE+extra-source-files: README.md CHANGES.md CONFIG STYLE                     tests/*.hs                     tests/Properties/*.hs                     tests/Properties/Layout/*.hs@@ -31,7 +31,8 @@ tested-with:                     GHC==7.6.3,                     GHC==7.8.4,-                    GHC==7.10.2+                    GHC==7.10.3,+                    GHC==8.0.1  data-files:         man/xmonad.hs, man/xmonad.1, man/xmonad.1.html @@ -42,12 +43,18 @@ flag testing     description: Testing mode, only build minimal components     default: False+    manual: True  flag generatemanpage     description: Build the tool for generating the man page     default: False     manual: True +flag profiling+     description: Enable profiling+     default: False+     manual: True+ library     hs-source-dirs:     src     exposed-modules:    XMonad@@ -63,7 +70,7 @@     build-depends: base < 5 && >=3,                    containers,                    data-default,-                   directory,+                   directory >= 1.2.3,                    extensible-exceptions,                    filepath,                    setlocale,@@ -71,7 +78,7 @@                    process,                    unix,                    utf8-string >= 0.3 && < 1.1,-                   X11>=1.5 && < 1.7+                   X11>=1.8 && < 1.9      if true         ghc-options:        -funbox-strict-fields -Wall@@ -83,7 +90,8 @@         -- needed for XMonad.Config's instance Default (XConfig a)  -    ghc-prof-options:   -prof -auto-all+    if flag(profiling)+        ghc-prof-options:   -prof -auto-all      if flag(testing)         buildable: False