diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,35 @@ # Change Log / Release Notes +## 0.18.0 (February 3, 2024) + +### Breaking Changes + +* Dropped support for GHC 8.4. + +### Enhancements + +* Exported `sendRestart` and `sendReplace` from `XMonad.Operations`. + +* Exported `buildLaunch` from `XMonad.Main`. + +* `Tall` does not draw windows with zero area. + +* `XMonad.Operations.floatLocation` now applies size hints. This means windows + will snap to these hints as soon as they're floated (mouse move, keybinding). + Previously that only happened on mouse resize. + +* Recompilation now detects `flake.nix` and `default.nix` (can be a + symlink) and switches to using `nix build` as appropriate. + +* Added `unGrab` to `XMonad.Operations`; this releases XMonad's passive + keyboard grab, so other applications (like `scrot`) can do their + thing. + +### Bug Fixes + +* Duplicated floats (e.g. from X.A.CopyToAll) no longer escape to inactive + screens. + ## 0.17.2 (April 2, 2023) ### Bug Fixes @@ -14,6 +44,9 @@ * Exported `cacheNumlockMask` and `mkGrabs` from `XMonad.Operations`. + * Added `willFloat` function to `XMonad.ManageHooks` to detect whether the + (about to be) managed window will be a floating window or not. + ### Bug Fixes * Fixed border color of windows with alpha channel. Now all windows have the @@ -70,9 +103,6 @@ * Added `withUnfocused` function to `XMonad.Operations`, allowing for `X` operations to be applied to unfocused windows. - - * Added `willFloat` function to `XMonad.ManageHooks` to detect whether the - (about to be) managed window will be a floating window or not [these build scripts]: https://github.com/xmonad/xmonad-testing/tree/master/build-scripts diff --git a/INSTALL.md b/INSTALL.md --- a/INSTALL.md +++ b/INSTALL.md @@ -123,7 +123,9 @@ #### Install Stack -The easiest way to get [stack] is probably via your system's package +Probably one of the best ways to get [stack] is to use [GHCup], which is the main Haskell installer according to language's official [website][GHCup] and community [survey]. GHCup is [widely available] and is considered less error prone than other installation options. + +You can also use your system's package manager: ``` console @@ -145,9 +147,6 @@ $ curl -sSL https://get.haskellstack.org/ | sh ``` -Yet another way would be via [ghcup]; this is similar to installers like -`rustup`, in case you prefer that. - #### Create a New Project Let's create a stack project. Since we're already in the correct @@ -222,7 +221,9 @@ #### Install cabal-install -The easiest way to get [cabal-install] is probably via your system's package +Probably one of the best ways to get [cabal-install] is to use [GHCup], which is the main Haskell installer according to language's official [website][GHCup] and community [survey]. GHCup is [widely available] and is considered less error prone than other installation options. + +You can also use your system's package manager: ``` console @@ -231,22 +232,22 @@ $ sudo pacman -S cabal-install # Arch ``` -If your distribution does not package cabal-install, [ghcup][] is another -option. See also . +See also . #### Create a New Project -Let's create a cabal project. Since we're already in the correct -directory (`~/.config/xmonad`) with `xmonad` and `xmonad-contrib` -subdirectories, we'll instruct cabal to use them. Create a file named -`cabal.project` containing: +If you want to use `xmonad` or `xmonad-contrib` from git, you will need a +`cabal.project` file. If you want to use both from [Hackage][], you should +skip this step. +Create a file named `cabal.project` containing: + ``` packages: */*.cabal ``` -(If you skip this step, cabal will use the latest releases from [Hackage][] -instead.) +(If you do this step without using [git] checkouts, you will get an error from +cabal in the next step. Simply remove `cabal.project` and try again.) #### Install Everything @@ -255,7 +256,7 @@ ``` console $ cabal update -$ cabal install --package-env=$HOME/.config/xmonad --lib xmonad xmonad-contrib +$ cabal install --package-env=$HOME/.config/xmonad --lib base xmonad xmonad-contrib $ cabal install --package-env=$HOME/.config/xmonad xmonad ``` @@ -393,7 +394,9 @@ [git]: https://git-scm.com/ [stack]: https://docs.haskellstack.org/en/stable/README/ [cabal-install]: https://www.haskell.org/cabal/ -[ghcup]: https://www.haskell.org/ghcup/ +[GHCup]: https://www.haskell.org/ghcup/ +[survey]: https://taylor.fausak.me/2022/11/18/haskell-survey-results/ +[widely available]: https://www.haskell.org/ghcup/install/#supported-platforms [what xmonad would do]: https://github.com/xmonad/xmonad/blob/master/src/XMonad/Core.hs#L659-L667 [Hackage]: https://hackage.haskell.org/ [scripts/build]: https://github.com/xmonad/xmonad-contrib/blob/master/scripts/build diff --git a/MAINTAINERS.md b/MAINTAINERS.md --- a/MAINTAINERS.md +++ b/MAINTAINERS.md @@ -117,7 +117,12 @@ See [old announcements][old-announce] ([even older][older-announce]) for inspiration. - 7. Bump version for development (add `.9`) and prepare fresh sections in + 7. Trigger xmonad-docs build to generate and persist docs for the just + released version: + + - https://github.com/xmonad/xmonad-docs/actions/workflows/stack.yml + + 8. Bump version for development (add `.9`) and prepare fresh sections in [`CHANGES.md`](CHANGES.md). [packdeps]: https://hackage.haskell.org/package/packdeps diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,9 +6,9 @@ License Made in Haskell
- Stack - Cabal - Nix + Stack + Cabal + Nix
GitHub Sponsors Open Collective diff --git a/TUTORIAL.md b/TUTORIAL.md --- a/TUTORIAL.md +++ b/TUTORIAL.md @@ -77,6 +77,11 @@ `~/.xinitrc` as directed in the xmonad guided tour, you should be good to go! If not, just smack an `exec xmonad` at the bottom of that file. +In particular, it might be a good idea to set a wallpaper beforehand. +Otherwise, when switching workspaces or closing windows, you might start +seeing "shadows" of windows that were there before, unable to interact +with them. + ## Installing Xmobar What we need to do now—provided we want to use a bar at all—is to @@ -263,7 +268,7 @@ ``` The so-called `where`-clause above simply consists of local declarations -that might clutter things up where they all declared at the top-level +that might clutter things up were they all declared at the top-level like this ``` haskell @@ -379,12 +384,16 @@ some [Hacks] to make this work), we will also add the relevant function to get "proper" fullscreen behaviour here. +--- + _IF YOU ARE ON A VERSION `< 0.17.0`_: The `ewmhFullscreen` function does not exist in these versions. Instead of it, you can try to add `fullscreenEventHook` to your `handleEventHook` to achieve similar functionality (how to do this is explained in the documentation of [XMonad.Hooks.EwmhDesktops]). +--- + To use the two combinators, we compose them with the `xmonad` function in the following way: @@ -430,7 +439,7 @@ ## Make XMonad and Xmobar Talk to Each Other Onto the main dish. First, we have to import the necessary modules. -Add the following to your list of imports: +Add the following to your list of imports ``` haskell import XMonad.Hooks.DynamicLog @@ -438,24 +447,28 @@ import XMonad.Hooks.StatusBar.PP ``` -_IF YOU ARE ON A VERSION `< 0.17.0`_: The `XMonad.Hooks.StatusBar` and - `XMonad.Hooks.StatusBar.PP` modules don't exist yet. You can find - everything you need in the `XMonad.Hooks.DynamicLog` module, so remove - these two imports. - -Replace your `main` function above with: +and replace your `main` function above with: ``` haskell main :: IO () main = xmonad $ ewmhFullscreen $ ewmh $ xmobarProp $ myConfig ``` -_IF YOU ARE ON A VERSION `< 0.17.0`_: The `xmobarProp` function does not - exist in these versions. Instead of it, use `xmobar` via - `main = xmonad . ewmh =<< xmobar myConfig` and carefully read the part - about pipes later on (`xmobar` uses pipes to make xmobar talk to - xmonad). +--- +_IF YOU ARE ON A VERSION `< 0.17.0`_: The `XMonad.Hooks.StatusBar` and + `XMonad.Hooks.StatusBar.PP` modules don't exist yet. You can find + everything you need in the `XMonad.Hooks.DynamicLog` module, so remove + these two imports. + + Further, the `xmobarProp` function does not exist in older versions. + Instead of it, use `xmobar` via `main = xmonad . ewmh =<< xmobar + myConfig` and carefully read the part about pipes later on (`xmobar` + uses pipes to make xmobar talk to xmonad). Do note the lack of + `ewmhFullscreen`, as explained above! + +--- + As a quick side-note, we could have also written ``` haskell @@ -540,11 +553,15 @@ (this is useful, for example, for [XMonad.Util.ClickableWorkspaces], which is a new feature in `0.17.0`). +--- + _IF YOU ARE ON A VERSION `< 0.17.0`_: As discussed above, the `xmobar` function uses pipes, so you actually do want to use the `StdinReader`. Simply replace _all_ occurences of `XMonadLog` with `StdinReader` below (don't forget the template!) +--- + ## Configuring Xmobar Now, before this will work, we have to configure xmobar. Here's a nice @@ -660,6 +677,8 @@ $ myConfig ``` +--- + _IF YOU ARE ON A VERSION `< 0.17.0`_: `xmobar` has a similar definition, relying on `statusBar` alone: `xmobar = statusBar "xmobar" xmobarPP toggleStrutsKey`. Sadly, the `defToggleStrutsKey` function is not yet @@ -668,7 +687,6 @@ ``` haskell main :: IO () main = xmonad - . ewmhFullscreen . ewmh =<< statusBar "xmobar" def toggleStrutsKey myConfig where @@ -676,6 +694,8 @@ toggleStrutsKey XConfig{ modMask = m } = (m, xK_b) ``` +--- + The `defToggleStrutsKey` here is just the key with which you can toggle the bar; it is bound to `M-b`. If you want to change this, you can also define your own: @@ -772,6 +792,8 @@ lowWhite = xmobarColor "#bbbbbb" "" ``` +--- + _IF YOU ARE ON A VERSION `< 0.17`_: Both `logTitles` and `xmobarBorder` are not available yet, so you will have to remove them. As an alternative to `xmobarBorder`, a common way to "mark" the currently @@ -779,6 +801,8 @@ `ppCurrent = wrap (blue "[") (blue "]")` and see if you like it. Also read the bit about `ppOrder` further down! +--- + That's a lot! But don't worry, take a deep breath and remind yourself of what you read above in the documentation of the [PP record]. Even if you haven't read the documentation yet, most of the fields should be @@ -882,10 +906,10 @@ First, configure xscreensaver how you like it with the `xscreensaver-demo` command. Now, we will set these things up in -`~/.xinitrc` (we could also do most of this in xmonad's `startupHook`, -but `~/.xinitrc` is perhaps more standard). If you want to use xmonad -with a desktop environment, see [Basic Desktop Environment Integration] -for how to do this. +`~/.xinitrc`. If you want to use XMonad with a desktop environment, see +[Basic Desktop Environment Integration] for how to do this. For a +version using XMonad's built in functionality instead, see the [next +section][using-the-startupHook]. Your `~/.xinitrc` may wind up looking like this: @@ -933,6 +957,38 @@ Of course substitute the wallpaper for one of your own. If you like the one used above, you can find it [here](https://i.imgur.com/9MQHuZx.png). +### Using the `startupHook` + +Instead of the `.xinitrc` file, one can also use XMonad's built in +`startupHook` in order to auto start programs. The +[XMonad.Util.SpawnOnce] library is perfect for this use case, allowing +programs to start only once, and not with every invocation of `M-q`! + +This requires but a small change in `myConfig`: + +``` haskell +-- import XMonad.Util.SpawnOnce (spawnOnce) + +myConfig = def + { modMask = mod4Mask -- Rebind Mod to the Super key + , layoutHook = myLayout -- Use custom layouts + , startupHook = myStartupHook + } + `additionalKeysP` + [ ("M-S-z", spawn "xscreensaver-command -lock") + , ("M-C-s", unGrab *> spawn "scrot -s" ) + , ("M-f" , spawn "firefox" ) + ] + +myStartupHook :: X () +myStartupHook = do + spawnOnce "trayer --edge top --align right --SetDockType true \ + \--SetPartialStrut true --expand true --width 10 \ + \--transparent true --tint 0x5f5f5f --height 18" + spawnOnce "feh --bg-fill --no-fehbg ~/.wallpapers/haskell-red-noise.png" + -- … and so on … +``` + ## Final Touches There may be some programs that you don't want xmonad to tile. The @@ -1238,21 +1294,22 @@ [Basic Desktop Environment Integration]: https://wiki.haskell.org/Xmonad/Basic_Desktop_Environment_Integration [Hacks]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Util-Hacks.html -[PP record]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Hooks-DynamicLog.html#t:PP [INSTALL.md]: INSTALL.md +[PP record]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Hooks-DynamicLog.html#t:PP [XMonad.Config]: https://github.com/xmonad/xmonad/blob/master/src/XMonad/Config.hs -[XMonad.ManageHook]: https://xmonad.github.io/xmonad-docs/xmonad/XMonad-ManageHook.html -[XMonad.Util.Loggers]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Util-Loggers.html -[XMonad.Util.EZConfig]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Util-EZConfig.html -[XMonad.Layout.Renamed]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Layout-Renamed.html -[XMonad.Layout.Magnifier]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Layout-Magnifier.html [XMonad.Doc.Contributing]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Doc-Configuring.html [XMonad.Hooks.EwmhDesktops]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Hooks-EwmhDesktops.html -[XMonad.Layout.ThreeColumns]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Layout-ThreeColumns.html [XMonad.Hooks.ManageHelpers]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Hooks-ManageHelpers.html +[XMonad.Layout.Magnifier]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Layout-Magnifier.html +[XMonad.Layout.Renamed]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Layout-Renamed.html +[XMonad.Layout.ThreeColumns]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Layout-ThreeColumns.html +[XMonad.ManageHook]: https://xmonad.github.io/xmonad-docs/xmonad/XMonad-ManageHook.html [XMonad.Util.ClickableWorkspaces]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Util-ClickableWorkspaces.html +[XMonad.Util.EZConfig]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Util-EZConfig.html +[XMonad.Util.Loggers]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Util-Loggers.html +[XMonad.Util.SpawnOnce]: https://hackage.haskell.org/package/xmonad-contrib/docs/XMonad-Util-SpawnOnce.html -[xmobar]: https://xmobar.org/ +[xmobar]: https://codeberg.org/xmobar/xmobar [battery]: https://codeberg.org/xmobar/xmobar/src/branch/master/doc/plugins.org#batteryp-dirs-args-refreshrate [xmobar.hs]: https://codeberg.org/xmobar/xmobar/src/branch/master/etc/xmobar.hs [Wikipedia page]: https://en.wikipedia.org/wiki/ICAO_airport_code#Prefixes diff --git a/src/XMonad/Core.hs b/src/XMonad/Core.hs --- a/src/XMonad/Core.hs +++ b/src/XMonad/Core.hs @@ -7,6 +7,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DerivingVia #-} ----------------------------------------------------------------------------- -- | @@ -32,7 +33,7 @@ StateExtension(..), ExtensionClass(..), ConfExtension(..), runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers, withDisplay, withWindowSet, isRoot, runOnWorkspaces, - getAtom, spawn, spawnPID, xfork, xmessage, recompile, trace, whenJust, whenX, + getAtom, spawn, spawnPID, xfork, xmessage, recompile, trace, whenJust, whenX, ifM, getXMonadDir, getXMonadCacheDir, getXMonadDataDir, stateFileName, binFileName, atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, withWindowAttributes, ManageHook, Query(..), runQuery, Directories'(..), Directories, getDirectories, @@ -48,12 +49,13 @@ import Control.Monad.Fix (fix) import Control.Monad.State import Control.Monad.Reader -import Control.Monad (filterM, guard, liftM2, void, when) +import Control.Monad (filterM, guard, void, when) import Data.Semigroup import Data.Traversable (for) import Data.Time.Clock (UTCTime) import Data.Default.Class import System.Environment (lookupEnv) +import Data.List (isInfixOf, intercalate, (\\)) import System.FilePath import System.IO import System.Info @@ -68,8 +70,8 @@ import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras (getWindowAttributes, WindowAttributes, Event) import Data.Typeable -import Data.List (isInfixOf, (\\)) import Data.Maybe (isJust,fromMaybe) +import Data.Monoid (Ap(..)) import qualified Data.Map as M import qualified Data.Set as S @@ -165,12 +167,7 @@ -- newtype X a = X (ReaderT XConf (StateT XState IO) a) deriving (Functor, Applicative, Monad, MonadFail, MonadIO, MonadState XState, MonadReader XConf) - -instance Semigroup a => Semigroup (X a) where - (<>) = liftM2 (<>) - -instance (Monoid a) => Monoid (X a) where - mempty = pure mempty + deriving (Semigroup, Monoid) via Ap X a instance Default a => Default (X a) where def = return def @@ -178,16 +175,11 @@ type ManageHook = Query (Endo WindowSet) newtype Query a = Query (ReaderT Window X a) deriving (Functor, Applicative, Monad, MonadReader Window, MonadIO) + deriving (Semigroup, Monoid) via Ap Query a runQuery :: Query a -> Window -> X a runQuery (Query m) = runReaderT m -instance Semigroup a => Semigroup (Query a) where - (<>) = liftM2 (<>) - -instance Monoid a => Monoid (Query a) where - mempty = pure mempty - instance Default a => Default (Query a) where def = return def @@ -423,9 +415,13 @@ data ConfExtension = forall a. Typeable a => ConfExtension a -- --------------------------------------------------------------------- --- | General utilities --- --- Lift an 'IO' action into the 'X' monad +-- General utilities + +-- | If-then-else lifted to a 'Monad'. +ifM :: Monad m => m Bool -> m a -> m a -> m a +ifM mb t f = mb >>= \b -> if b then t else f + +-- | Lift an 'IO' action into the 'X' monad io :: MonadIO m => IO a -> m a io = liftIO @@ -584,21 +580,31 @@ srcFileName Directories{ cfgDir } = cfgDir "xmonad.hs" libFileName Directories{ cfgDir } = cfgDir "lib" -buildScriptFileName, stackYamlFileName :: Directories -> FilePath +buildScriptFileName, stackYamlFileName, nixFlakeFileName, nixDefaultFileName :: Directories -> FilePath buildScriptFileName Directories{ cfgDir } = cfgDir "build" stackYamlFileName Directories{ cfgDir } = cfgDir "stack.yaml" +nixFlakeFileName Directories{ cfgDir } = cfgDir "flake.nix" +nixDefaultFileName Directories{ cfgDir } = cfgDir "default.nix" -- | Compilation method for xmonad configuration. -data Compile = CompileGhc | CompileStackGhc FilePath | CompileScript FilePath +data Compile + = CompileGhc + | CompileStackGhc FilePath + | CompileNixFlake + | CompileNixDefault + | CompileScript FilePath deriving (Show) -- | Detect compilation method by looking for known file names in xmonad -- configuration directory. detectCompile :: Directories -> IO Compile -detectCompile dirs = tryScript <|> tryStack <|> useGhc +detectCompile dirs = + tryScript <|> tryStack <|> tryNixFlake <|> tryNixDefault <|> useGhc where buildScript = buildScriptFileName dirs stackYaml = stackYamlFileName dirs + flakeNix = nixFlakeFileName dirs + defaultNix = nixDefaultFileName dirs tryScript = do guard =<< doesFileExist buildScript @@ -612,6 +618,18 @@ trace $ "Suggested resolution to use it: chmod u+x " <> show buildScript empty + tryNixFlake = do + guard =<< doesFileExist flakeNix + canonNixFlake <- canonicalizePath flakeNix + trace $ "XMonad will use nix flake at " <> show canonNixFlake <> " to recompile" + pure CompileNixFlake + + tryNixDefault = do + guard =<< doesFileExist defaultNix + canonNixDefault <- canonicalizePath defaultNix + trace $ "XMonad will use nix file at " <> show canonNixDefault <> " to recompile" + pure CompileNixDefault + tryStack = do guard =<< doesFileExist stackYaml canonStackYaml <- canonicalizePath stackYaml @@ -619,11 +637,18 @@ pure $ CompileStackGhc canonStackYaml useGhc = do - trace $ "XMonad will use ghc to recompile, because neither " - <> show buildScript <> " nor " <> show stackYaml <> " exists." + trace $ "XMonad will use ghc to recompile, because none of " + <> intercalate ", " + [ show buildScript + , show stackYaml + , show flakeNix + , show defaultNix + ] <> " exist." pure CompileGhc - isExecutable f = E.catch (executable <$> getPermissions f) (\(SomeException _) -> return False) +-- | Determine whether or not the file found at the provided filepath is executable. +isExecutable :: FilePath -> IO Bool +isExecutable f = E.catch (executable <$> getPermissions f) (\(SomeException _) -> return False) -- | Should we recompile xmonad configuration? Is it newer than the compiled -- binary? @@ -648,6 +673,8 @@ if binT < stackYamlT then True <$ trace "XMonad recompiling because some files have changed." else shouldCompile dirs CompileGhc +shouldCompile _dirs CompileNixFlake{} = True <$ trace "XMonad recompiling because flake recompilation is being used." +shouldCompile _dirs CompileNixDefault{} = True <$ trace "XMonad recompiling because nix recompilation is being used." shouldCompile _dirs CompileScript{} = True <$ trace "XMonad recompiling because a custom build script is being used." @@ -667,6 +694,10 @@ CompileStackGhc stackYaml -> run "stack" ["build", "--silent", "--stack-yaml", stackYaml] .&&. run "stack" ("ghc" : "--stack-yaml" : stackYaml : "--" : ghcArgs) + CompileNixFlake -> + run "nix" ["build"] >>= andCopyFromResultDir + CompileNixDefault -> + run "nix-build" [] >>= andCopyFromResultDir CompileScript script -> run script [binFileName dirs] where @@ -680,6 +711,18 @@ , "-outputdir", buildDirName dirs , "-o", binFileName dirs ] + andCopyFromResultDir exitCode = do + if exitCode == ExitSuccess then copyFromResultDir else return exitCode + findM p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing) + catchAny :: IO a -> (SomeException -> IO a) -> IO a + catchAny = E.catch + copyFromResultDir = do + let binaryDirectory = cfgDir dirs "result" "bin" + binFiles <- map (binaryDirectory ) <$> catchAny (listDirectory binaryDirectory) (\_ -> return []) + mfilepath <- findM isExecutable binFiles + case mfilepath of + Just filepath -> copyFile filepath (binFileName dirs) >> return ExitSuccess + Nothing -> return $ ExitFailure 1 -- waitForProcess =<< System.Process.runProcess, but without closing the err handle runProc cwd err exe args = do diff --git a/src/XMonad/Layout.hs b/src/XMonad/Layout.hs --- a/src/XMonad/Layout.hs +++ b/src/XMonad/Layout.hs @@ -62,9 +62,13 @@ -- a nice pure layout, lots of properties for the layout, and its messages, in Properties.hs instance LayoutClass Tall a where - pureLayout (Tall nmaster _ frac) r s = zip ws rs + pureLayout (Tall nmaster _ frac) r s + | frac == 0 = drop nmaster layout + | frac == 1 = take nmaster layout + | otherwise = layout where ws = W.integrate s rs = tile frac r nmaster (length ws) + layout = zip ws rs pureMessage (Tall nmaster delta frac) m = msum [fmap resize (fromMessage m) diff --git a/src/XMonad/Main.hs b/src/XMonad/Main.hs --- a/src/XMonad/Main.hs +++ b/src/XMonad/Main.hs @@ -15,14 +15,13 @@ -- ----------------------------------------------------------------------------- -module XMonad.Main (xmonad, launch) where +module XMonad.Main (xmonad, buildLaunch, launch) where import System.Locale.SetLocale import qualified Control.Exception as E import Data.Bits import Data.List ((\\)) import Data.Foldable (traverse_) -import Data.Function import qualified Data.Map as M import qualified Data.Set as S import Control.Monad.Reader @@ -132,25 +131,6 @@ args <- getArgs executeFile bin False args Nothing -sendRestart :: IO () -sendRestart = do - dpy <- openDisplay "" - rw <- rootWindow dpy $ defaultScreen dpy - xmonad_restart <- internAtom dpy "XMONAD_RESTART" False - allocaXEvent $ \e -> do - setEventType e clientMessage - setClientMessageEvent' e rw xmonad_restart 32 [] - sendEvent dpy rw False structureNotifyMask e - sync dpy False - --- | a wrapper for 'replace' -sendReplace :: IO () -sendReplace = do - dpy <- openDisplay "" - let dflt = defaultScreen dpy - rootw <- rootWindow dpy dflt - replace dpy dflt rootw - -- | Entry point into xmonad for custom builds. -- -- This function isn't meant to be called by the typical xmonad user @@ -485,36 +465,3 @@ 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 diff --git a/src/XMonad/ManageHook.hs b/src/XMonad/ManageHook.hs --- a/src/XMonad/ManageHook.hs +++ b/src/XMonad/ManageHook.hs @@ -64,10 +64,6 @@ (<||>) :: Monad m => m Bool -> m Bool -> m Bool x <||> y = ifM x (pure True) y --- | If-then-else lifted to a 'Monad'. -ifM :: Monad m => m Bool -> m a -> m a -> m a -ifM mb t f = mb >>= \b -> if b then t else f - -- | Return the window title. title :: Query String title = ask >>= \w -> liftX $ do @@ -77,7 +73,7 @@ (internAtom d "_NET_WM_NAME" False >>= getTextProperty d w) `E.catch` \(SomeException _) -> getTextProperty d w wM_NAME extract prop = do l <- wcTextPropertyToTextList d prop - return $ if null l then "" else head l + return $ fromMaybe "" $ listToMaybe l io $ bracket getProp (xFree . tp_value) extract `E.catch` \(SomeException _) -> return "" -- | Return the application name; i.e., the /first/ string returned by diff --git a/src/XMonad/Operations.hs b/src/XMonad/Operations.hs --- a/src/XMonad/Operations.hs +++ b/src/XMonad/Operations.hs @@ -33,10 +33,11 @@ -- * Keyboard and Mouse cleanMask, extraModifiers, mouseDrag, mouseMoveWindow, mouseResizeWindow, - setButtonGrab, setFocusX, cacheNumlockMask, mkGrabs, + setButtonGrab, setFocusX, cacheNumlockMask, mkGrabs, unGrab, -- * Messages sendMessage, broadcastMessage, sendMessageWithNoRefresh, + sendRestart, sendReplace, -- * Save and Restore State StateFile (..), writeStateToFile, readStateFile, restart, @@ -196,6 +197,7 @@ let m = W.floating ws flt = [(fw, scaleRationalRect viewrect r) | fw <- filter (`M.member` m) (W.index this) + , fw `notElem` vis , Just r <- [M.lookup fw m]] vs = flt ++ rs @@ -473,6 +475,28 @@ , extraMod <- extraMods ] +-- | Release XMonad's keyboard grab, so other grabbers can do their thing. +-- +-- Start a keyboard action with this if it is going to run something +-- that needs to do a keyboard, pointer, or server grab. For example, +-- +-- > , ((modm .|. controlMask, xK_p), unGrab >> spawn "scrot") +-- +-- (Other examples are certain screen lockers and "gksu".) +-- This avoids needing to insert a pause/sleep before running the +-- command. +-- +-- XMonad retains the keyboard grab during key actions because if they +-- use a submap, they need the keyboard to be grabbed, and if they had +-- to assert their own grab then the asynchronous nature of X11 allows +-- race conditions between XMonad, other clients, and the X server that +-- would cause keys to sometimes be "leaked" to the focused window. +unGrab :: X () +unGrab = withDisplay $ \d -> io $ do + ungrabKeyboard d currentTime + ungrabPointer d currentTime + sync d False + ------------------------------------------------------------------------ -- Message handling @@ -519,6 +543,59 @@ handleMessage (W.layout ws) (SomeMessage ReleaseResources) windows $ const $ ss{ W.current = c{ W.workspace = ws{ W.layout = l } } } +-- | Signal xmonad to restart itself. +sendRestart :: IO () +sendRestart = do + dpy <- openDisplay "" + rw <- rootWindow dpy $ defaultScreen dpy + xmonad_restart <- internAtom dpy "XMONAD_RESTART" False + allocaXEvent $ \e -> do + setEventType e clientMessage + setClientMessageEvent' e rw xmonad_restart 32 [] + sendEvent dpy rw False structureNotifyMask e + sync dpy False + +-- | Signal compliant window managers to exit. +sendReplace :: IO () +sendReplace = do + dpy <- openDisplay "" + let dflt = defaultScreen dpy + rootw <- rootWindow dpy dflt + replace dpy dflt rootw + +-- | Signal 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 + ------------------------------------------------------------------------ -- Utilities @@ -649,6 +726,7 @@ where go = withDisplay $ \d -> do ws <- gets windowset + sh <- io $ getWMNormalHints d w wa <- io $ getWindowAttributes d w let bw = (fromIntegral . wa_border_width) wa point_sc <- pointScreen (fi $ wa_x wa) (fi $ wa_y wa) @@ -663,13 +741,14 @@ sr = screenRect . W.screenDetail $ sc x = (fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr) y = (fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr) - width = fi (wa_width wa + bw*2) % fi (rect_width sr) - height = fi (wa_height wa + bw*2) % fi (rect_height sr) + (width, height) = applySizeHintsContents sh (wa_width wa, wa_height wa) + rwidth = fi (width + bw*2) % fi (rect_width sr) + rheight = fi (height + bw*2) % fi (rect_height sr) -- adjust x/y of unmanaged windows if we ignored or didn't get pointScreen, -- it might be out of bounds otherwise rr = if managed || point_sc `sr_eq` Just sc - then W.RationalRect x y width height - else W.RationalRect (0.5 - width/2) (0.5 - height/2) width height + then W.RationalRect x y rwidth rheight + else W.RationalRect (0.5 - rwidth/2) (0.5 - rheight/2) rwidth rheight return (W.screen sc, rr) diff --git a/src/XMonad/StackSet.hs b/src/XMonad/StackSet.hs --- a/src/XMonad/StackSet.hs +++ b/src/XMonad/StackSet.hs @@ -106,7 +106,10 @@ -- -- -- --- and Conor McBride's zipper differentiation paper. +-- and +-- +-- . +-- -- Another good reference is: -- $xinerama diff --git a/tests/Properties.hs b/tests/Properties.hs --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -166,11 +166,16 @@ -- tall layout ,("tile 1 window fullsize", property prop_tile_fullscreen) + ,("tile max ratio", property prop_tile_max_ratio) + ,("tile min ratio", property prop_tile_min_ratio) ,("tiles never overlap", property prop_tile_non_overlap) ,("split horizontal", property prop_split_horizontal) ,("split vertical", property prop_split_vertical) - ,("pure layout tall", property prop_purelayout_tall) + ,("pure layout tall", property prop_purelayout_tall) + {- Following two test cases should be automatically generated by QuickCheck ideally, but it fails. -} + ,("pure layout tall: ratio = 0", property (\n d rect -> prop_purelayout_tall n d 0 rect)) + ,("pure layout tall: ratio = 1", property (\n d rect -> prop_purelayout_tall n d 1 rect)) ,("send shrink tall", property prop_shrink_tall) ,("send expand tall", property prop_expand_tall) ,("send incmaster tall", property prop_incmaster_tall) diff --git a/tests/Properties/Layout/Tall.hs b/tests/Properties/Layout/Tall.hs --- a/tests/Properties/Layout/Tall.hs +++ b/tests/Properties/Layout/Tall.hs @@ -11,8 +11,9 @@ import Graphics.X11.Xlib.Types (Rectangle(..)) -import Data.Maybe +import Control.Applicative import Data.List (sort) +import Data.Maybe import Data.Ratio ------------------------------------------------------------------------ @@ -27,6 +28,22 @@ where _ = rect :: Rectangle pct = 3 % 100 +-- with a ratio of 1, no stack windows are drawn of there is at least +-- one master window around. +prop_tile_max_ratio = extremeRatio 1 drop + +-- with a ratio of 0, no master windows are drawn at all if there are +-- any stack windows around. +prop_tile_min_ratio = extremeRatio 0 take + +extremeRatio amount getRects rect = do + w@(NonNegative windows) <- arbitrary `suchThat` (> NonNegative 0) + NonNegative nmaster <- arbitrary `suchThat` (< w) + let tiled = tile amount rect nmaster windows + pure $ if nmaster == 0 + then prop_tile_non_overlap rect windows nmaster + else all ((== 0) . rect_width) $ getRects nmaster tiled + -- splitting horizontally yields sensible results prop_split_horizontal (NonNegative n) x = noOverflows (+) (rect_x x) (rect_width x) ==> @@ -49,13 +66,20 @@ -- pureLayout works. -prop_purelayout_tall n r1 r2 rect = do +prop_purelayout_tall n d r rect = do x <- (arbitrary :: Gen T) `suchThat` (isJust . peek) - let layout = Tall n r1 r2 + let layout = Tall n d r st = fromJust . stack . workspace . current $ x ts = pureLayout layout rect st + ntotal = length (index x) return $ - length ts == length (index x) + (if r == 0 then + -- (<=) for Bool is the logical implication + (0 <= n && n <= ntotal) <= (length ts == ntotal - n) + else if r == 1 then + (0 <= n && n <= ntotal) <= (length ts == n) + else + length ts == ntotal) && noOverlaps (map snd ts) && diff --git a/xmonad.cabal b/xmonad.cabal --- a/xmonad.cabal +++ b/xmonad.cabal @@ -1,5 +1,5 @@ name: xmonad -version: 0.17.2 +version: 0.18.0 synopsis: A tiling window manager description: xmonad is a tiling window manager for X. Windows are arranged automatically to tile the screen without gaps or overlap, maximising @@ -27,7 +27,7 @@ Ondřej Súkup, Paul Hebble, Shachaf Ben-Kiki, Siim Põder, Tim McIver, Trevor Elliott, Wouter Swierstra, Conrad Irwin, Tim Thelion, Tony Zorman maintainer: xmonad@haskell.org -tested-with: GHC == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.7 || == 9.4.4 || == 9.6.1 +tested-with: GHC == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.8 || == 9.4.8 || == 9.6.4 || == 9.8.1 category: System homepage: http://xmonad.org bug-reports: https://github.com/xmonad/xmonad/issues @@ -128,6 +128,9 @@ , containers , xmonad default-language: Haskell2010 + + if impl(ghc > 9.8) + ghc-options: -Wno-x-partial if flag(pedantic) ghc-options: -Werror