diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,7 +1,107 @@ # Change Log / Release Notes -## _unreleased_ +## 0.18.2 (March 7, 2026) +### Breaking Changes + + * Drop support for GHC 8.6 + +### New Modules + + * `XMonad.Util.StickyWindows` + + - Stick windows on screens so they follow you across desktops. + +### Bug Fixes and Minor Changes + + * `XMonad.Actions.WindowBringer` + + - Make sure functions that internally use their `…Args` versions + pass on the default `dmenu` arguments. + + These are also now exported as `defaultDMenuArgs` for users using + the `…Args` versions but want to augment instead of replacing the + default `dmenu` arguments. + + For users, the visible change will be that `bringMenu` and `copyMenu` + now behave identically to `gotoMenu`, as expected, instead of being + case sensitive. Users who might have been relying on the incorrect + behavior should replace `*Menu` with `*MenuArgs []`. + + * `XMonad.Util.XSelection` + + - Added `getClipboard` to query the X clipboard. + Also added `getSecondarySelection`. + + * `XMonad.Util.EZConfig` + + - Added `XF86WLAN` and `Menu` to the list of supported special keys. + + * `XMonad.Actions.DynamicProjects` + + - No longer autodelete projects when `switchProject` is called from + an empty workspace. This also fixes a bug where static workspaces + would be deleted when switching to a dynamic project. + - Improved documentation on how to close a project. + + * `XMonad.Hooks.Rescreen` + + - Allow overriding the `rescreen` operation itself. Additionally, the + `XMonad.Actions.PhysicalScreens` module now provides an alternative + implementation of `rescreen` that avoids reshuffling the workspaces if + the number of screens doesn't change and only their locations do (which + is especially common if one uses `xrandr --setmonitor` to split an + ultra-wide display in two). + + - Added an optional delay when waiting for events to settle. This may be + used to avoid flicker and unnecessary workspace reshuffling if multiple + `xrandr` commands are used to reconfigure the display layout. + + * `XMonad.Layout.NoBorders` + + - It's no longer necessary to use `borderEventHook` to garbage collect + `alwaysHidden`/`neverHidden` lists. The layout listens to + `DestroyWindowEvent` messages instead, which are broadcast to layouts + since xmonad v0.17.0. + + * `XMonad.Hooks.EwmhDesktops` + + - Added a customization option for the action that gets executed when + a client sends a **_NET_CURRENT_DESKTOP** request. It is now possible + to change it using the `setEwmhSwitchDesktopHook`. + - Added a customization option for mapping hidden workspaces to screens + when setting the **_NET_DESKTOP_VIEWPORT**. This can be done using + the `setEwmhHiddenWorkspaceToScreenMapping`. + + - Added support for **_NET_WM_STATE_{ABOVE,BELOW}** to place windows + correctly. + + * `XMonad.Layout.IndependentScreens` + + - Added `focusWorkspace` for focusing workspaces on the screen that they + belong to. + - Added `doFocus'` hook as an alternative for `doFocus` when using + IndependentScreens. + - Added `screenOnMonitor` for getting the active screen for a monitor. + + * `XMonad.Util.NamedScratchPad` + + - Fix unintended window hiding in `nsSingleScratchpadPerWorkspace`. + Only hide the previously active scratchpad. + + * `XMonad.Actions.Search` + + - Added `multiChar`, `combineChar`, and `prefixAwareChar` as + slightly generalised versions of `prefixAware` and `(!>)` that + allow specifying the character that separates a search engine's + prefix with the query when combining engines. + + - Added the `ecosia` search engine. + + * `XMonad.Hooks.ManageDocks` + + - Added `onAllDocks` to run an action on all recognised docks. + ## 0.18.1 (August 20, 2024) ### Breaking Changes @@ -421,7 +521,8 @@ * `XMonad.Config.{Arossato,Dmwit,Droundy,Monad,Prime,Saegesser,Sjanssen}` - Deprecated all of these modules. The user-specific configuration - modules may still be found [on the website]. + modules may still be found [on the + website](https://xmonad.org/configurations.html) * `XMonad.Util.NamedScratchpad` @@ -442,8 +543,6 @@ - Deprecated `urgencyConfig`; use `def` from the new `Default` instance of `UrgencyConfig` instead. -[on the website]: https://xmonad.org/configurations.html - ### New Modules * `XMonad.Actions.PerLayoutKeys` @@ -518,7 +617,8 @@ `todo +d 12 02 2024` work. - Added the ability to specify alphabetic (`#A`, `#B`, and `#C`) - [priorities] at the end of the input note. + [priorities](https://orgmode.org/manual/Priorities.html) at the end of + the input note. * `XMonad.Prompt.Unicode` @@ -612,7 +712,8 @@ - Modified `mkAbsolutePath` to support a leading environment variable, so things like `$HOME/NOTES` work. If you want more general environment - variable support, comment on [this PR]. + variable support, comment on [this + PR](https://github.com/xmonad/xmonad-contrib/pull/744) * `XMonad.Util.XUtils` @@ -651,9 +752,6 @@ - Added a `Default` instance for `UrgencyConfig` and `DzenUrgencyHook`. -[this PR]: https://github.com/xmonad/xmonad-contrib/pull/744 -[priorities]: https://orgmode.org/manual/Priorities.html - ### Other changes * Migrated the sample build scripts from the deprecated `xmonad-testing` repo to @@ -2179,8 +2277,8 @@ * `XMonad.Prompt.Pass` - This module provides 3 `XMonad.Prompt`s to ease passwords - manipulation (generate, read, remove) via [pass][]. + This module provides 3 `XMonad.Prompt`s to ease passwords manipulation + (generate, read, remove) via [pass](http://www.passwordstore.org/). * `XMonad.Util.RemoteWindows` @@ -2256,5 +2354,3 @@ ## See Also - -[pass]: http://www.passwordstore.org/ diff --git a/XMonad/Actions/CycleWindows.hs b/XMonad/Actions/CycleWindows.hs --- a/XMonad/Actions/CycleWindows.hs +++ b/XMonad/Actions/CycleWindows.hs @@ -217,8 +217,8 @@ -- | The unfocused rotation on a stack. rotUnfocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a -rotUnfocused' _ s@(W.Stack _ [] []) = s -rotUnfocused' f s@(W.Stack _ [] _ ) = rotSlaves' f s -- Master has focus -rotUnfocused' f (W.Stack t ls rs) = W.Stack t (reverse revls') rs' -- otherwise - where (master :| revls) = NE.reverse (let l:ll = ls in l :| ll) +rotUnfocused' _ s@(W.Stack _ [] []) = s +rotUnfocused' f s@(W.Stack _ [] _ ) = rotSlaves' f s -- Master has focus +rotUnfocused' f (W.Stack t ls@(l:ll) rs) = W.Stack t (reverse revls') rs' -- otherwise + where (master :| revls) = NE.reverse (l :| ll) (revls',rs') = splitAt (length ls) (f $ master:revls ++ rs) diff --git a/XMonad/Actions/DynamicProjects.hs b/XMonad/Actions/DynamicProjects.hs --- a/XMonad/Actions/DynamicProjects.hs +++ b/XMonad/Actions/DynamicProjects.hs @@ -69,7 +69,9 @@ -- the working directory to the one configured for the matching -- project. If the workspace doesn't have any windows, the project's -- start-up hook is executed. This allows you to launch applications --- or further configure the workspace/project. +-- or further configure the workspace/project. To close a project, +-- you can use the functions provided by "XMonad.Actions.DynamicWorkspaces", +-- such as @removeWorkspace@ or @removeWorkspaceByTag@. -- -- When using the @switchProjectPrompt@ function, workspaces are -- created as needed. This means you can create new project spaces @@ -230,7 +232,9 @@ -------------------------------------------------------------------------------- -- | Fetch the current project (the one being used for the currently --- active workspace). +-- active workspace). If the workspace doesn't have a project, a +-- default project is returned, using the workspace name as the +-- project name. currentProject :: X Project currentProject = do name <- gets (W.tag . W.workspace . W.current . windowset) @@ -255,20 +259,7 @@ -------------------------------------------------------------------------------- -- | Switch to the given project. switchProject :: Project -> X () -switchProject p = do - oldws <- gets (W.workspace . W.current . windowset) - oldp <- currentProject - - let name = W.tag oldws - ws = W.integrate' (W.stack oldws) - - -- If the project we are switching away from has no windows, and - -- it's a dynamic project, remove it from the configuration. - when (null ws && isNothing (projectStartHook oldp)) $ do - removeWorkspaceByTag name -- also remove the old workspace - XS.modify (\s -> s {projects = Map.delete name $ projects s}) - - appendWorkspace (projectName p) +switchProject p = appendWorkspace (projectName p) -------------------------------------------------------------------------------- -- | Prompt for a project name and then switch to it. Automatically diff --git a/XMonad/Actions/OnScreen.hs b/XMonad/Actions/OnScreen.hs --- a/XMonad/Actions/OnScreen.hs +++ b/XMonad/Actions/OnScreen.hs @@ -1,148 +1,181 @@ ------------------------------------------------------------------------------ -- | -- Module : XMonad.Actions.OnScreen -- Description : Control workspaces on different screens (in xinerama mode). --- Copyright : (c) 2009 Nils Schweinsberg +-- Copyright : (c) 2009-2025 Nils Schweinsberg -- License : BSD3-style (see LICENSE) -- --- Maintainer : Nils Schweinsberg +-- Maintainer : Nils Schweinsberg -- Stability : unstable -- Portability : unportable -- -- Control workspaces on different screens (in xinerama mode). --- ------------------------------------------------------------------------------ - -module XMonad.Actions.OnScreen ( - -- * Usage +module XMonad.Actions.OnScreen + ( -- * Usage -- $usage - onScreen - , onScreen' - , Focus(..) - , viewOnScreen - , greedyViewOnScreen - , onlyOnScreen - , toggleOnScreen - , toggleGreedyOnScreen - ) where + onScreen, + onScreen', + Focus (..), + viewOnScreen, + greedyViewOnScreen, + onlyOnScreen, + toggleOnScreen, + toggleGreedyOnScreen, + ) +where import XMonad -import XMonad.Prelude (fromMaybe, guard, empty) +import XMonad.Prelude (empty, fromMaybe, guard) import XMonad.StackSet hiding (new) - -- | Focus data definitions -data Focus = FocusNew -- ^ always focus the new screen - | FocusCurrent -- ^ always keep the focus on the current screen - | FocusTag WorkspaceId -- ^ always focus tag i on the new stack - | FocusTagVisible WorkspaceId -- ^ focus tag i only if workspace with tag i is visible on the old stack - +data Focus + = -- | always focus the new screen + FocusNew + | -- | always keep the focus on the current screen + FocusCurrent + | -- | always focus tag i on the new stack + FocusTag WorkspaceId + | -- | focus tag i only if workspace with tag i is visible on the old stack + FocusTagVisible WorkspaceId -- | Run any function that modifies the stack on a given screen. This function -- will also need to know which Screen to focus after the function has been -- run. -onScreen :: (WindowSet -> WindowSet) -- ^ function to run - -> Focus -- ^ what to do with the focus - -> ScreenId -- ^ screen id - -> WindowSet -- ^ current stack - -> WindowSet +onScreen :: + -- | function to run + (WindowSet -> WindowSet) -> + -- | what to do with the focus + Focus -> + -- | screen id + ScreenId -> + -- | current stack + WindowSet -> + WindowSet onScreen f foc sc st = fromMaybe st $ do - ws <- lookupWorkspace sc st - - let fStack = f $ view ws st + ws <- lookupWorkspace sc st - return $ setFocus foc st fStack + let fStack = f $ view ws st + return $ setFocus foc st fStack -- set focus for new stack -setFocus :: Focus - -> WindowSet -- ^ old stack - -> WindowSet -- ^ new stack - -> WindowSet -setFocus FocusNew _ new = new -setFocus FocusCurrent old new = - case lookupWorkspace (screen $ current old) new of - Nothing -> new - Just i -> view i new -setFocus (FocusTag i) _ new = view i new +setFocus :: + Focus -> + -- | old stack + WindowSet -> + -- | new stack + WindowSet -> + WindowSet +setFocus FocusNew _ new = new +setFocus FocusCurrent old new = + case lookupWorkspace (screen $ current old) new of + Nothing -> new + Just i -> view i new +setFocus (FocusTag i) _ new = view i new setFocus (FocusTagVisible i) old new = - if i `elem` map (tag . workspace) (visible old) - then setFocus (FocusTag i) old new - else setFocus FocusCurrent old new + if i `elem` map (tag . workspace) (visible old) + then setFocus (FocusTag i) old new + else setFocus FocusCurrent old new -- | A variation of @onScreen@ which will take any @X ()@ function and run it -- on the given screen. -- Warning: This function will change focus even if the function it's supposed -- to run doesn't succeed. -onScreen' :: X () -- ^ X function to run - -> Focus -- ^ focus - -> ScreenId -- ^ screen id - -> X () +onScreen' :: + -- | X function to run + X () -> + -- | focus + Focus -> + -- | screen id + ScreenId -> + X () onScreen' x foc sc = do - st <- gets windowset - case lookupWorkspace sc st of - Nothing -> return () - Just ws -> do - windows $ view ws - x - windows $ setFocus foc st - + st <- gets windowset + case lookupWorkspace sc st of + Nothing -> return () + Just ws -> do + windows $ view ws + x + windows $ setFocus foc st -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @view@ to -- switch focus to the workspace @i@. -viewOnScreen :: ScreenId -- ^ screen id - -> WorkspaceId -- ^ index of the workspace - -> WindowSet -- ^ current stack - -> WindowSet +viewOnScreen :: + -- | screen id + ScreenId -> + -- | index of the workspace + WorkspaceId -> + -- | current stack + WindowSet -> + WindowSet viewOnScreen sid i = - onScreen (view i) (FocusTag i) sid + onScreen (view i) (FocusTag i) sid -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @greedyView@ -- to switch the current workspace with workspace @i@. -greedyViewOnScreen :: ScreenId -- ^ screen id - -> WorkspaceId -- ^ index of the workspace - -> WindowSet -- ^ current stack - -> WindowSet +greedyViewOnScreen :: + -- | screen id + ScreenId -> + -- | index of the workspace + WorkspaceId -> + -- | current stack + WindowSet -> + WindowSet greedyViewOnScreen sid i = - onScreen (greedyView i) (FocusTagVisible i) sid + onScreen (greedyView i) (FocusTagVisible i) sid -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible do nothing. -onlyOnScreen :: ScreenId -- ^ screen id - -> WorkspaceId -- ^ index of the workspace - -> WindowSet -- ^ current stack - -> WindowSet +onlyOnScreen :: + -- | screen id + ScreenId -> + -- | index of the workspace + WorkspaceId -> + -- | current stack + WindowSet -> + WindowSet onlyOnScreen sid i = - onScreen (view i) FocusCurrent sid + onScreen (view i) FocusCurrent sid -- | @toggleOrView@ as in "XMonad.Actions.CycleWS" for @onScreen@ with view -toggleOnScreen :: ScreenId -- ^ screen id - -> WorkspaceId -- ^ index of the workspace - -> WindowSet -- ^ current stack - -> WindowSet +toggleOnScreen :: + -- | screen id + ScreenId -> + -- | index of the workspace + WorkspaceId -> + -- | current stack + WindowSet -> + WindowSet toggleOnScreen sid i = - onScreen (toggleOrView' view i) FocusCurrent sid + onScreen (toggleOrView' view i) FocusCurrent sid -- | @toggleOrView@ from "XMonad.Actions.CycleWS" for @onScreen@ with greedyView -toggleGreedyOnScreen :: ScreenId -- ^ screen id - -> WorkspaceId -- ^ index of the workspace - -> WindowSet -- ^ current stack - -> WindowSet +toggleGreedyOnScreen :: + -- | screen id + ScreenId -> + -- | index of the workspace + WorkspaceId -> + -- | current stack + WindowSet -> + WindowSet toggleGreedyOnScreen sid i = - onScreen (toggleOrView' greedyView i) FocusCurrent sid - + onScreen (toggleOrView' greedyView i) FocusCurrent sid -- a \"pure\" version of X.A.CycleWS.toggleOrDoSkip -toggleOrView' :: (WorkspaceId -> WindowSet -> WindowSet) -- ^ function to run - -> WorkspaceId -- ^ tag to look for - -> WindowSet -- ^ current stackset - -> WindowSet +toggleOrView' :: + -- | function to run + (WorkspaceId -> WindowSet -> WindowSet) -> + -- | tag to look for + WorkspaceId -> + -- | current stackset + WindowSet -> + WindowSet toggleOrView' f i st = fromMaybe (f i st) $ do - let st' = hidden st - -- make sure we actually have to do something - guard $ i == (tag . workspace $ current st) - case st' of - [] -> empty - (h : _) -> return $ f (tag h) st -- finally, toggle! + let st' = hidden st + -- make sure we actually have to do something + guard $ i == (tag . workspace $ current st) + case st' of + [] -> empty + (h : _) -> return $ f (tag h) st -- finally, toggle! -- $usage -- diff --git a/XMonad/Actions/PhysicalScreens.hs b/XMonad/Actions/PhysicalScreens.hs --- a/XMonad/Actions/PhysicalScreens.hs +++ b/XMonad/Actions/PhysicalScreens.hs @@ -1,4 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ParallelListComp #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.PhysicalScreens @@ -28,10 +30,13 @@ , getScreenIdAndRectangle , screenComparatorById , screenComparatorByRectangle + , rescreen ) where -import XMonad -import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy) +import Data.List.NonEmpty (nonEmpty) +import XMonad hiding (rescreen) +import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy, NonEmpty((:|))) +import qualified Data.List.NonEmpty as NE import qualified XMonad.StackSet as W {- $usage @@ -146,3 +151,53 @@ -- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter. onPrevNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X () onPrevNeighbour sc = neighbourWindows sc (-1) + +-- | An alternative to 'XMonad.Operations.rescreen' that avoids reshuffling +-- the workspaces if the number of screens doesn't change and only their +-- locations do. Useful for users of @xrandr --setmonitor@. +-- +-- See 'XMonad.Hooks.Rescreen.setRescreenWorkspacesHook', which lets you +-- replace the builtin rescreen handler. +rescreen :: ScreenComparator -> X () +rescreen (ScreenComparator cmpScreen) = withDisplay (fmap nonEmpty . getCleanedScreenInfo) >>= \case + Nothing -> trace "getCleanedScreenInfo returned []" + Just xinescs -> windows $ rescreen' xinescs + where + rescreen' :: NonEmpty Rectangle -> WindowSet -> WindowSet + rescreen' xinescs ws + | NE.length xinescs == length (W.visible ws) + 1 = rescreenSameLength xinescs ws + | otherwise = rescreenCore xinescs ws + + -- the 'XMonad.Operations.rescreen' implementation from core as a fallback + rescreenCore :: NonEmpty Rectangle -> WindowSet -> WindowSet + rescreenCore (xinesc :| xinescs) ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } = + let (xs, ys) = splitAt (length xinescs) (map W.workspace vs ++ hs) + a = W.Screen (W.workspace v) 0 (SD xinesc) + as = zipWith3 W.Screen xs [1..] $ map SD xinescs + in ws{ W.current = a + , W.visible = as + , W.hidden = ys } + + -- sort both existing screens and the screens we just got from xinerama + -- using cmpScreen, and then replace the rectangles in the WindowSet, + -- keeping the order of current/visible workspaces intact + rescreenSameLength :: NonEmpty Rectangle -> WindowSet -> WindowSet + rescreenSameLength xinescs ws = + ws{ W.current = (W.current ws){ W.screenDetail = SD newCurrentRect } + , W.visible = [ w{ W.screenDetail = SD r } | w <- W.visible ws | r <- newVisibleRects ] + } + where + undoSort = + NE.map fst $ + NE.sortBy (cmpScreen `on` (getScreenIdAndRectangle . snd)) $ + NE.zip ((0 :: Int) :| [1..]) $ -- add indices to undo the sort later + W.current ws :| W.visible ws + newCurrentRect :| newVisibleRects = + NE.map snd $ NE.sortWith fst $ NE.zip undoSort $ -- sort back into current:visible order + NE.map snd $ NE.sortBy cmpScreen $ NE.zip (0 :| [1..]) xinescs + + -- TODO: + -- If number of screens before and after isn't the same, we might still + -- try to match locations and avoid changing the workspace for those that + -- didn't move, while making sure that the current workspace is still + -- visible somewhere. diff --git a/XMonad/Actions/Search.hs b/XMonad/Actions/Search.hs --- a/XMonad/Actions/Search.hs +++ b/XMonad/Actions/Search.hs @@ -30,6 +30,9 @@ (!>), prefixAware, namedEngine, + multiChar, + combineChar, + prefixAwareChar, alpha, amazon, @@ -44,6 +47,7 @@ dictionary, duckduckgo, ebay, + ecosia, flora, github, google, @@ -89,7 +93,7 @@ import XMonad.Prompt (XPConfig (), XPrompt (showXPrompt, nextCompletion, commandToComplete), getNextCompletion, historyCompletionP, mkXPrompt) -import XMonad.Prelude (isAlphaNum, isAscii, isPrefixOf) +import XMonad.Prelude (NonEmpty ((:|)), isAlphaNum, isAscii, isPrefixOf) import XMonad.Prompt.Shell (getBrowser) import XMonad.Util.Run (safeSpawn) import XMonad.Util.XSelection (getSelection) @@ -145,6 +149,8 @@ * 'ebay' -- Ebay keyword search. +* 'ecosia' -- Ecosia search engine. + * 'flora' -- Prettier Haskell package database. * 'github' -- GitHub keyword search. @@ -339,9 +345,9 @@ searchEngineF = SearchEngine -- The engines. -alpha, amazon, arXiv, aur, clojureDocs, codesearch, cratesIo, deb, debbts, debpts, dictionary, duckduckgo, ebay, flora, - github, google, hackage, homeManager, hoogle, images, imdb, lucky, maps, mathworld, ncatlab, nixos, noogle, openstreetmap, protondb, - rosettacode, rustStd, scholar, sourcehut, stackage, steam, thesaurus, vocabulary, voidpgks_x86_64, voidpgks_x86_64_musl, wayback, +alpha, amazon, arXiv, aur, clojureDocs, codesearch, cratesIo, deb, debbts, debpts, dictionary, duckduckgo, ebay, ecosia, flora, + github, google, hackage, homeManager, hoogle, images, imdb, lucky, maps, mathworld, ncatlab, nixos, noogle, openstreetmap, protondb, + rosettacode, rustStd, scholar, sourcehut, stackage, steam, thesaurus, vocabulary, voidpgks_x86_64, voidpgks_x86_64_musl, wayback, wikipedia, wiktionary, youtube, zbmath :: SearchEngine alpha = searchEngine "alpha" "https://www.wolframalpha.com/input/?i=" amazon = searchEngine "amazon" "https://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords=" @@ -356,6 +362,7 @@ dictionary = searchEngine "dict" "https://dictionary.reference.com/browse/" duckduckgo = searchEngine "duckduckgo" "https://duckduckgo.com/?t=lm&q=" ebay = searchEngine "ebay" "https://www.ebay.com/sch/i.html?_nkw=" +ecosia = searchEngine "ecosia" "https://www.ecosia.org/search?q=" flora = searchEngine "flora" "https://flora.pm/search?q=" github = searchEngine "github" "https://github.com/search?q=" google = searchEngine "google" "https://www.google.com/search?q=" @@ -389,7 +396,7 @@ zbmath = searchEngine "zbmath" "https://zbmath.org/?q=" multi :: SearchEngine -multi = namedEngine "multi" $ foldr1 (!>) [alpha, amazon, aur, codesearch, deb, debbts, debpts, dictionary, duckduckgo, ebay, flora, github, hackage, hoogle, images, imdb, lucky, maps, mathworld, ncatlab, openstreetmap, protondb, rosettacode, scholar, sourcehut, stackage, steam, thesaurus, vocabulary, voidpgks_x86_64, voidpgks_x86_64_musl, wayback, wikipedia, wiktionary, youtube, prefixAware google] +multi = namedEngine "multi" $ foldr1 (!>) [alpha, amazon, aur, codesearch, deb, debbts, debpts, dictionary, duckduckgo, ebay, ecosia, flora, github, hackage, hoogle, images, imdb, lucky, maps, mathworld, ncatlab, openstreetmap, protondb, rosettacode, scholar, sourcehut, stackage, steam, thesaurus, vocabulary, voidpgks_x86_64, voidpgks_x86_64_musl, wayback, wikipedia, wiktionary, youtube, prefixAware google] {- | This function wraps up a search engine and creates a new one, which works like the argument, but goes directly to a URL if one is given rather than @@ -401,11 +408,27 @@ intelligent :: SearchEngine -> SearchEngine intelligent (SearchEngine name site) = searchEngineF name (\s -> if takeWhile (/= ':') s `elem` ["http", "https", "ftp"] then s else site s) --- | > removeColonPrefix "foo://bar" ~> "//bar" --- > removeColonPrefix "foo//bar" ~> "foo//bar" -removeColonPrefix :: String -> String -removeColonPrefix s = if ':' `elem` s then drop 1 $ dropWhile (':' /=) s else s +-- >>> rmChar ':' "foo://bar" +-- "//bar" +-- >>> rmChar 'z' "foo://bar" +-- "foo://bar" +rmChar :: Char -> String -> String +rmChar c s = if c `elem` s then drop 1 (dropWhile (c /=) s) else s +-- | Connect the given list of search engines into one. Selecting a search +-- engine works by its prefix, separated by the given separation character. +-- This is a generalisation of '(!>)' and 'prefixAware' with a custom +-- character that separates the prefix from the query. The first search engine +-- is the fallback; for example, +-- +-- > multiChar ':' (google :| [wikipedia, mathworld]) +-- +-- is equivalent to +-- +-- > wikipedia !> mathworld !> (prefixAware google) +multiChar :: Char -> NonEmpty SearchEngine -> SearchEngine +multiChar c (se :| ses) = foldr (combineChar c) (prefixAwareChar c se) ses + {- | Connects a few search engines into one. If the search engines\' names are \"s1\", \"s2\" and \"s3\", then the resulting engine will use s1 if the query is @s1:word@, s2 if you type @s2:word@ and s3 in all other cases. @@ -418,15 +441,29 @@ \"mathworld:integral\" will search mathworld, and everything else will fall back to google. The use of intelligent will make sure that URLs are opened directly. -} (!>) :: SearchEngine -> SearchEngine -> SearchEngine -(SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if (name1++":") `isPrefixOf` s then site1 (removeColonPrefix s) else site2 s) +(!>) = combineChar ':' infixr 6 !> +-- | @combineChar c s s'@ combines the search engines @s@ and @s'@ into one, +-- where prefixes are separated by the character @c@. It works analogously to +-- '(!>)', only with a chosen separating character: @combineChar ':'@ is the +-- same as '(!>)'. +combineChar :: Char -> SearchEngine -> SearchEngine -> SearchEngine +combineChar c (SearchEngine name1 site1) (SearchEngine name2 site2) = + searchEngineF (name1 ++ "/" ++ name2) (\s -> if (name1++[c]) `isPrefixOf` s then site1 (rmChar c s) else site2 s) + {- | Makes a search engine prefix-aware. Especially useful together with '!>'. It will automatically remove the prefix from a query so that you don\'t end up searching for google:xmonad if google is your fallback engine and you explicitly add the prefix. -} prefixAware :: SearchEngine -> SearchEngine -prefixAware (SearchEngine name site) = SearchEngine name (\s -> if (name++":") `isPrefixOf` s then site $ removeColonPrefix s else site s) +prefixAware = prefixAwareChar ':' + +-- | Like 'prefixAware', but one gets to choose the character that separates +-- the prefix from the search query. +prefixAwareChar :: Char -> SearchEngine -> SearchEngine +prefixAwareChar c (SearchEngine name site) = + SearchEngine name (\s -> if (name++[c]) `isPrefixOf` s then site (rmChar c s) else site s) {- | Changes search engine's name -} namedEngine :: Name -> SearchEngine -> SearchEngine diff --git a/XMonad/Actions/UpKeys.hs b/XMonad/Actions/UpKeys.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/UpKeys.hs @@ -0,0 +1,169 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TypeApplications #-} +{- | + Module : XMonad.Actions.UpKeys + Description : Bind an action to the release of a key + Copyright : (c) Tony Zorman, 2024 + License : BSD-3 + Maintainer : Tony Zorman + +A combinator for binding an action to the release of a key. This can be +useful for hold-type buttons, where the press of a key engages some +functionality, and its release… releases it again. +-} +module XMonad.Actions.UpKeys + ( -- * Usage + -- $usage + useUpKeys, + UpKeysConfig (..), + ezUpKeys, + ) +where + +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import XMonad +import XMonad.Prelude +import XMonad.Util.EZConfig (mkKeymap) +import qualified XMonad.Util.ExtensibleConf as XC + +{- $usage +You can use this module with the following in your @xmonad.hs@: + +> import XMonad.Actions.UpKeys + +Next, define the keys and actions you want to have happen on the release +of a key: + +> myUpKeys = ezUpKeys $ +> [ ("M-z", myAction) +> , ("M-a", myAction2) +> ] + +All that's left is to plug this definition into the 'useUpKeys' +combinator that this module provides: + +> main :: IO () +> main = xmonad +> . useUpKeys (def{ grabKeys = True, upKeys = myUpKeys }) +> $ myConfig + +Note the presence of @'grabKeys' = True@; this is for situations where +you don't have any of these keys bound to do something upon pressing +them; i.e., you use them solely for their release actions. If you want +something to happen in both cases, remove that part (@'grabKeys' = +False@ is the default) and bind the keys to actions as you normally +would. + +==== __Examples__ + +As an extended example, consider the case where you want all of your +docks (e.g., status bar) to "pop up" when you press the super key, and +then vanish again once that keys is released. + +Since docks are not generally part of XMonad's window-set—otherwise, we +would have to manage them—we first need a way to access and manipulate +all docks. + +> onAllDocks :: (Display -> Window -> IO ()) -> X () +> onAllDocks act = withDisplay \dpy -> do +> rootw <- asks theRoot +> (_, _, wins) <- io $ queryTree dpy rootw +> traverse_ (io . act dpy) =<< filterM (runQuery checkDock) wins + +This is also the place where one could filter for just status bar, +trayer, and so on. + +Now we have to decide what kinds of keys we want to watch out for. Since +you most likely use left super as your modifier key, this is a little +bit more complicated than for other keys, as you will most likely see +the key both as a @KeyMask@, as well as a @KeySym@. One could think a +bit and probably come up with an elegant solution for this—or one could +grab all possible key combinations by brute-force! + +> dockKeys :: X () -> [((KeyMask, KeySym), X ())] +> dockKeys act = map (actKey . foldr1 (.|.)) . combinations $ keyMasks +> where +> actKey :: KeyMask -> ((KeyMask, KeySym), X ()) +> actKey mask = ((mask, xK_Super_L), act) +> +> keyMasks :: [KeyMask] +> keyMasks = [ noModMask, shiftMask, lockMask, controlMask, mod1Mask, mod2Mask, mod3Mask, mod4Mask, mod5Mask ] +> +> -- Return all combinations of a sequence of values. +> combinations :: [a] -> [[a]] +> combinations xs = concat [combs i xs | i <- [1 .. length xs]] +> where +> combs 0 _ = [[]] +> combs _ [] = [] +> combs n (x:xs) = map (x:) (combs (n-1) xs) <> combs n xs + +Given some action, like lowering or raising the window, we generate all +possible combinations of modifiers that may be pressed with the super +key. This is a good time to say that this is just for demonstrative +purposes, btw—please don't actually do this. + +All that's left is to plug everything into the machinery of this module, +and we're done! + +> import qualified Data.Map.Strict as Map +> +> main :: IO () +> main = xmonad +> . … -- other combinators +> . useUpKeys (def { upKeys = Map.fromList $ dockKeys (onAllDocks lowerWindow) }) +> $ myConfig `additionalKeys` dockKeys (onAllDocks raiseWindow) +> +> myConfig = … +-} + +data UpKeysConfig = UpKeysConfig + { -- | Whether to grab all keys that are not already grabbed. + grabKeys :: !Bool + -- | The keys themselves. + , upKeys :: !(Map (KeyMask, KeySym) (X ())) + } + +-- | The default 'UpKeysConfig'; keys are not grabbed, and no upkeys are +-- specified. +instance Default UpKeysConfig where + def :: UpKeysConfig + def = UpKeysConfig { grabKeys = False, upKeys = mempty } + +instance Semigroup UpKeysConfig where + (<>) :: UpKeysConfig -> UpKeysConfig -> UpKeysConfig + UpKeysConfig g u <> UpKeysConfig g' u' = UpKeysConfig (g && g') (u <> u') + +-- | Bind actions to keys upon their release. +useUpKeys :: UpKeysConfig -> (XConfig l -> XConfig l) +useUpKeys upKeysConf = flip XC.once upKeysConf \conf -> conf + { handleEventHook = handleEventHook conf <> (\e -> handleKeyUp e $> All True) + , startupHook = startupHook conf <> when (grabKeys upKeysConf) grabUpKeys + } + where + grabUpKeys :: X () + grabUpKeys = do + XConf{ display = dpy, theRoot = rootw } <- ask + realKeys <- maybe mempty upKeys <$> XC.ask @X @UpKeysConfig + let grab :: (KeyMask, KeyCode) -> X () + grab (km, kc) = io $ grabKey dpy kc km rootw True grabModeAsync grabModeAsync + traverse_ grab =<< mkGrabs (Map.keys realKeys) + +-- | Parse the given EZConfig-style keys into the internal keymap +-- representation. +-- +-- This is just 'mkKeymap' with a better name. +ezUpKeys :: XConfig l -> [(String, X ())] -> Map (KeyMask, KeySym) (X ()) +ezUpKeys = mkKeymap + +-- | A handler for key-up events. +handleKeyUp :: Event -> X () +handleKeyUp KeyEvent{ ev_event_type, ev_state, ev_keycode } + | ev_event_type == keyRelease = withDisplay \dpy -> do + s <- io $ keycodeToKeysym dpy ev_keycode 0 + cln <- cleanMask ev_state + ks <- maybe mempty upKeys <$> XC.ask @X @UpKeysConfig + userCodeDef () $ whenJust (ks Map.!? (cln, s)) id +handleKeyUp _ = pure () diff --git a/XMonad/Actions/WindowBringer.hs b/XMonad/Actions/WindowBringer.hs --- a/XMonad/Actions/WindowBringer.hs +++ b/XMonad/Actions/WindowBringer.hs @@ -23,7 +23,8 @@ gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs', bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs', copyMenu, copyMenuConfig, copyMenu', copyMenuArgs, copyMenuArgs', - windowMap, windowAppMap, windowMap', bringWindow, actionMenu + windowMap, windowAppMap, windowMap', bringWindow, actionMenu, + defaultDMenuArgs ) where import Control.Monad @@ -51,6 +52,11 @@ -- For detailed instructions on editing your key bindings, see -- . +-- | The default arguments passed to dmenu. You may want to use this with +-- the *MenuArgs functions. +defaultDMenuArgs :: [String] +defaultDMenuArgs = ["-i"] + data WindowBringerConfig = WindowBringerConfig { menuCommand :: String -- ^ The shell command that will handle window selection , menuArgs :: [String] -- ^ Arguments to be passed to menuCommand @@ -60,7 +66,7 @@ instance Default WindowBringerConfig where def = WindowBringerConfig{ menuCommand = "dmenu" - , menuArgs = ["-i"] + , menuArgs = defaultDMenuArgs , windowTitler = decorateName , windowFilter = \_ -> return True } @@ -95,7 +101,7 @@ -- | Pops open a dmenu with window titles. Choose one, and it will be copied into your current workspace. copyMenu :: X () -copyMenu = copyMenuArgs def +copyMenu = copyMenuArgs defaultDMenuArgs -- | Pops open a dmenu with window titles. Choose one, and it will be -- copied into your current workspace. This version @@ -127,7 +133,7 @@ -- | Pops open a dmenu with window titles. Choose one, and it will be -- dragged, kicking and screaming, into your current workspace. bringMenu :: X () -bringMenu = bringMenuArgs def +bringMenu = bringMenuArgs defaultDMenuArgs -- | Pops open a dmenu with window titles. Choose one, and it will be -- dragged, kicking and screaming, into your current workspace. This version diff --git a/XMonad/Config/Prime.hs b/XMonad/Config/Prime.hs --- a/XMonad/Config/Prime.hs +++ b/XMonad/Config/Prime.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, UndecidableInstances #-} ----------------------------------------------------------------------------- diff --git a/XMonad/Hooks/DebugEvents.hs b/XMonad/Hooks/DebugEvents.hs --- a/XMonad/Hooks/DebugEvents.hs +++ b/XMonad/Hooks/DebugEvents.hs @@ -33,7 +33,6 @@ -- import Graphics.X11.Xlib.Extras.GetAtomName (getAtomName) import Control.Exception as E -import Control.Monad.Fail import Control.Monad.State import Control.Monad.Reader import Codec.Binary.UTF8.String diff --git a/XMonad/Hooks/DynamicIcons.hs b/XMonad/Hooks/DynamicIcons.hs --- a/XMonad/Hooks/DynamicIcons.hs +++ b/XMonad/Hooks/DynamicIcons.hs @@ -3,10 +3,10 @@ -- | -- Module : XMonad.Hooks.DynamicIcons -- Description : Dynamically update workspace names based on its contents\/windows on it. --- Copyright : (c) Will Pierlot +-- Copyright : (c) Ivy Pierlot -- License : BSD3-style (see LICENSE) -- --- Maintainer : Will Pierlot +-- Maintainer : Ivy Pierlot -- Stability : unstable -- Portability : unportable -- diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs --- a/XMonad/Hooks/EwmhDesktops.hs +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -42,6 +42,10 @@ -- $customActivate setEwmhActivateHook, + -- ** Workspace switching + -- $customWorkspaceSwitch + setEwmhSwitchDesktopHook, + -- ** Fullscreen -- $customFullscreen setEwmhFullscreenHooks, @@ -50,6 +54,12 @@ -- $customManageDesktopViewport disableEwmhManageDesktopViewport, + -- $customHiddenWorkspaceMapper + setEwmhHiddenWorkspaceToScreenMapping, + -- ** @_NET_WM_STATE_{ABOVE,BELOW}@ + -- $customManageAboveBelowState + enableEwmhManageAboveBelowState, + -- * Standalone hooks (deprecated) ewmhDesktopsStartup, ewmhDesktopsLogHook, @@ -97,7 +107,8 @@ ewmh :: XConfig a -> XConfig a ewmh c = c { startupHook = ewmhDesktopsStartup <> startupHook c , handleEventHook = ewmhDesktopsEventHook <> handleEventHook c - , logHook = ewmhDesktopsLogHook <> logHook c } + , logHook = ewmhDesktopsLogHook <> logHook c + , manageHook = ewmhDesktopsManageHook' <> manageHook c } -- $customization @@ -114,8 +125,14 @@ -- ^ configurable handling of window activation requests , fullscreenHooks :: (ManageHook, ManageHook) -- ^ configurable handling of fullscreen state requests + , switchDesktopHook :: WorkspaceId -> WindowSet -> WindowSet + -- ^ configurable action for handling _NET_CURRENT_DESKTOP , manageDesktopViewport :: Bool -- ^ manage @_NET_DESKTOP_VIEWPORT@? + , hiddenWorkspaceToScreen :: WindowSet -> WindowSpace -> WindowScreen + -- ^ map hidden workspaces to screens for @_NET_DESKTOP_VIEWPORT@ + , handleAboveBelowState :: Bool + -- ^ handle @_NET_WM_STATE_ABOVE@ and @_NET_WM_STATE_BELOW@? } instance Default EwmhDesktopsConfig where @@ -124,7 +141,11 @@ , workspaceRename = pure pure , activateHook = doFocus , fullscreenHooks = (doFullFloat, doSink) + , switchDesktopHook = W.view , manageDesktopViewport = True + -- Hidden workspaces are mapped to the current screen by default. + , hiddenWorkspaceToScreen = \winset _ -> W.current winset + , handleAboveBelowState = False } @@ -231,8 +252,8 @@ -- > [ className =? "Google-chrome" <||> className =? "google-chrome" -?> doAskUrgent -- > , pure True -?> doFocus ] -- --- See "XMonad.ManageHook", "XMonad.Hooks.ManageHelpers" and "XMonad.Hooks.Focus" --- for functions that can be useful here. +-- See "XMonad.ManageHook", "XMonad.Hooks.ManageHelpers", "XMonad.Hooks.Focus" and +-- "XMonad.Layout.IndependentScreens" for functions that can be useful here. -- | Set (replace) the hook which is invoked when a client sends a -- @_NET_ACTIVE_WINDOW@ request to activate a window. The default is 'doFocus' @@ -245,6 +266,31 @@ setEwmhActivateHook h = XC.modifyDef $ \c -> c{ activateHook = h } +-- $customWorkspaceSwitch +-- When a client sends a @_NET_CURRENT_DESKTOP@ request to switch to a workspace, +-- the default action used to do that is the 'W.view' function. +-- This may not be the desired behaviour in all configurations. +-- +-- For example if using the "XMonad.Layout.IndependentScreens" the default action +-- might move a workspace to a screen that it isn't supposed to be on. +-- This behaviour can be fixed using the following: +-- +-- > import XMonad.Actions.OnScreen +-- > import XMonad.Layout.IndependentScreens +-- > +-- > main = xmonad $ ... . setEwmhSwitchDesktopHook focusWorkspace . ewmh . ... $ +-- > def{ +-- > ... +-- > workspaces = withScreens 2 (workspaces def) +-- > ... +-- > } + +-- | Set (replace) the action which is invoked when a client sends a +-- @_NET_CURRENT_DESKTOP@ request to switch workspace. +setEwmhSwitchDesktopHook :: (WorkspaceId -> WindowSet -> WindowSet) -> XConfig l -> XConfig l +setEwmhSwitchDesktopHook action = XC.modifyDef $ \c -> c{ switchDesktopHook = action } + + -- $customFullscreen -- When a client sends a @_NET_WM_STATE@ request to add\/remove\/toggle the -- @_NET_WM_STATE_FULLSCREEN@ state, 'ewmhFullscreen' uses a pair of hooks to @@ -283,11 +329,98 @@ disableEwmhManageDesktopViewport :: XConfig l -> XConfig l disableEwmhManageDesktopViewport = XC.modifyDef $ \c -> c{ manageDesktopViewport = False } +-- $customManageAboveBelowState +-- Some applications use the @_NET_WM_STATE_ABOVE@ and @_NET_WM_STATE_BELOW@ +-- states to request being kept above or below other windows. By default, xmonad +-- does not handle these states. To enable handling of these states, you can use +-- the following hook: +-- +-- > main = xmonad $ … . enableEwmhManageAboveBelowState . ewmh . … $ def{…} +-- +-- This will make xmonad respond to requests to set these states by calling +-- lowerWindow and raiseWindow respectively. +enableEwmhManageAboveBelowState :: XConfig l -> XConfig l +enableEwmhManageAboveBelowState = XC.modifyDef (\c -> c{handleAboveBelowState = True}) +aboveBelowManageHook :: ManageHook +aboveBelowManageHook = + ((isEnabled <&&> isInProperty "_NET_WM_STATE" "_NET_WM_STATE_BELOW") --> doLower) + <> ((isEnabled <&&> isInProperty "_NET_WM_STATE" "_NET_WM_STATE_ABOVE") --> doRaise) + where + isEnabled = liftX (XC.withDef (pure . handleAboveBelowState)) + +aboveBelowEventHook :: Event -> X () +aboveBelowEventHook + ClientMessageEvent{ev_event_display = dpy, ev_window = w, ev_message_type = typ, ev_data = action : dats} = + do + wmstate <- getAtom "_NET_WM_STATE" + above <- getAtom "_NET_WM_STATE_ABOVE" + below <- getAtom "_NET_WM_STATE_BELOW" + + wstate <- fromMaybe [] <$> getProp32 wmstate w + + let isAbove = fi above `elem` wstate + isBelow = fi below `elem` wstate + chWstate f = io $ changeProperty32 dpy w wmstate aTOM propModeReplace (f wstate) + raise = chWstate (filter (/= fi below) . (fi above :)) >> io (raiseWindow dpy w) + lower = chWstate (filter (/= fi above) . (fi below :)) >> io (lowerWindow dpy w) + clear st = chWstate (filter (/= fi st)) + when (typ == wmstate) $ + if + -- remove + | action == 0 -> do + when (fi above `elem` dats && isAbove) $ clear above + when (fi below `elem` dats && isBelow) $ clear below + -- add + | action == 1 -> do + when (fi above `elem` dats && not isAbove) raise + when (fi below `elem` dats && not isBelow) lower + -- toggle + | action == 2 -> do + when (fi above `elem` dats) $ + if isAbove + then clear above + else raise + when (fi below `elem` dats) $ + if isBelow + then clear below + else lower + | otherwise -> trace ("Bad _NET_WM_STATE with data =" <> show action) + mempty +aboveBelowEventHook _ = mempty + +-- $customHiddenWorkspaceMapper +-- +-- Mapping the hidden workspaces to the current screen is a good default behavior, +-- but it makes the assumption that workspaces don't belong to a sepcific screen. +-- If the default behaviour is undesired, for example when using "XMonad.Layout.IndependentScreens", +-- it can be customized. +-- +-- The following example demonstrates a way to configure the mapping when using "XMonad.Layout.IndependentScreens": +-- +-- > import XMonad.Layout.IndependentScreens +-- > +-- > customMapper :: WindowSet -> (WindowSpace -> WindowScreen) +-- > customMapper winset (Workspace wsid _ _) = fromMaybe (W.current winset) maybeMappedScreen +-- > where +-- > screenId = unmarshallS wsid +-- > maybeMappedScreen = screenOnMonitor screenId winset +-- > +-- > +-- > main = xmonad $ ... . setEwmhHiddenWorkspaceToScreenMapping customMapper . ewmh . ... $ def{...} + +-- | Set (replace) the function responsible for mapping the hidden workspaces to screens. +setEwmhHiddenWorkspaceToScreenMapping :: (WindowSet -> (WindowSpace -> WindowScreen)) + -- ^ Function that given the current WindowSet + -- produces a function to maps a (hidden) workspace to a screen. + -> XConfig l -> XConfig l +setEwmhHiddenWorkspaceToScreenMapping mapper = XC.modifyDef $ \c -> c{ hiddenWorkspaceToScreen = mapper } + + -- | Initializes EwmhDesktops and advertises EWMH support to the X server. {-# DEPRECATED ewmhDesktopsStartup "Use ewmh instead." #-} ewmhDesktopsStartup :: X () -ewmhDesktopsStartup = setSupported +ewmhDesktopsStartup = setSupported >> XC.withDef ewmhDesktopsStartupHook' -- | Notifies pagers and window lists, such as those in the gnome-panel of the -- current state of workspaces and windows. @@ -302,6 +435,12 @@ ewmhDesktopsLogHookCustom f = ewmhDesktopsLogHook' def{ workspaceSort = (f .) <$> workspaceSort def } +-- | Manage hook that EWMH extensions can hook into. Should be named +-- ewmhDesktopsManageHook for consistency with ewmhDesktopsLogHook for example, +-- but that name is taken. +ewmhDesktopsManageHook' :: ManageHook +ewmhDesktopsManageHook' = aboveBelowManageHook + -- | Intercepts messages from pagers and similar applications and reacts on them. -- -- Currently supports: @@ -357,8 +496,14 @@ whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X () whenChanged = whenX . XS.modified . const +ewmhDesktopsStartupHook' :: EwmhDesktopsConfig -> X () +ewmhDesktopsStartupHook' EwmhDesktopsConfig{handleAboveBelowState} = + when + handleAboveBelowState + (addSupported ["_NET_WM_STATE", "_NET_WM_STATE_ABOVE", "_NET_WM_STATE_BELOW"]) + ewmhDesktopsLogHook' :: EwmhDesktopsConfig -> X () -ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename, manageDesktopViewport} = withWindowSet $ \s -> do +ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename, manageDesktopViewport, hiddenWorkspaceToScreen} = withWindowSet $ \s -> do sort' <- workspaceSort let ws = sort' $ W.workspaces s @@ -423,19 +568,21 @@ when manageDesktopViewport $ do let visibleScreens = W.current s : W.visible s currentTags = map (W.tag . W.workspace) visibleScreens - whenChanged (MonitorTags currentTags) $ mkViewPorts s (map W.tag ws) + whenChanged (MonitorTags currentTags) $ mkViewPorts s hiddenWorkspaceToScreen (map W.tag ws) -- | Create the viewports from the current 'WindowSet' and a list of -- already sorted workspace IDs. -mkViewPorts :: WindowSet -> [WorkspaceId] -> X () -mkViewPorts winset = setDesktopViewport . concat . mapMaybe (viewPorts M.!?) +mkViewPorts :: WindowSet -> (WindowSet -> WindowSpace -> WindowScreen) -> [WorkspaceId] -> X () +mkViewPorts winset hiddenWorkspaceMapper = setDesktopViewport . concat . mapMaybe (viewPorts M.!?) where foc = W.current winset - -- Hidden workspaces are mapped to the current screen's viewport. viewPorts :: M.Map WorkspaceId [Position] viewPorts = M.fromList $ map mkVisibleViewPort (foc : W.visible winset) - ++ map (mkViewPort foc) (W.hidden winset) + ++ map (uncurry mkViewPort) hiddenWorkspacesWithScreens + hiddenWorkspacesWithScreens :: [(WindowScreen,WindowSpace)] + hiddenWorkspacesWithScreens = map (\x -> (hiddenWorkspaceMapper winset x, x)) (W.hidden winset) + mkViewPort :: WindowScreen -> WindowSpace -> (WorkspaceId, [Position]) mkViewPort scr w = (W.tag w, mkPos scr) @@ -448,8 +595,8 @@ ewmhDesktopsEventHook' :: Event -> EwmhDesktopsConfig -> X All ewmhDesktopsEventHook' - ClientMessageEvent{ev_window = w, ev_message_type = mt, ev_data = d} - EwmhDesktopsConfig{workspaceSort, activateHook} = + e@ClientMessageEvent{ev_window = w, ev_message_type = mt, ev_data = d} + EwmhDesktopsConfig{workspaceSort, activateHook, switchDesktopHook, handleAboveBelowState} = withWindowSet $ \s -> do sort' <- workspaceSort let ws = sort' $ W.workspaces s @@ -462,7 +609,7 @@ if | mt == a_cw -> killWindow w | mt == a_cd, n : _ <- d, Just ww <- ws !? fi n -> - if W.currentTag s == W.tag ww then mempty else windows $ W.view (W.tag ww) + if W.currentTag s == W.tag ww then mempty else windows $ switchDesktopHook (W.tag ww) | mt == a_cd -> trace $ "Bad _NET_CURRENT_DESKTOP with data=" ++ show d | not (w `W.member` s) -> @@ -484,7 +631,7 @@ -- The Message is unknown to us, but that is ok, not all are meant -- to be handled by the window manager mempty - + when handleAboveBelowState (aboveBelowEventHook e) mempty ewmhDesktopsEventHook' _ _ = mempty diff --git a/XMonad/Hooks/ManageDocks.hs b/XMonad/Hooks/ManageDocks.hs --- a/XMonad/Hooks/ManageDocks.hs +++ b/XMonad/Hooks/ManageDocks.hs @@ -16,7 +16,7 @@ module XMonad.Hooks.ManageDocks ( -- * Usage -- $usage - docks, manageDocks, checkDock, AvoidStruts(..), avoidStruts, avoidStrutsOn, + docks, manageDocks, checkDock, AvoidStruts(..), avoidStruts, avoidStrutsOn, onAllDocks, ToggleStruts(..), SetStruts(..), module XMonad.Util.Types, @@ -134,6 +134,10 @@ strut <- getStrut w pure $ M.insert w strut cache +-- | Perform the given action on all docks. +onAllDocks :: (Window -> X ()) -> X () +onAllDocks act = traverse_ (act . fst) . M.toList =<< getStrutCache + -- | Detects if the given window is of type DOCK and if so, reveals -- it, but does not manage it. manageDocks :: ManageHook @@ -343,9 +347,5 @@ -- Precondition for every input range @(x, y)@: @x '<=' y@. -- -- A range @(x, y)@ is assumed to include every pixel from @x@ to @y@. - overlaps :: Ord a => (a, a) -> (a, a) -> Bool -(a, b) `overlaps` (x, y) = - inRange (a, b) x || inRange (a, b) y || inRange (x, y) a - where - inRange (i, j) k = i <= k && k <= j +(a, b) `overlaps` (x, y) = not (b < x || y < a) -- not disjoint diff --git a/XMonad/Hooks/Rescreen.hs b/XMonad/Hooks/Rescreen.hs --- a/XMonad/Hooks/Rescreen.hs +++ b/XMonad/Hooks/Rescreen.hs @@ -15,10 +15,13 @@ -- $usage addAfterRescreenHook, addRandrChangeHook, + setRescreenWorkspacesHook, + setRescreenDelay, RescreenConfig(..), rescreenHook, ) where +import Control.Concurrent (threadDelay) import Graphics.X11.Xrandr import XMonad import XMonad.Prelude @@ -59,16 +62,21 @@ data RescreenConfig = RescreenConfig { afterRescreenHook :: X () -- ^ hook to invoke after 'rescreen' , randrChangeHook :: X () -- ^ hook for other randr changes, e.g. (dis)connects + , rescreenWorkspacesHook :: Last (X ()) -- ^ hook to invoke instead of 'rescreen' + , rescreenDelay :: Last Int -- ^ delay (in microseconds) to wait for events to settle } instance Default RescreenConfig where def = RescreenConfig { afterRescreenHook = mempty , randrChangeHook = mempty + , rescreenWorkspacesHook = mempty + , rescreenDelay = mempty } instance Semigroup RescreenConfig where - RescreenConfig arh rch <> RescreenConfig arh' rch' = RescreenConfig (arh <> arh') (rch <> rch') + RescreenConfig arh rch rwh rd <> RescreenConfig arh' rch' rwh' rd' = + RescreenConfig (arh <> arh') (rch <> rch') (rwh <> rwh') (rd <> rd') instance Monoid RescreenConfig where mempty = def @@ -89,21 +97,46 @@ -- 'randrChangeHook' may be used to automatically trigger xrandr (or perhaps -- autorandr) when outputs are (dis)connected. -- +-- 'rescreenWorkspacesHook' allows tweaking the 'rescreen' implementation, +-- to change the order workspaces are assigned to physical screens for +-- example. +-- +-- 'rescreenDelay' makes xmonad wait a bit for events to settle (after the +-- first event is received) — useful when multiple @xrandr@ invocations are +-- being used to change the screen layout. +-- -- Note that 'rescreenHook' is safe to use several times, 'rescreen' is still --- done just once and hooks are invoked in sequence, also just once. +-- done just once and hooks are invoked in sequence (except +-- 'rescreenWorkspacesHook', which has a replace rather than sequence +-- semantics), also just once. rescreenHook :: RescreenConfig -> XConfig l -> XConfig l -rescreenHook = XC.once $ \c -> c - { startupHook = startupHook c <> rescreenStartupHook - , handleEventHook = handleEventHook c <> rescreenEventHook } +rescreenHook = XC.once hook . catchUserCode + where + hook c = c + { startupHook = startupHook c <> rescreenStartupHook + , handleEventHook = handleEventHook c <> rescreenEventHook } + catchUserCode rc@RescreenConfig{..} = rc + { afterRescreenHook = userCodeDef () afterRescreenHook + , randrChangeHook = userCodeDef () randrChangeHook + , rescreenWorkspacesHook = flip catchX rescreen <$> rescreenWorkspacesHook + } -- | Shortcut for 'rescreenHook'. addAfterRescreenHook :: X () -> XConfig l -> XConfig l -addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = userCodeDef () h } +addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = h } -- | Shortcut for 'rescreenHook'. addRandrChangeHook :: X () -> XConfig l -> XConfig l -addRandrChangeHook h = rescreenHook def{ randrChangeHook = userCodeDef () h } +addRandrChangeHook h = rescreenHook def{ randrChangeHook = h } +-- | Shortcut for 'rescreenHook'. +setRescreenWorkspacesHook :: X () -> XConfig l -> XConfig l +setRescreenWorkspacesHook h = rescreenHook def{ rescreenWorkspacesHook = pure h } + +-- | Shortcut for 'rescreenHook'. +setRescreenDelay :: Int -> XConfig l -> XConfig l +setRescreenDelay d = rescreenHook def{ rescreenDelay = pure d } + -- | Startup hook to listen for @RRScreenChangeNotify@ events. rescreenStartupHook :: X () rescreenStartupHook = do @@ -126,13 +159,14 @@ handleEvent e = XC.with $ \RescreenConfig{..} -> do -- Xorg emits several events after every change, clear them to prevent -- triggering the hook multiple times. + whenJust (getLast rescreenDelay) (io . threadDelay) moreConfigureEvents <- clearTypedWindowEvents (ev_window e) configureNotify _ <- clearTypedWindowRREvents (ev_window e) rrScreenChangeNotify -- If there were any ConfigureEvents, this is an actual screen -- configuration change, so rescreen and fire rescreenHook. Otherwise, -- this is just a connect/disconnect, fire randrChangeHook. if ev_event_type e == configureNotify || moreConfigureEvents - then rescreen >> afterRescreenHook + then fromMaybe rescreen (getLast rescreenWorkspacesHook) >> afterRescreenHook else randrChangeHook -- | Remove all X events of a given window and type from the event queue, diff --git a/XMonad/Hooks/ScreenCorners.hs b/XMonad/Hooks/ScreenCorners.hs --- a/XMonad/Hooks/ScreenCorners.hs +++ b/XMonad/Hooks/ScreenCorners.hs @@ -1,52 +1,51 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-} ------------------------------------------------------------------------------ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TupleSections #-} + -- | -- Module : XMonad.Hooks.ScreenCorners -- Description : Run X () actions by touching the edge of your screen with your mouse. --- Copyright : (c) 2009 Nils Schweinsberg, 2015 Evgeny Kurnevsky, 2024 Yuanle Song +-- Copyright : (c) 2009-2025 Nils Schweinsberg, 2015 Evgeny Kurnevsky, 2024 Yuanle Song -- License : BSD3-style (see LICENSE) -- --- Maintainer : Nils Schweinsberg +-- Maintainer : Nils Schweinsberg -- Stability : unstable -- Portability : unportable -- -- Run @X ()@ actions by touching the edge of your screen with your mouse. --- ------------------------------------------------------------------------------ - module XMonad.Hooks.ScreenCorners - ( - -- * Usage + ( -- * Usage -- $usage -- * Adding screen corners - ScreenCorner (..) - , addScreenCorner - , addScreenCorners + ScreenCorner (..), + addScreenCorner, + addScreenCorners, -- * Event hook - , screenCornerEventHook + screenCornerEventHook, -- * Layout hook - , screenCornerLayoutHook - ) where + screenCornerLayoutHook, + ) +where -import XMonad.Prelude +import qualified Data.Map as M import XMonad import XMonad.Layout.LayoutModifier - -import qualified Data.Map as M +import XMonad.Prelude import qualified XMonad.Util.ExtensibleState as XS -data ScreenCorner = SCUpperLeft - | SCUpperRight - | SCLowerLeft - | SCLowerRight - | SCTop - | SCBottom - | SCLeft - | SCRight - deriving (Eq, Ord, Show) +data ScreenCorner + = SCUpperLeft + | SCUpperRight + | SCLowerLeft + | SCLowerRight + | SCTop + | SCBottom + | SCLeft + | SCRight + deriving (Eq, Ord, Show) -------------------------------------------------------------------------------- -- ExtensibleState modifications @@ -55,25 +54,22 @@ newtype ScreenCornerState = ScreenCornerState (M.Map Window (ScreenCorner, X ())) instance ExtensionClass ScreenCornerState where - initialValue = ScreenCornerState M.empty + initialValue = ScreenCornerState M.empty -- | Add one single @X ()@ action to a screen corner addScreenCorner :: ScreenCorner -> X () -> X () addScreenCorner corner xF = do - - ScreenCornerState m <- XS.get - (win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of - - Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions - Nothing -> (, xF) <$> createWindowAt corner + ScreenCornerState m <- XS.get + (win, xFunc) <- case find (\(_, (sc, _)) -> sc == corner) (M.toList m) of + Just (w, (_, xF')) -> return (w, xF' >> xF) -- chain X actions + Nothing -> (,xF) <$> createWindowAt corner - XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m' + XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner, xFunc) m' -- | Add a list of @(ScreenCorner, X ())@ tuples -addScreenCorners :: [ (ScreenCorner, X ()) ] -> X () +addScreenCorners :: [(ScreenCorner, X ())] -> X () addScreenCorners = mapM_ (uncurry addScreenCorner) - -------------------------------------------------------------------------------- -- Xlib functions -------------------------------------------------------------------------------- @@ -83,72 +79,64 @@ createWindowAt :: ScreenCorner -> X Window createWindowAt SCUpperLeft = createWindowAt' 0 0 1 1 createWindowAt SCUpperRight = withDisplay $ \dpy -> - let w = displayWidth dpy (defaultScreen dpy) - 1 - in createWindowAt' (fi w) 0 1 1 - + let w = displayWidth dpy (defaultScreen dpy) - 1 + in createWindowAt' (fi w) 0 1 1 createWindowAt SCLowerLeft = withDisplay $ \dpy -> - let h = displayHeight dpy (defaultScreen dpy) - 1 - in createWindowAt' 0 (fi h) 1 1 - + let h = displayHeight dpy (defaultScreen dpy) - 1 + in createWindowAt' 0 (fi h) 1 1 createWindowAt SCLowerRight = withDisplay $ \dpy -> - let w = displayWidth dpy (defaultScreen dpy) - 1 - h = displayHeight dpy (defaultScreen dpy) - 1 - in createWindowAt' (fi w) (fi h) 1 1 - + let w = displayWidth dpy (defaultScreen dpy) - 1 + h = displayHeight dpy (defaultScreen dpy) - 1 + in createWindowAt' (fi w) (fi h) 1 1 createWindowAt SCTop = withDisplay $ \dpy -> - let w = displayWidth dpy (defaultScreen dpy) - 1 - -- leave some gap so corner and edge can work nicely when they overlap - threshold = 150 - in createWindowAt' threshold 0 (fi $ fi w - threshold * 2) 1 - + let w = displayWidth dpy (defaultScreen dpy) - 1 + -- leave some gap so corner and edge can work nicely when they overlap + threshold = 150 + in createWindowAt' threshold 0 (fi $ fi w - threshold * 2) 1 createWindowAt SCBottom = withDisplay $ \dpy -> - let w = displayWidth dpy (defaultScreen dpy) - 1 - h = displayHeight dpy (defaultScreen dpy) - 1 - threshold = 150 - in createWindowAt' threshold (fi h) (fi $ fi w - threshold * 2) 1 - + let w = displayWidth dpy (defaultScreen dpy) - 1 + h = displayHeight dpy (defaultScreen dpy) - 1 + threshold = 150 + in createWindowAt' threshold (fi h) (fi $ fi w - threshold * 2) 1 createWindowAt SCLeft = withDisplay $ \dpy -> - let h = displayHeight dpy (defaultScreen dpy) - 1 - threshold = 150 - in createWindowAt' 0 threshold 1 (fi $ fi h - threshold * 2) - + let h = displayHeight dpy (defaultScreen dpy) - 1 + threshold = 150 + in createWindowAt' 0 threshold 1 (fi $ fi h - threshold * 2) createWindowAt SCRight = withDisplay $ \dpy -> - let w = displayWidth dpy (defaultScreen dpy) - 1 - h = displayHeight dpy (defaultScreen dpy) - 1 - threshold = 150 - in createWindowAt' (fi w) threshold 1 (fi $ fi h - threshold * 2) + let w = displayWidth dpy (defaultScreen dpy) - 1 + h = displayHeight dpy (defaultScreen dpy) - 1 + threshold = 150 + in createWindowAt' (fi w) threshold 1 (fi $ fi h - threshold * 2) -- Create a new X window at a (x,y) Position, with given width and height. createWindowAt' :: Position -> Position -> Dimension -> Dimension -> X Window createWindowAt' x y width height = withDisplay $ \dpy -> io $ do - - rootw <- rootWindow dpy (defaultScreen dpy) - - let - visual = defaultVisualOfScreen $ defaultScreenOfDisplay dpy - attrmask = cWOverrideRedirect + rootw <- rootWindow dpy (defaultScreen dpy) - w <- allocaSetWindowAttributes $ \attributes -> do + let visual = defaultVisualOfScreen $ defaultScreenOfDisplay dpy + attrmask = cWOverrideRedirect - set_override_redirect attributes True - createWindow dpy -- display - rootw -- parent window - x -- x - y -- y - width -- width - height -- height - 0 -- border width - 0 -- depth - inputOnly -- class - visual -- visual - attrmask -- valuemask - attributes -- attributes + w <- allocaSetWindowAttributes $ \attributes -> do + set_override_redirect attributes True + createWindow + dpy -- display + rootw -- parent window + x -- x + y -- y + width -- width + height -- height + 0 -- border width + 0 -- depth + inputOnly -- class + visual -- visual + attrmask -- valuemask + attributes -- attributes - -- we only need mouse entry events - selectInput dpy w enterWindowMask - mapWindow dpy w - sync dpy False - return w + -- we only need mouse entry events + selectInput dpy w enterWindowMask + mapWindow dpy w + sync dpy False + return w -------------------------------------------------------------------------------- -- Event hook @@ -156,37 +144,34 @@ -- | Handle screen corner events screenCornerEventHook :: Event -> X All -screenCornerEventHook CrossingEvent { ev_window = win } = do - - ScreenCornerState m <- XS.get - - case M.lookup win m of - Just (_, xF) -> xF - Nothing -> return () +screenCornerEventHook CrossingEvent {ev_window = win} = do + ScreenCornerState m <- XS.get - return (All True) + case M.lookup win m of + Just (_, xF) -> xF + Nothing -> return () + return (All True) screenCornerEventHook _ = return (All True) - -------------------------------------------------------------------------------- -- Layout hook -------------------------------------------------------------------------------- data ScreenCornerLayout a = ScreenCornerLayout - deriving ( Read, Show ) + deriving (Read, Show) instance LayoutModifier ScreenCornerLayout a where - hook ScreenCornerLayout = withDisplay $ \dpy -> do - ScreenCornerState m <- XS.get - io $ mapM_ (raiseWindow dpy) $ M.keys m - unhook = hook + hook ScreenCornerLayout = withDisplay $ \dpy -> do + ScreenCornerState m <- XS.get + io $ mapM_ (raiseWindow dpy) $ M.keys m + unhook = hook screenCornerLayoutHook :: l a -> ModifiedLayout ScreenCornerLayout l a screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout - -------------------------------------------------------------------------------- + -- $usage -- -- This extension adds KDE-like screen corners and GNOME Hot Edge like diff --git a/XMonad/Hooks/StatusBar.hs b/XMonad/Hooks/StatusBar.hs --- a/XMonad/Hooks/StatusBar.hs +++ b/XMonad/Hooks/StatusBar.hs @@ -426,12 +426,12 @@ -- > xmobarBottom = statusBarPropTo "_XMONAD_LOG_2" "xmobar -x 0 ~/.config/xmobar/xmobarrc_bottom" (pure ppBottom) -- > xmobar1 = statusBarPropTo "_XMONAD_LOG_3" "xmobar -x 1 ~/.config/xmobar/xmobarrc1" (pure pp1) -- > --- > barSpawner :: ScreenId -> IO StatusBarConfig --- > barSpawner 0 = pure $ xmobarTop <> xmobarBottom -- two bars on the main screen --- > barSpawner 1 = pure $ xmobar1 +-- > barSpawner :: ScreenId -> StatusBarConfig +-- > barSpawner 0 = xmobarTop <> xmobarBottom -- two bars on the main screen +-- > barSpawner 1 = xmobar1 -- > barSpawner _ = mempty -- nothing on the rest of the screens -- > --- > main = xmonad $ dynamicSBs barSpawner (def { ... }) +-- > main = xmonad $ dynamicSBs (pure . barSpawner) (def { ... }) -- -- Make sure you specify which screen to place the status bar on (in xmobar, -- this is achieved by the @-x@ argument). In addition to making sure that your diff --git a/XMonad/Layout/CircleEx.hs b/XMonad/Layout/CircleEx.hs --- a/XMonad/Layout/CircleEx.hs +++ b/XMonad/Layout/CircleEx.hs @@ -116,7 +116,7 @@ = Rotate !Double -- ^ Rotate secondary windows by specific angle | IncStackRatio !Rational -- ^ Increase (or decrease, with negative value) sizes of secondary windows | IncMultiplier !Rational -- ^ Increase 'cMultiplier'. - deriving (Eq, Show, Typeable) + deriving (Eq, Show) instance Message CircleExMsg diff --git a/XMonad/Layout/FixedAspectRatio.hs b/XMonad/Layout/FixedAspectRatio.hs --- a/XMonad/Layout/FixedAspectRatio.hs +++ b/XMonad/Layout/FixedAspectRatio.hs @@ -158,6 +158,5 @@ FixRatio Rational Window -- ^ Set the aspect ratio for the window | ResetRatio Window -- ^ Remove the aspect ratio for the window | ToggleRatio Rational Window -- ^ Toggle the reatio - deriving Typeable instance Message ManageAspectRatio diff --git a/XMonad/Layout/IndependentScreens.hs b/XMonad/Layout/IndependentScreens.hs --- a/XMonad/Layout/IndependentScreens.hs +++ b/XMonad/Layout/IndependentScreens.hs @@ -26,8 +26,8 @@ marshallPP, whenCurrentOn, countScreens, - workspacesOn, - workspaceOnScreen, focusWindow', focusScreen, nthWorkspace, withWspOnScreen, + workspacesOn, screenOnMonitor, + workspaceOnScreen, focusWindow', doFocus', focusScreen, focusWorkspace, nthWorkspace, withWspOnScreen, -- * Converting between virtual and physical workspaces -- $converting marshall, unmarshall, unmarshallS, unmarshallW, @@ -40,6 +40,7 @@ import XMonad.Hooks.StatusBar.PP import XMonad.Prelude import qualified XMonad.StackSet as W +import XMonad.Actions.OnScreen (viewOnScreen) -- $usage -- You can use this module with the following in your @xmonad.hs@: @@ -147,7 +148,7 @@ Just wsp -> operation wsp ws Nothing -> ws --- | Get the workspace that is active on a given screen. +-- | Get the screen that is active on a given monitor. screenOnMonitor :: ScreenId -> WindowSet -> Maybe WindowScreen screenOnMonitor screenId ws = find ((screenId ==) . W.screen) (W.current ws : W.visible ws) @@ -159,9 +160,19 @@ Just tag -> W.focusWindow window $ focusScreen (unmarshallS tag) ws Nothing -> ws +-- | ManageHook to focus a window, switching workspace on the correct Xinerama screen if neccessary. +-- Useful in 'XMonad.Hooks.EwmhDesktops.setActivateHook' when using this module. +doFocus' :: ManageHook +doFocus' = doF . focusWindow' =<< ask + -- | Focus a given screen. focusScreen :: ScreenId -> WindowSet -> WindowSet focusScreen screenId = withWspOnScreen screenId W.view + +-- | Focus the given workspace on the correct Xinerama screen. +-- An example usage can be found at `XMonad.Hooks.EwmhDesktops.setEwmhSwitchDesktopHook` +focusWorkspace :: WorkspaceId -> WindowSet -> WindowSet +focusWorkspace workspaceId = viewOnScreen (unmarshallS workspaceId) workspaceId -- | Get the nth virtual workspace nthWorkspace :: Int -> X (Maybe VirtualWorkspace) diff --git a/XMonad/Layout/NoBorders.hs b/XMonad/Layout/NoBorders.hs --- a/XMonad/Layout/NoBorders.hs +++ b/XMonad/Layout/NoBorders.hs @@ -143,10 +143,8 @@ -- | Only necessary with 'BorderMessage' - remove non-existent windows from the -- 'alwaysHidden' or 'neverHidden' lists. +{-# DEPRECATED borderEventHook "No longer needed." #-} borderEventHook :: Event -> X All -borderEventHook DestroyWindowEvent{ ev_window = w } = do - broadcastMessage $ ResetBorder w - return $ All True borderEventHook _ = return $ All True instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder p) Window where @@ -167,14 +165,17 @@ in ConfigurableBorder gh <$> consNewIf ah (not b) <*> consNewIf nh b <*> pure ch - | Just (ResetBorder w) <- fromMessage m = + | Just (ResetBorder w) <- fromMessage m = resetBorder w + | Just DestroyWindowEvent { ev_window = w } <- fromMessage m = resetBorder w + | otherwise = Nothing + where + resetBorder w = let delete' e l = if e `elem` l then (True,delete e l) else (False,l) (da,ah') = delete' w ah (dn,nh') = delete' w nh in if da || dn then Just cb { alwaysHidden = ah', neverHidden = nh' } else Nothing - | otherwise = Nothing -- | SetsAmbiguous allows custom actions to generate lists of windows that -- should not have borders drawn through 'ConfigurableBorder' diff --git a/XMonad/Layout/OnHost.hs b/XMonad/Layout/OnHost.hs --- a/XMonad/Layout/OnHost.hs +++ b/XMonad/Layout/OnHost.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} - +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.OnHost @@ -27,10 +28,12 @@ import XMonad import qualified XMonad.StackSet as W +import XMonad.Prelude import XMonad.Layout.LayoutModifier -import Data.Maybe (fromMaybe) +import Foreign (allocaArray0) +import Foreign.C import System.Posix.Env (getEnv) -- $usage @@ -56,11 +59,13 @@ -- -- > layoutHook = A ||| B ||| onHost "foo" D C -- --- Note that we rely on '$HOST' being set in the environment, as is true on most --- modern systems; if it's not, you may want to use a wrapper around xmonad or --- perhaps use 'System.Posix.Env.setEnv' (or 'putEnv') to set it in 'main'. --- This is to avoid dragging in the network package as an xmonad dependency. --- If '$HOST' is not defined, it will behave as if the host name never matches. +-- Note that we rely on either @$HOST@ being set in the environment, or +-- returning something +-- useful, as is true on most modern systems; if this is not the case for you, +-- you may want to use a wrapper around xmonad or perhaps use +-- 'System.Posix.Env.setEnv' (or 'putEnv') to set @$HOST@ in 'main'. If +-- neither of the two methods work, the module will behave as if the host name +-- never matches. -- -- Also note that '$HOST' is usually a fully qualified domain name, not a short name. -- If you use a short name, this code will try to truncate $HOST to match; this may @@ -116,16 +121,16 @@ instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (OnHost l1 l2) a where runLayout (W.Workspace i p@(OnHost hosts _ lt lf) ms) r = do - h <- io $ getEnv "HOST" + h <- io $ getEnv "HOST" <|> getHostName if maybe False (`elemFQDN` hosts) h then do (wrs, mlt') <- runLayout (W.Workspace i lt ms) r return (wrs, Just $ mkNewOnHostT p mlt') else do (wrs, mlt') <- runLayout (W.Workspace i lf ms) r return (wrs, Just $ mkNewOnHostF p mlt') - handleMessage (OnHost hosts bool lt lf) m - | bool = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ OnHost hosts bool nt lf) - | otherwise = handleMessage lf m >>= maybe (return Nothing) (return . Just . OnHost hosts bool lt) + handleMessage (OnHost hosts choice lt lf) m + | choice = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ OnHost hosts choice nt lf) + | otherwise = handleMessage lf m >>= maybe (return Nothing) (return . Just . OnHost hosts choice lt) description (OnHost _ True l1 _) = description l1 description (OnHost _ _ _ l2) = description l2 @@ -154,3 +159,17 @@ | '.' `elem` a = takeWhile (/= '.') a == b | '.' `elem` b = a == takeWhile (/= '.') b | otherwise = a == b + +----------------------------------------------------------------------- +-- cbits + +foreign import ccall "gethostname" gethostname :: CString -> CSize -> IO CInt + +getHostName :: IO (Maybe String) +getHostName = allocaArray0 size $ \cstr -> do + throwErrnoIfMinus1_ "getHostName" $ gethostname cstr (fromIntegral size) + peekCString cstr <&> \case + "" -> Nothing + s -> Just s + where + size = 256 diff --git a/XMonad/Prelude.hs b/XMonad/Prelude.hs --- a/XMonad/Prelude.hs +++ b/XMonad/Prelude.hs @@ -313,6 +313,7 @@ , ("KP_7" , xK_KP_7) , ("KP_8" , xK_KP_8) , ("KP_9" , xK_KP_9) + , ("Menu" , xK_Menu) ] -- | List of multimedia keys. If Xlib does not know about some keysym @@ -472,6 +473,7 @@ , "XF86_Next_VMode" , "XF86_Prev_VMode" , "XF86Bluetooth" + , "XF86WLAN" ] -- | The specialized 'W.Screen' derived from 'WindowSet'. diff --git a/XMonad/Util/EZConfig.hs b/XMonad/Util/EZConfig.hs --- a/XMonad/Util/EZConfig.hs +++ b/XMonad/Util/EZConfig.hs @@ -419,6 +419,7 @@ -- > -- > -- > +-- > mkKeymap :: XConfig l -> [(String, X ())] -> M.Map (KeyMask, KeySym) (X ()) mkKeymap c = M.fromList . mkSubmaps . readKeymap c diff --git a/XMonad/Util/NamedScratchpad.hs b/XMonad/Util/NamedScratchpad.hs --- a/XMonad/Util/NamedScratchpad.hs +++ b/XMonad/Util/NamedScratchpad.hs @@ -309,7 +309,7 @@ nsSingleScratchpadPerWorkspace scratches = nsHideOnCondition $ \ _lastFocus curFocus winSet hideScratch -> do allScratchesButCurrent <- - filterM (liftA2 (<||>) (pure . (/= curFocus)) (`isNSP` scratches)) + filterM (liftA2 (<&&>) (pure . (/= curFocus)) (`isNSP` scratches)) (W.index winSet) whenX (isNSP curFocus scratches) $ for_ allScratchesButCurrent hideScratch diff --git a/XMonad/Util/StickyWindows.hs b/XMonad/Util/StickyWindows.hs new file mode 100644 --- /dev/null +++ b/XMonad/Util/StickyWindows.hs @@ -0,0 +1,142 @@ +-- | +-- Module : XMonad.Util.StickyWindows +-- Description : Make windows sticky to a screen across workspace changes. +-- Copyright : (c) Yecine Megdiche +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Yecine Megdiche +-- Stability : unstable +-- Portability : unportable +-- +-- This module provides functionality to make windows \"sticky\" to a particular +-- screen. When a window is marked as sticky on a screen, it will automatically +-- follow that screen across workspace changes, staying visible even when you +-- switch to a different workspace. +-- +-- This is particularly useful for windows you want to keep visible at all times +-- on a specific monitor, such as Picture-in-Picture videos, music players, +-- communication apps, or reference documentation. +module XMonad.Util.StickyWindows ( + -- * Usage + -- $usage + sticky, + stick, + unstick, +) where + +import qualified Data.Map as M +import qualified Data.Set as S +import XMonad +import XMonad.Prelude +import qualified XMonad.StackSet as W +import qualified XMonad.Util.ExtensibleState as XS + +-- $usage +-- You can use this module with the following in your @xmonad.hs@: +-- +-- > import XMonad.Util.StickyWindows +-- +-- To enable sticky windows, wrap your config with 'sticky': +-- +-- > main = xmonad $ … . sticky . … $ def { ... } +-- +-- This adds the necessary hooks to manage sticky windows. Next, add keybindings +-- to stick and unstick windows: +-- +-- > , ((modMask, xK_s), withFocused stick) +-- > , ((modMask .|. shiftMask, xK_s), withFocused unstick) +-- +-- Now you can: +-- +-- 1. Focus a window and press @Mod-s@ to make it sticky to the current screen +-- 2. Switch workspaces on that screen, and the sticky window will follow +-- 3. Press @Mod-Shift-s@ to unstick the window +-- +-- Note that windows are sticky to a /specific screen/, not to all screens. If you +-- have multiple monitors, a window marked sticky on screen 0 will only follow +-- workspace changes on screen 0, not on other screens. +-- +-- The sticky state persists across XMonad restarts. + +data StickyState = SS + { lastWs :: !(M.Map ScreenId WorkspaceId) + , stickies :: !(M.Map ScreenId (S.Set Window)) + } + deriving (Show, Read) + +instance ExtensionClass StickyState where + initialValue = SS mempty mempty + extensionType = PersistentExtension + +modifySticky :: + (S.Set Window -> S.Set Window) -> ScreenId -> StickyState -> StickyState +modifySticky f sid (SS ws ss) = + SS ws $ M.alter (Just . f . fromMaybe S.empty) sid ss + +modifyStickyM :: (S.Set Window -> S.Set Window) -> ScreenId -> X () +modifyStickyM f sid = XS.modify (modifySticky f sid) + +stick' :: Window -> ScreenId -> X () +stick' = modifyStickyM . S.insert + +unstick' :: Window -> ScreenId -> X () +unstick' = modifyStickyM . S.delete + +-- | Remove the sticky status from the given window on the current screen. +-- The window will no longer automatically follow workspace changes. +-- +-- Typically used with 'withFocused': +-- +-- > , ((modMask .|. shiftMask, xK_s), withFocused unstick) +unstick :: Window -> X () +unstick w = unstick' w =<< currentScreen + +-- | Mark the given window as sticky to the current screen. The window will +-- automatically follow this screen across workspace changes until explicitly +-- unstuck with 'unstick' or until the window is destroyed. +-- +-- Typically used with 'withFocused': +-- +-- > , ((modMask, xK_s), withFocused stick) +stick :: Window -> X () +stick w = stick' w =<< currentScreen + +currentScreen :: X ScreenId +currentScreen = gets $ W.screen . W.current . windowset + +-- | Incorporates sticky window functionality into an 'XConfig'. This adds +-- the necessary log hook and event hook to: +-- +-- * Automatically move sticky windows when workspaces change on their screen +-- * Clean up sticky state when windows are destroyed +-- +-- Example usage: +-- +-- > main = xmonad $ … . sticky . … $ def { ... } +sticky :: XConfig l -> XConfig l +sticky xconf = + xconf + { logHook = logHook xconf >> stickyLogHook + , handleEventHook = handleEventHook xconf <> stickyEventHook + } + +stickyLogHook :: X () +stickyLogHook = do + lastWS_ <- XS.gets lastWs + screens <- withWindowSet $ return . map (\s -> (W.screen s, W.tag . W.workspace $ s)) . W.screens + for_ screens $ \(sid, wsTag) -> do + unless (M.lookup sid lastWS_ == Just wsTag) $ + -- We need to update the last workspace before moving windows to avoid + -- getting stuck in a loop: This is a log hook, and calling moveWindows + -- (which in turn calls 'windows') would trigger another log hook. + XS.modify (\(SS ws ss) -> SS (M.insert sid wsTag ws) ss) + >> XS.gets (M.lookup sid . stickies) + >>= maybe mempty (moveWindows wsTag) + +moveWindows :: WorkspaceId -> S.Set Window -> X () +moveWindows wsTag = traverse_ (\w -> windows $ W.focusDown . W.shiftWin wsTag w) + +stickyEventHook :: Event -> X All +stickyEventHook DestroyWindowEvent{ev_window = w} = + XS.modify (\(SS ws ss) -> SS ws (M.map (S.delete w) ss)) $> All True +stickyEventHook _ = return (All True) diff --git a/XMonad/Util/XSelection.hs b/XMonad/Util/XSelection.hs --- a/XMonad/Util/XSelection.hs +++ b/XMonad/Util/XSelection.hs @@ -18,6 +18,8 @@ module XMonad.Util.XSelection ( -- * Usage -- $usage getSelection, + getClipboard, + getSecondarySelection, promptSelection, safePromptSelection, transformPromptSelection, @@ -31,31 +33,47 @@ {- $usage Add @import XMonad.Util.XSelection@ to the top of Config.hs - Then make use of getSelection or promptSelection as needed; if - one wanted to run Firefox with the selection as an argument (perhaps + + If one wanted to run Firefox with the selection as an argument (perhaps the selection string is an URL you just highlighted), then one could add to the xmonad.hs a line like thus: > , ((modm .|. shiftMask, xK_b), promptSelection "firefox") + To add a 'paste' keybinding in your prompts, use: + + > prompt_extra_bindings = [ + > ((mod1Mask, xK_v), getClipboard >>= insertString) -- Alt+v to paste + > ] + > + > prompt_conf = def { + > promptKeymap = + > foldl (\m (k, a) -> M.insert k a m) defaultXPKeymap prompt_extra_bindings, + > -- other prompt config + > } + + Next use it to construct a prompt, for example in your bindings: + + > ("M-p", shellPrompt prompt_conf), + Future improvements for XSelection: * More elaborate functionality: Emacs' registers are nice; if you - don't know what they are, see -} + don't know what they are, see --- | Returns a String corresponding to the current mouse selection in X; --- if there is none, an empty string is returned. --- --- WARNING: this function is fundamentally implemented incorrectly and may, among other possible failure modes, --- deadlock or crash. For details, see . --- (These errors are generally very rare in practice, but still exist.) -getSelection :: MonadIO m => m String -getSelection = io $ do + WARNING: these functions are fundamentally implemented incorrectly and may, + among other possible failure modes, deadlock or crash. For details, see + . + (These errors are generally very rare in practice, but still exist.) -} + +-- Query the content of a selection in X +getSelectionNamed :: String -> IO String +getSelectionNamed sel_name = do dpy <- openDisplay "" let dflt = defaultScreen dpy rootw <- rootWindow dpy dflt win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0 - p <- internAtom dpy "PRIMARY" True + p <- internAtom dpy sel_name True ty <- E.catch (E.catch (internAtom dpy "UTF8_STRING" False) @@ -69,9 +87,25 @@ result <- if ev_event_type ev == selectionNotify then do res <- getWindowProperty8 dpy clp win return $ decode . maybe [] (map fromIntegral) $ res - else destroyWindow dpy win >> return "" + else return "" + destroyWindow dpy win closeDisplay dpy return result + +-- | Returns a String corresponding to the current mouse selection in X; +-- if there is none, an empty string is returned. +getSelection :: MonadIO m => m String +getSelection = io $ getSelectionNamed "PRIMARY" + +-- | Returns a String corresponding to the current clipboard in X; +-- if there is none, an empty string is returned. +getClipboard :: MonadIO m => m String +getClipboard = io $ getSelectionNamed "CLIPBOARD" + +-- | Returns a String corresponding to the secondary selection in X; +-- if there is none, an empty string is returned. +getSecondarySelection :: MonadIO m => m String +getSecondarySelection = io $ getSelectionNamed "SECONDARY" {- | A wrapper around 'getSelection'. Makes it convenient to run a program with the current selection as an argument. This is convenient for handling URLs, in particular. For example, in your Config.hs you could bind a key to diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -1,5 +1,5 @@ name: xmonad-contrib -version: 0.18.1 +version: 0.18.2 -- ^ also update cpp-options: -DXMONAD_CONTRIB_VERSION_* homepage: https://xmonad.org/ @@ -38,7 +38,7 @@ build-type: Simple bug-reports: https://github.com/xmonad/xmonad-contrib/issues -tested-with: GHC == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.8 || == 9.4.8 || == 9.6.6 || == 9.8.2 || == 9.10.1 +tested-with: GHC == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.8 || == 9.4.8 || == 9.6.7 || == 9.8.4 || == 9.10.3 || == 9.12.2 || == 9.14.1 source-repository head type: git @@ -56,10 +56,10 @@ library build-depends: base >= 4.12 && < 5, bytestring >= 0.10 && < 0.13, - containers >= 0.5 && < 0.8, + containers >= 0.5 && < 0.9, directory, filepath, - time >= 1.8 && < 1.15, + time >= 1.8 && < 1.16, process, random, mtl >= 1 && < 3, @@ -73,14 +73,16 @@ cpp-options: -DXMONAD_CONTRIB_VERSION_MAJOR=0 -DXMONAD_CONTRIB_VERSION_MINOR=18 - -DXMONAD_CONTRIB_VERSION_PATCH=1 + -DXMONAD_CONTRIB_VERSION_PATCH=2 ghc-options: -Wall -Wno-unused-do-bind if flag(pedantic) ghc-options: -Werror -Wwarn=deprecations + if impl(ghc >= 9.10) + ghc-options: -Wno-incomplete-record-selectors -- Keep this in sync with the oldest version in 'tested-with' - if impl(ghc > 8.6.5) + if impl(ghc > 8.8.4) -- don't treat unused-imports warning as errors, they may be necessary -- for compatibility with older versions of base (or other deps) ghc-options: -Wwarn=unused-imports @@ -154,6 +156,7 @@ XMonad.Actions.TreeSelect XMonad.Actions.UpdateFocus XMonad.Actions.UpdatePointer + XMonad.Actions.UpKeys XMonad.Actions.Warp XMonad.Actions.WindowBringer XMonad.Actions.WindowGo @@ -403,6 +406,7 @@ XMonad.Util.SpawnNamedPipe XMonad.Util.SpawnOnce XMonad.Util.Stack + XMonad.Util.StickyWindows XMonad.Util.StringProp XMonad.Util.Themes XMonad.Util.Timer @@ -489,7 +493,7 @@ , bytestring >= 0.10 && < 0.13 , containers , directory - , time >= 1.8 && < 1.15 + , time >= 1.8 && < 1.16 , hspec >= 2.4.0 && < 3 , mtl , random @@ -504,9 +508,11 @@ if flag(pedantic) ghc-options: -Werror -Wwarn=deprecations + if impl(ghc >= 9.10) + ghc-options: -Wno-incomplete-record-selectors -- Keep this in sync with the oldest version in 'tested-with' - if impl(ghc > 8.6.5) + if impl(ghc > 8.8.4) -- don't treat unused-imports warning as errors, they may be necessary -- for compatibility with older versions of base (or other deps) ghc-options: -Wwarn=unused-imports