Compare commits

..

No commits in common. "master" and "v0.18.1" have entirely different histories.

25 changed files with 326 additions and 751 deletions

View File

@ -38,13 +38,13 @@ set in GitHub repository secrets.
linux:
name: Haskell-CI - Linux - ${{ matrix.compiler }}
@@ -33,6 +40,7 @@
compilerVersion: 9.8.4
compilerVersion: 9.8.2
setup-method: ghcup
allow-failure: false
+ upload: true
- compiler: ghc-9.6.7
- compiler: ghc-9.6.6
compilerKind: ghc
compilerVersion: 9.6.7
compilerVersion: 9.6.6
@@ -257,6 +265,10 @@
- name: haddock
run: |

View File

@ -8,9 +8,9 @@
#
# For more information, see https://github.com/haskell-CI/haskell-ci
#
# version: 0.19.20250506
# version: 0.19.20240708
#
# REGENDATA ("0.19.20250506",["github","cabal.project"])
# REGENDATA ("0.19.20240708",["github","cabal.project"])
#
name: Haskell-CI
on:
@ -26,7 +26,7 @@ on:
jobs:
linux:
name: Haskell-CI - Linux - ${{ matrix.compiler }}
runs-on: ubuntu-24.04
runs-on: ubuntu-20.04
timeout-minutes:
60
container:
@ -35,25 +35,20 @@ jobs:
strategy:
matrix:
include:
- compiler: ghc-9.12.2
- compiler: ghc-9.10.1
compilerKind: ghc
compilerVersion: 9.12.2
compilerVersion: 9.10.1
setup-method: ghcup
allow-failure: false
- compiler: ghc-9.10.2
- compiler: ghc-9.8.2
compilerKind: ghc
compilerVersion: 9.10.2
setup-method: ghcup
allow-failure: false
- compiler: ghc-9.8.4
compilerKind: ghc
compilerVersion: 9.8.4
compilerVersion: 9.8.2
setup-method: ghcup
allow-failure: false
upload: true
- compiler: ghc-9.6.7
- compiler: ghc-9.6.6
compilerKind: ghc
compilerVersion: 9.6.7
compilerVersion: 9.6.6
setup-method: ghcup
allow-failure: false
- compiler: ghc-9.4.8
@ -81,32 +76,24 @@ jobs:
compilerVersion: 8.8.4
setup-method: ghcup
allow-failure: false
- compiler: ghc-8.6.5
compilerKind: ghc
compilerVersion: 8.6.5
setup-method: ghcup
allow-failure: false
fail-fast: false
steps:
- name: apt-get install
- name: apt
run: |
apt-get update
apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
apt-get install -y libx11-dev libxext-dev libxft-dev libxinerama-dev libxrandr-dev libxss-dev
- name: Install GHCup
run: |
mkdir -p "$HOME/.ghcup/bin"
curl -sL https://downloads.haskell.org/ghcup/0.1.50.1/x86_64-linux-ghcup-0.1.50.1 > "$HOME/.ghcup/bin/ghcup"
curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup"
chmod a+x "$HOME/.ghcup/bin/ghcup"
- name: Install cabal-install
run: |
"$HOME/.ghcup/bin/ghcup" install cabal 3.14.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
echo "CABAL=$HOME/.ghcup/bin/cabal-3.14.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
- name: Install GHC (GHCup)
if: matrix.setup-method == 'ghcup'
run: |
"$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
echo "HC=$HC" >> "$GITHUB_ENV"
echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
"$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
apt-get update
apt-get install -y libx11-dev libxext-dev libxft-dev libxinerama-dev libxrandr-dev libxss-dev
env:
HCKIND: ${{ matrix.compilerKind }}
HCNAME: ${{ matrix.compiler }}
@ -117,12 +104,21 @@ jobs:
echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
HCDIR=/opt/$HCKIND/$HCVER
HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
echo "HC=$HC" >> "$GITHUB_ENV"
echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"
HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
echo "GHCJSARITH=0" >> "$GITHUB_ENV"
env:
HCKIND: ${{ matrix.compilerKind }}
HCNAME: ${{ matrix.compiler }}
@ -252,8 +248,8 @@ jobs:
rm -f cabal.project.local
$CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
- name: save cache
if: always()
uses: actions/cache/save@v4
if: always()
with:
key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
path: ~/.cabal/store

View File

@ -6,15 +6,19 @@ on:
jobs:
build:
runs-on: ubuntu-latest
runs-on: ubuntu-20.04 # FIXME
name: Nix Flake - Linux
permissions:
contents: read
steps:
- name: Install Nix
uses: cachix/install-nix-action@v31
uses: cachix/install-nix-action@V27
with:
github_access_token: ${{ secrets.GITHUB_TOKEN }}
install_url: https://nixos-nix-install-tests.cachix.org/serve/i6laym9jw3wg9mw6ncyrk6gjx4l34vvx/install
install_options: '--tarball-url-prefix https://nixos-nix-install-tests.cachix.org/serve'
extra_nix_config: |
experimental-features = nix-command flakes
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
- name: Clone project
uses: actions/checkout@v4
- name: Build

View File

@ -12,8 +12,10 @@ jobs:
fail-fast: false
matrix:
include:
- resolver: lts-16 # GHC 8.8
- resolver: lts-14 # GHC 8.6
yaml: stack.yaml
- resolver: lts-14 # GHC 8.6
yaml: stack-master.yaml
- resolver: lts-16 # GHC 8.8
yaml: stack-master.yaml
- resolver: lts-18 # GHC 8.10
@ -25,10 +27,8 @@ jobs:
- resolver: lts-21 # GHC 9.4
yaml: stack-master.yaml
- resolver: lts-22 # GHC 9.6
yaml: stack-master.yaml
- resolver: lts-23 # GHC 9.8
yaml: stack.yaml
- resolver: lts-23 # GHC 9.8
- resolver: lts-22 # GHC 9.6
yaml: stack-master.yaml
steps:

View File

@ -2,65 +2,6 @@
## _unreleased_
### Breaking Changes
* Drop support for GHC 8.6
### Bug Fixes and Minor Changes
* `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`.
* `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.
## 0.18.1 (August 20, 2024)
### Breaking Changes
@ -480,8 +421,7 @@
* `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](https://xmonad.org/configurations.html)
modules may still be found [on the website].
* `XMonad.Util.NamedScratchpad`
@ -502,6 +442,8 @@
- 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`
@ -576,8 +518,7 @@
`todo +d 12 02 2024` work.
- Added the ability to specify alphabetic (`#A`, `#B`, and `#C`)
[priorities](https://orgmode.org/manual/Priorities.html) at the end of
the input note.
[priorities] at the end of the input note.
* `XMonad.Prompt.Unicode`
@ -671,8 +612,7 @@
- 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](https://github.com/xmonad/xmonad-contrib/pull/744)
variable support, comment on [this PR].
* `XMonad.Util.XUtils`
@ -711,6 +651,9 @@
- 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
@ -2236,8 +2179,8 @@
* `XMonad.Prompt.Pass`
This module provides 3 `XMonad.Prompt`s to ease passwords manipulation
(generate, read, remove) via [pass](http://www.passwordstore.org/).
This module provides 3 `XMonad.Prompt`s to ease passwords
manipulation (generate, read, remove) via [pass][].
* `XMonad.Util.RemoteWindows`
@ -2313,3 +2256,5 @@
## See Also
<https://wiki.haskell.org/Xmonad/Notable_changes_since_0.8>
[pass]: http://www.passwordstore.org/

View File

@ -69,9 +69,7 @@ import qualified XMonad.Util.ExtensibleState as XS
-- 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. To close a project,
-- you can use the functions provided by "XMonad.Actions.DynamicWorkspaces",
-- such as @removeWorkspace@ or @removeWorkspaceByTag@.
-- or further configure the workspace/project.
--
-- When using the @switchProjectPrompt@ function, workspaces are
-- created as needed. This means you can create new project spaces
@ -232,9 +230,7 @@ lookupProject name = Map.lookup name <$> XS.gets projects
--------------------------------------------------------------------------------
-- | Fetch the current project (the one being used for the currently
-- active workspace). If the workspace doesn't have a project, a
-- default project is returned, using the workspace name as the
-- project name.
-- active workspace).
currentProject :: X Project
currentProject = do
name <- gets (W.tag . W.workspace . W.current . windowset)
@ -259,7 +255,20 @@ modifyProject f = do
--------------------------------------------------------------------------------
-- | Switch to the given project.
switchProject :: Project -> X ()
switchProject p = appendWorkspace (projectName p)
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)
--------------------------------------------------------------------------------
-- | Prompt for a project name and then switch to it. Automatically

View File

@ -1,181 +1,148 @@
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.OnScreen
-- Description : Control workspaces on different screens (in xinerama mode).
-- Copyright : (c) 2009-2025 Nils Schweinsberg
-- Copyright : (c) 2009 Nils Schweinsberg
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Nils Schweinsberg <mail@nils.cc>
-- Maintainer : Nils Schweinsberg <mail@n-sch.de>
-- 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 (empty, fromMaybe, guard)
import XMonad.Prelude (fromMaybe, guard, empty)
import XMonad.StackSet hiding (new)
-- | Focus data definitions
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
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
-- | 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 ::
-- | function to run
(WindowSet -> WindowSet) ->
-- | what to do with the focus
Focus ->
-- | screen id
ScreenId ->
-- | current stack
WindowSet ->
WindowSet
onScreen :: (WindowSet -> WindowSet) -- ^ function to run
-> Focus -- ^ what to do with the focus
-> ScreenId -- ^ screen id
-> WindowSet -- ^ current stack
-> WindowSet
onScreen f foc sc st = fromMaybe st $ do
ws <- lookupWorkspace sc st
ws <- lookupWorkspace sc st
let fStack = f $ view ws st
let fStack = f $ view ws st
return $ setFocus foc st fStack
return $ setFocus foc st fStack
-- set focus for new stack
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 :: 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 (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 function to run
X () ->
-- | focus
Focus ->
-- | screen id
ScreenId ->
X ()
onScreen' :: X () -- ^ X function to run
-> Focus -- ^ focus
-> ScreenId -- ^ screen id
-> 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 ::
-- | screen id
ScreenId ->
-- | index of the workspace
WorkspaceId ->
-- | current stack
WindowSet ->
WindowSet
viewOnScreen :: ScreenId -- ^ screen id
-> WorkspaceId -- ^ index of the workspace
-> WindowSet -- ^ current stack
-> 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 ::
-- | screen id
ScreenId ->
-- | index of the workspace
WorkspaceId ->
-- | current stack
WindowSet ->
WindowSet
greedyViewOnScreen :: ScreenId -- ^ screen id
-> WorkspaceId -- ^ index of the workspace
-> WindowSet -- ^ current stack
-> 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 ::
-- | screen id
ScreenId ->
-- | index of the workspace
WorkspaceId ->
-- | current stack
WindowSet ->
WindowSet
onlyOnScreen :: ScreenId -- ^ screen id
-> WorkspaceId -- ^ index of the workspace
-> WindowSet -- ^ current stack
-> 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 ::
-- | screen id
ScreenId ->
-- | index of the workspace
WorkspaceId ->
-- | current stack
WindowSet ->
WindowSet
toggleOnScreen :: ScreenId -- ^ screen id
-> WorkspaceId -- ^ index of the workspace
-> WindowSet -- ^ current stack
-> 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 ::
-- | screen id
ScreenId ->
-- | index of the workspace
WorkspaceId ->
-- | current stack
WindowSet ->
WindowSet
toggleGreedyOnScreen :: ScreenId -- ^ screen id
-> WorkspaceId -- ^ index of the workspace
-> WindowSet -- ^ current stack
-> 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' ::
-- | function to run
(WorkspaceId -> WindowSet -> WindowSet) ->
-- | tag to look for
WorkspaceId ->
-- | current stackset
WindowSet ->
WindowSet
toggleOrView' :: (WorkspaceId -> WindowSet -> WindowSet) -- ^ function to run
-> WorkspaceId -- ^ tag to look for
-> WindowSet -- ^ current stackset
-> 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
--

View File

@ -1,6 +1,4 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ParallelListComp #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.PhysicalScreens
@ -30,13 +28,10 @@ module XMonad.Actions.PhysicalScreens (
, getScreenIdAndRectangle
, screenComparatorById
, screenComparatorByRectangle
, rescreen
) where
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 XMonad
import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy)
import qualified XMonad.StackSet as W
{- $usage
@ -151,53 +146,3 @@ onNextNeighbour sc = neighbourWindows sc 1
-- | 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.

View File

@ -1,169 +0,0 @@
{-# 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 <soliditsallgood@mailbox.org>
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-setotherwise, we
would have to manage themwe 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 thisor 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, btwplease 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 ()

View File

@ -1,4 +1,3 @@
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, UndecidableInstances #-}
-----------------------------------------------------------------------------

View File

@ -33,6 +33,7 @@ import XMonad.Util.DebugWindow (debugWindow)
-- 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

View File

@ -42,10 +42,6 @@ module XMonad.Hooks.EwmhDesktops (
-- $customActivate
setEwmhActivateHook,
-- ** Workspace switching
-- $customWorkspaceSwitch
setEwmhSwitchDesktopHook,
-- ** Fullscreen
-- $customFullscreen
setEwmhFullscreenHooks,
@ -54,9 +50,6 @@ module XMonad.Hooks.EwmhDesktops (
-- $customManageDesktopViewport
disableEwmhManageDesktopViewport,
-- $customHiddenWorkspaceMapper
setEwmhHiddenWorkspaceToScreenMapping,
-- * Standalone hooks (deprecated)
ewmhDesktopsStartup,
ewmhDesktopsLogHook,
@ -121,12 +114,8 @@ data EwmhDesktopsConfig =
-- ^ 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@
}
instance Default EwmhDesktopsConfig where
@ -135,10 +124,7 @@ instance Default EwmhDesktopsConfig where
, 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
}
@ -245,8 +231,8 @@ setEwmhWorkspaceRename f = XC.modifyDef $ \c -> c{ workspaceRename = f }
-- > [ className =? "Google-chrome" <||> className =? "google-chrome" -?> doAskUrgent
-- > , pure True -?> doFocus ]
--
-- See "XMonad.ManageHook", "XMonad.Hooks.ManageHelpers", "XMonad.Hooks.Focus" and
-- "XMonad.Layout.IndependentScreens" for functions that can be useful here.
-- See "XMonad.ManageHook", "XMonad.Hooks.ManageHelpers" and "XMonad.Hooks.Focus"
-- 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'
@ -259,31 +245,6 @@ setEwmhActivateHook :: ManageHook -> XConfig l -> XConfig l
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
@ -323,34 +284,6 @@ disableEwmhManageDesktopViewport :: XConfig l -> XConfig l
disableEwmhManageDesktopViewport = XC.modifyDef $ \c -> c{ manageDesktopViewport = False }
-- $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 ()
@ -425,7 +358,7 @@ whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X ()
whenChanged = whenX . XS.modified . const
ewmhDesktopsLogHook' :: EwmhDesktopsConfig -> X ()
ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename, manageDesktopViewport, hiddenWorkspaceToScreen} = withWindowSet $ \s -> do
ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename, manageDesktopViewport} = withWindowSet $ \s -> do
sort' <- workspaceSort
let ws = sort' $ W.workspaces s
@ -490,20 +423,18 @@ ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename, manageDe
when manageDesktopViewport $ do
let visibleScreens = W.current s : W.visible s
currentTags = map (W.tag . W.workspace) visibleScreens
whenChanged (MonitorTags currentTags) $ mkViewPorts s hiddenWorkspaceToScreen (map W.tag ws)
whenChanged (MonitorTags currentTags) $ mkViewPorts s (map W.tag ws)
-- | Create the viewports from the current 'WindowSet' and a list of
-- already sorted workspace IDs.
mkViewPorts :: WindowSet -> (WindowSet -> WindowSpace -> WindowScreen) -> [WorkspaceId] -> X ()
mkViewPorts winset hiddenWorkspaceMapper = setDesktopViewport . concat . mapMaybe (viewPorts M.!?)
mkViewPorts :: WindowSet -> [WorkspaceId] -> X ()
mkViewPorts winset = 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 (uncurry mkViewPort) hiddenWorkspacesWithScreens
hiddenWorkspacesWithScreens :: [(WindowScreen,WindowSpace)]
hiddenWorkspacesWithScreens = map (\x -> (hiddenWorkspaceMapper winset x, x)) (W.hidden winset)
++ map (mkViewPort foc) (W.hidden winset)
mkViewPort :: WindowScreen -> WindowSpace -> (WorkspaceId, [Position])
mkViewPort scr w = (W.tag w, mkPos scr)
@ -518,7 +449,7 @@ mkViewPorts winset hiddenWorkspaceMapper = setDesktopViewport . concat . mapMayb
ewmhDesktopsEventHook' :: Event -> EwmhDesktopsConfig -> X All
ewmhDesktopsEventHook'
ClientMessageEvent{ev_window = w, ev_message_type = mt, ev_data = d}
EwmhDesktopsConfig{workspaceSort, activateHook, switchDesktopHook} =
EwmhDesktopsConfig{workspaceSort, activateHook} =
withWindowSet $ \s -> do
sort' <- workspaceSort
let ws = sort' $ W.workspaces s
@ -531,7 +462,7 @@ ewmhDesktopsEventHook'
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 $ switchDesktopHook (W.tag ww)
if W.currentTag s == W.tag ww then mempty else windows $ W.view (W.tag ww)
| mt == a_cd ->
trace $ "Bad _NET_CURRENT_DESKTOP with data=" ++ show d
| not (w `W.member` s) ->

View File

@ -15,13 +15,10 @@ module XMonad.Hooks.Rescreen (
-- $usage
addAfterRescreenHook,
addRandrChangeHook,
setRescreenWorkspacesHook,
setRescreenDelay,
RescreenConfig(..),
rescreenHook,
) where
import Control.Concurrent (threadDelay)
import Graphics.X11.Xrandr
import XMonad
import XMonad.Prelude
@ -62,21 +59,16 @@ import qualified XMonad.Util.ExtensibleConf as XC
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 rwh rd <> RescreenConfig arh' rch' rwh' rd' =
RescreenConfig (arh <> arh') (rch <> rch') (rwh <> rwh') (rd <> rd')
RescreenConfig arh rch <> RescreenConfig arh' rch' = RescreenConfig (arh <> arh') (rch <> rch')
instance Monoid RescreenConfig where
mempty = def
@ -97,45 +89,20 @@ instance Monoid RescreenConfig where
-- '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 (except
-- 'rescreenWorkspacesHook', which has a replace rather than sequence
-- semantics), also just once.
-- done just once and hooks are invoked in sequence, also just once.
rescreenHook :: RescreenConfig -> XConfig l -> XConfig l
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
}
rescreenHook = XC.once $ \c -> c
{ startupHook = startupHook c <> rescreenStartupHook
, handleEventHook = handleEventHook c <> rescreenEventHook }
-- | Shortcut for 'rescreenHook'.
addAfterRescreenHook :: X () -> XConfig l -> XConfig l
addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = h }
addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = userCodeDef () h }
-- | Shortcut for 'rescreenHook'.
addRandrChangeHook :: X () -> XConfig l -> XConfig l
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 }
addRandrChangeHook h = rescreenHook def{ randrChangeHook = userCodeDef () h }
-- | Startup hook to listen for @RRScreenChangeNotify@ events.
rescreenStartupHook :: X ()
@ -159,14 +126,13 @@ handleEvent :: Event -> X ()
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 fromMaybe rescreen (getLast rescreenWorkspacesHook) >> afterRescreenHook
then rescreen >> afterRescreenHook
else randrChangeHook
-- | Remove all X events of a given window and type from the event queue,

View File

@ -1,51 +1,52 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.ScreenCorners
-- Description : Run X () actions by touching the edge of your screen with your mouse.
-- Copyright : (c) 2009-2025 Nils Schweinsberg, 2015 Evgeny Kurnevsky, 2024 Yuanle Song
-- Copyright : (c) 2009 Nils Schweinsberg, 2015 Evgeny Kurnevsky, 2024 Yuanle Song
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Nils Schweinsberg <mail@nils.cc>
-- Maintainer : Nils Schweinsberg <mail@n-sch.de>
-- 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 qualified Data.Map as M
import XMonad.Prelude
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Prelude
import qualified Data.Map as M
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
@ -54,22 +55,25 @@ data ScreenCorner
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
XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner, xFunc) m'
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'
-- | Add a list of @(ScreenCorner, X ())@ tuples
addScreenCorners :: [(ScreenCorner, X ())] -> X ()
addScreenCorners :: [ (ScreenCorner, X ()) ] -> X ()
addScreenCorners = mapM_ (uncurry addScreenCorner)
--------------------------------------------------------------------------------
-- Xlib functions
--------------------------------------------------------------------------------
@ -79,64 +83,72 @@ addScreenCorners = mapM_ (uncurry addScreenCorner)
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
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
let
visual = defaultVisualOfScreen $ defaultScreenOfDisplay dpy
attrmask = cWOverrideRedirect
-- we only need mouse entry events
selectInput dpy w enterWindowMask
mapWindow dpy w
sync dpy False
return w
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
--------------------------------------------------------------------------------
-- Event hook
@ -144,34 +156,37 @@ createWindowAt' x y width height = withDisplay $ \dpy -> io $ do
-- | Handle screen corner events
screenCornerEventHook :: Event -> X All
screenCornerEventHook CrossingEvent {ev_window = win} = do
ScreenCornerState m <- XS.get
screenCornerEventHook CrossingEvent { ev_window = win } = do
case M.lookup win m of
Just (_, xF) -> xF
Nothing -> return ()
ScreenCornerState m <- XS.get
case M.lookup win m of
Just (_, xF) -> xF
Nothing -> return ()
return (All True)
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

View File

@ -426,12 +426,12 @@ statusBarPipe cmd xpp = do
-- > 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 -> StatusBarConfig
-- > barSpawner 0 = xmobarTop <> xmobarBottom -- two bars on the main screen
-- > barSpawner 1 = xmobar1
-- > barSpawner :: ScreenId -> IO StatusBarConfig
-- > barSpawner 0 = pure $ xmobarTop <> xmobarBottom -- two bars on the main screen
-- > barSpawner 1 = pure $ xmobar1
-- > barSpawner _ = mempty -- nothing on the rest of the screens
-- >
-- > main = xmonad $ dynamicSBs (pure . barSpawner) (def { ... })
-- > main = xmonad $ dynamicSBs 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

View File

@ -116,7 +116,7 @@ data CircleExMsg
= 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)
deriving (Eq, Show, Typeable)
instance Message CircleExMsg

View File

@ -158,5 +158,6 @@ data ManageAspectRatio =
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

View File

@ -26,8 +26,8 @@ module XMonad.Layout.IndependentScreens (
marshallPP,
whenCurrentOn,
countScreens,
workspacesOn, screenOnMonitor,
workspaceOnScreen, focusWindow', doFocus', focusScreen, focusWorkspace, nthWorkspace, withWspOnScreen,
workspacesOn,
workspaceOnScreen, focusWindow', focusScreen, nthWorkspace, withWspOnScreen,
-- * Converting between virtual and physical workspaces
-- $converting
marshall, unmarshall, unmarshallS, unmarshallW,
@ -40,7 +40,6 @@ import XMonad
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@:
@ -148,7 +147,7 @@ withWspOnScreen screenId operation ws = case workspaceOnScreen screenId ws of
Just wsp -> operation wsp ws
Nothing -> ws
-- | Get the screen that is active on a given monitor.
-- | Get the workspace that is active on a given screen.
screenOnMonitor :: ScreenId -> WindowSet -> Maybe WindowScreen
screenOnMonitor screenId ws = find ((screenId ==) . W.screen) (W.current ws : W.visible ws)
@ -160,20 +159,10 @@ focusWindow' window ws
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)
nthWorkspace n = (!? n) . workspaces' <$> asks config

View File

@ -143,8 +143,10 @@ data ConfigurableBorder p w = ConfigurableBorder
-- | 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
@ -165,17 +167,14 @@ instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder
in ConfigurableBorder gh <$> consNewIf ah (not b)
<*> consNewIf nh b
<*> pure ch
| Just (ResetBorder w) <- fromMessage m = resetBorder w
| Just DestroyWindowEvent { ev_window = w } <- fromMessage m = resetBorder w
| otherwise = Nothing
where
resetBorder w =
| Just (ResetBorder w) <- fromMessage m =
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'

View File

@ -1,6 +1,5 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.OnHost
@ -28,12 +27,10 @@ module XMonad.Layout.OnHost (-- * Usage
import XMonad
import qualified XMonad.StackSet as W
import XMonad.Prelude
import XMonad.Layout.LayoutModifier
import Foreign (allocaArray0)
import Foreign.C
import Data.Maybe (fromMaybe)
import System.Posix.Env (getEnv)
-- $usage
@ -59,13 +56,11 @@ import System.Posix.Env (getEnv)
--
-- > layoutHook = A ||| B ||| onHost "foo" D C
--
-- Note that we rely on either @$HOST@ being set in the environment, or
-- <https://linux.die.net/man/2/gethostname gethostname> 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.
-- 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.
--
-- 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
@ -121,16 +116,16 @@ data OnHost l1 l2 a = OnHost [String]
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" <|> getHostName
h <- io $ getEnv "HOST"
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 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)
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)
description (OnHost _ True l1 _) = description l1
description (OnHost _ _ _ l2) = description l2
@ -159,17 +154,3 @@ eqFQDN a b
| '.' `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

View File

@ -313,7 +313,6 @@ specialKeys =
, ("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
@ -473,7 +472,6 @@ multimediaKeys = filter ((/= noSymbol) . snd) . map (id &&& stringToKeysym) $
, "XF86_Next_VMode"
, "XF86_Prev_VMode"
, "XF86Bluetooth"
, "XF86WLAN"
]
-- | The specialized 'W.Screen' derived from 'WindowSet'.

View File

@ -419,7 +419,6 @@ infixl 4 `removeMouseBindings`
-- > <XF86_Next_VMode>
-- > <XF86_Prev_VMode>
-- > <XF86Bluetooth>
-- > <XF86WLAN>
mkKeymap :: XConfig l -> [(String, X ())] -> M.Map (KeyMask, KeySym) (X ())
mkKeymap c = M.fromList . mkSubmaps . readKeymap c

View File

@ -309,7 +309,7 @@ nsSingleScratchpadPerWorkspace :: NamedScratchpads -> X ()
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

View File

@ -2,9 +2,9 @@
# See NIX.md for an overview of module usage.
{
inputs = {
flake-utils.url = "github:numtide/flake-utils";
git-ignore-nix.url = "github:hercules-ci/gitignore.nix/master";
xmonad.url = "github:xmonad/xmonad";
flake-utils.url = github:numtide/flake-utils;
git-ignore-nix.url = github:hercules-ci/gitignore.nix/master;
xmonad.url = github:xmonad/xmonad;
};
outputs = { self, flake-utils, nixpkgs, git-ignore-nix, xmonad }:
with xmonad.lib;

View File

@ -1,5 +1,5 @@
name: xmonad-contrib
version: 0.18.1.9
version: 0.18.1
-- ^ also update cpp-options: -DXMONAD_CONTRIB_VERSION_*
homepage: https://xmonad.org/
@ -38,7 +38,7 @@ cabal-version: 1.12
build-type: Simple
bug-reports: https://github.com/xmonad/xmonad-contrib/issues
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.2 || == 9.12.2
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
source-repository head
type: git
@ -56,7 +56,7 @@ flag pedantic
library
build-depends: base >= 4.12 && < 5,
bytestring >= 0.10 && < 0.13,
containers >= 0.5 && < 0.9,
containers >= 0.5 && < 0.8,
directory,
filepath,
time >= 1.8 && < 1.15,
@ -80,7 +80,7 @@ library
ghc-options: -Werror -Wwarn=deprecations
-- Keep this in sync with the oldest version in 'tested-with'
if impl(ghc > 8.8.4)
if impl(ghc > 8.6.5)
-- 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,7 +154,6 @@ library
XMonad.Actions.TreeSelect
XMonad.Actions.UpdateFocus
XMonad.Actions.UpdatePointer
XMonad.Actions.UpKeys
XMonad.Actions.Warp
XMonad.Actions.WindowBringer
XMonad.Actions.WindowGo
@ -507,7 +506,7 @@ test-suite tests
ghc-options: -Werror -Wwarn=deprecations
-- Keep this in sync with the oldest version in 'tested-with'
if impl(ghc > 8.8.4)
if impl(ghc > 8.6.5)
-- 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