twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-05-19 11:30:22 -07:00
Code Issues Packages Projects Releases Wiki Activity

Compare commits

base: twin:master
Branches Tags
twin:master
twin:feature/fix-PR9
twin:v0.18.1
twin:v0.18.0
twin:v0.17.1
twin:v0.17.0
twin:v0.16
twin:v0.15
twin:v0.14
twin:v0.13
twin:v0.12
twin:v0.11
twin:v0.10
twin:v0.9.1
twin:v0.9
twin:v0.8.1
twin:v0.8
twin:v0.7
twin:v0.6
twin:v0.5
twin:v0.4
twin:v0.3
..
compare: twin:v0.18.0
Branches Tags
twin:master
twin:feature/fix-PR9
twin:v0.18.1
twin:v0.18.0
twin:v0.17.1
twin:v0.17.0
twin:v0.16
twin:v0.15
twin:v0.14
twin:v0.13
twin:v0.12
twin:v0.11
twin:v0.10
twin:v0.9.1
twin:v0.9
twin:v0.8.1
twin:v0.8
twin:v0.7
twin:v0.6
twin:v0.5
twin:v0.4
twin:v0.3

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

54 changed files with 570 additions and 3214 deletions
Show Stats Expand all files Collapse all files

21
.github/workflows/haskell-ci-hackage.patch vendored
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.1
setup-method: ghcup
allow-failure: false
+ upload: true
- compiler: ghc-9.6.7
- compiler: ghc-9.6.4
compilerKind: ghc
compilerVersion: 9.6.7
compilerVersion: 9.6.4
@@ -257,6 +265,10 @@
- name: haddock
run: |
@ -56,24 +56,19 @@ set in GitHub repository secrets.
- name: unconstrained build
run: |
rm -f cabal.project.local
@@ -267,3 +279,80 @@
@@ -267,3 +279,75 @@
with:
key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
path: ~/.cabal/store
+ # must be separate artifacts because GitHub Actions are still broken:
+ # https://github.com/actions/upload-artifact/issues/441
+ # https://github.com/actions/upload-artifact/issues/457
+ - name: upload artifact (sdist)
+ - name: upload artifacts (sdist)
+ if: matrix.upload
+ uses: actions/upload-artifact@v4
+ uses: actions/upload-artifact@v3
+ with:
+ name: sdist
+ path: ${{ github.workspace }}/sdist/*.tar.gz
+ - name: upload artifact (haddock)
+ - name: upload artifacts (haddock)
+ if: matrix.upload
+ uses: actions/upload-artifact@v4
+ uses: actions/upload-artifact@v3
+ with:
+ name: haddock
+ path: ${{ github.workspace }}/haddock/*-docs.tar.gz
+ - name: hackage upload (candidate)
+ if: matrix.upload && github.event_name == 'workflow_dispatch' && github.event.inputs.version != ''

111
.github/workflows/haskell-ci.yml vendored
View File

@ -8,9 +8,9 @@
#
# For more information, see https://github.com/haskell-CI/haskell-ci
#
# version: 0.19.20250506
# version: 0.17.20240109
#
# REGENDATA ("0.19.20250506",["github","cabal.project"])
# REGENDATA ("0.17.20240109",["github","cabal.project"])
#
name: Haskell-CI
on:
@ -26,34 +26,24 @@ on:
jobs:
linux:
name: Haskell-CI - Linux - ${{ matrix.compiler }}
runs-on: ubuntu-24.04
runs-on: ubuntu-20.04
timeout-minutes:
60
container:
image: buildpack-deps:jammy
image: buildpack-deps:bionic
continue-on-error: ${{ matrix.allow-failure }}
strategy:
matrix:
include:
- compiler: ghc-9.12.2
- compiler: ghc-9.8.1
compilerKind: ghc
compilerVersion: 9.12.2
setup-method: ghcup
allow-failure: false
- compiler: ghc-9.10.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.1
setup-method: ghcup
allow-failure: false
upload: true
- compiler: ghc-9.6.7
- compiler: ghc-9.6.4
compilerKind: ghc
compilerVersion: 9.6.7
compilerVersion: 9.6.4
setup-method: ghcup
allow-failure: false
- compiler: ghc-9.4.8
@ -79,34 +69,36 @@ jobs:
- compiler: ghc-8.8.4
compilerKind: ghc
compilerVersion: 8.8.4
setup-method: ghcup
setup-method: hvr-ppa
allow-failure: false
- compiler: ghc-8.6.5
compilerKind: ghc
compilerVersion: 8.6.5
setup-method: hvr-ppa
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"
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"
if [ "${{ matrix.setup-method }}" = ghcup ]; then
mkdir -p "$HOME/.ghcup/bin"
curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
chmod a+x "$HOME/.ghcup/bin/ghcup"
"$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
"$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.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
else
apt-add-repository -y 'ppa:hvr/ghc'
apt-get update
apt-get install -y "$HCNAME" libx11-dev libxext-dev libxft-dev libxinerama-dev libxrandr-dev libxss-dev
mkdir -p "$HOME/.ghcup/bin"
curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
chmod a+x "$HOME/.ghcup/bin/ghcup"
"$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
fi
env:
HCKIND: ${{ matrix.compilerKind }}
HCNAME: ${{ matrix.compiler }}
@ -117,12 +109,30 @@ 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
if [ "${{ matrix.setup-method }}" = ghcup ]; then
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.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
else
HC=$HCDIR/bin/$HCKIND
echo "HC=$HC" >> "$GITHUB_ENV"
echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"
echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
fi
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 }}
@ -172,7 +182,7 @@ jobs:
chmod a+x $HOME/.cabal/bin/cabal-plan
cabal-plan --version
- name: checkout
uses: actions/checkout@v4
uses: actions/checkout@v3
with:
path: source
- name: initial cabal.project for sdist
@ -210,7 +220,7 @@ jobs:
flags: +pedantic
ghc-options: -j
EOF
$HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(xmonad-contrib)$/; }' >> cabal.project.local
$HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(xmonad-contrib)$/; }' >> cabal.project.local
cat cabal.project
cat cabal.project.local
- name: dump install plan
@ -218,7 +228,7 @@ jobs:
$CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
cabal-plan
- name: restore cache
uses: actions/cache/restore@v4
uses: actions/cache/restore@v3
with:
key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
path: ~/.cabal/store
@ -252,25 +262,20 @@ jobs:
rm -f cabal.project.local
$CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
- name: save cache
uses: actions/cache/save@v3
if: always()
uses: actions/cache/save@v4
with:
key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
path: ~/.cabal/store
# must be separate artifacts because GitHub Actions are still broken:
# https://github.com/actions/upload-artifact/issues/441
# https://github.com/actions/upload-artifact/issues/457
- name: upload artifact (sdist)
- name: upload artifacts (sdist)
if: matrix.upload
uses: actions/upload-artifact@v4
uses: actions/upload-artifact@v3
with:
name: sdist
path: ${{ github.workspace }}/sdist/*.tar.gz
- name: upload artifact (haddock)
- name: upload artifacts (haddock)
if: matrix.upload
uses: actions/upload-artifact@v4
uses: actions/upload-artifact@v3
with:
name: haddock
path: ${{ github.workspace }}/haddock/*-docs.tar.gz
- name: hackage upload (candidate)
if: matrix.upload && github.event_name == 'workflow_dispatch' && github.event.inputs.version != ''

14
.github/workflows/nix.yml vendored
View File

@ -6,21 +6,23 @@ 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@v25
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
# "nix build" builds with full optimization and includes a profiling
# build, so just the build of xmonad-contrib itself takes 3 minutes.
# As a workaround, we invoke cabal manually here.
run: |
nix develop -c cabal v2-update -O0 -j
nix develop -c cabal v2-build -O0 -j
run: nix develop -c cabal v2-build -O0 -j

9
.github/workflows/packdeps.yml vendored
View File

@ -42,9 +42,10 @@ jobs:
*.cabal
workflow-keepalive:
if: github.event_name == 'schedule'
runs-on: ubuntu-latest
permissions:
actions: write
steps:
- uses: liskin/gh-workflow-keepalive@v1
- name: Re-enable workflow
env:
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
run: |
gh api -X PUT repos/${{ github.repository }}/actions/workflows/packdeps.yml/enable

10
.github/workflows/stack.yml vendored
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
@ -23,12 +25,8 @@ jobs:
- resolver: lts-20 # GHC 9.2
yaml: stack-master.yaml
- 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-21 # GHC 9.4
yaml: stack-master.yaml
steps:

5
.mailmap
View File

@ -103,7 +103,6 @@ hexago.nl <xmonad-contrib@hexago.nl>
lithis <xmonad@selg.hethrael.org>
lithis <xmonad@selg.hethrael.org> <xmonad@s001.hethrael.com>
sam-barr <mail@samf.bar> <samfbarr@outlook.com>
Tony Zorman <soliditsallgood@mailbox.org> <50166980+slotThe@users.noreply.github.com>
Tony Zorman <soliditsallgood@mailbox.org> <soliditsallgood@tuta.io>
Tony Zorman <soliditsallgood@mailbox.org>
slotThe <soliditsallgood@mailbox.org> <50166980+slotThe@users.noreply.github.com>
slotThe <soliditsallgood@mailbox.org> <soliditsallgood@tuta.io>
spoonm <spoonm@spoonm.org>

182
CHANGES.md
View File

@ -1,165 +1,5 @@
# Change Log / Release Notes
## _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
* `XMonad.Hooks.StatusBars`
- Move status bar functions from the `IO` to the `X` monad to
allow them to look up information from `X`, like the screen
width. Existing configurations may need to use `io` from
`XMonad.Core` or `liftIO` from `Control.Monad.IO.Class` in
order to lift any existing `IO StatusBarConfig` values into
`X StatusBarConfig` values.
* `XMonad.Prompt`
- Added an additional `XPConfig` argument to `historyCompletion` and
`historyCompletionP`. Calls along the lines of `historyCompletionP
myFunc` should be changed to `historyCompletionP myConf myFunc`.
If not `myConf` is lying around, `def` can be used instead.
* `XMonad.Actions.GridSelect`
- Added the `gs_cancelOnEmptyClick` field to `GSConfig`, which makes
mouse clicks into "empty space" cancel the current grid-select.
Users explicitly defining their own `GSConfig` record will have to
add this to their definitions. Additionally, the field defaults to
`True`—to retain the old behaviour, set it to `False`.
### New Modules
* `XMonad.Actions.Profiles`
- Group workspaces by similarity. Useful when one has lots
of workspaces and uses only a couple per unit of work.
* `XMonad.Hooks.FloatConfigureReq`
- Customize handling of floating windows' move/resize/restack requests
(ConfigureRequest). Useful as a workaround for some misbehaving client
applications (Steam, rxvt-unicode, anything that tries to restore
absolute position of floats).
* `XMonad.Layout.Columns`
- Organize windows in columns. This layout allows to move/resize windows in
every directions.
* `XMonad.Prompt.WindowBringer`
- Added `copyMenu`, a convenient way to copy a window to the current workspace.
### Bug Fixes and Minor Changes
* Fix build-with-cabal.sh when XDG_CONFIG_HOME is defined.
* `XMonad.Util.EZConfig`
- Fixed `checkKeymap` warning that all keybindings are duplicates.
* `XMonad.Hooks.ManageHelpers`
- Added `isNotification` predicate to check for windows with
`_NET_WM_WINDOW_TYPE` property of `_NET_WM_WINDOW_TYPE_NOTIFICATION`.
* `XMonad.Prompt.OrgMode`
- Added `HH:MM-HH:MM` and `HH:MM+HH` syntax to specify time spans.
* `XMonad.Prompt`
- The history file is not extraneously read and written anymore if
the `historySize` is set to 0.
* `XMonad.Hooks.EwmhDesktops`
- Requests for unmanaged windows no longer cause a refresh. This avoids
flicker and also fixes disappearing menus in the Steam client and
possibly a few other client applications.
(See also `XMonad.Hooks.FloatConfigureReq` and/or `XMonad.Util.Hacks`
for additional Steam client workarounds.)
* `XMonad.Actions.Submap`
- Added `visualSubmapSorted` to enable sorting of the keymap
descriptions.
* `XMonad.Hooks.ScreenCorners`
- Added screen edge support with `SCTop`, `SCBottom`, `SCLeft` and
`SCRight`. Now both corners and edges are supported.
* `XMonad.Actions.WindowNavigation`
- Improve navigation in presence of floating windows.
- Handle window switching when in `Full` layout.
### Other changes
## 0.18.0 (February 3, 2024)
### Breaking Changes
@ -467,6 +307,8 @@
- Added `zipperFocusedAtFirstOf` to differentiate two lists into a
zipper.
### Other changes
## 0.17.1 (September 3, 2022)
### Breaking Changes
@ -480,8 +322,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 +343,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 +419,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 +513,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 +552,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 +2080,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 +2157,5 @@
## See Also
<https://wiki.haskell.org/Xmonad/Notable_changes_since_0.8>
[pass]: http://www.passwordstore.org/

23
XMonad/Actions/DynamicProjects.hs
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

22
XMonad/Actions/GridSelect.hs
View File

@ -203,13 +203,10 @@ data GSConfig a = GSConfig {
gs_colorizer :: a -> Bool -> X (String, String),
gs_font :: String,
gs_navigate :: TwoD a (Maybe a),
-- ^ Customize key bindings for a GridSelect
gs_rearranger :: Rearranger a,
gs_originFractX :: Double,
gs_originFractY :: Double,
gs_bordercolor :: String,
gs_cancelOnEmptyClick :: Bool
-- ^ When True, click on empty space will cancel GridSelect
gs_bordercolor :: String
}
-- | That is 'fromClassName' if you are selecting a 'Window', or
@ -389,20 +386,13 @@ updateElementsWithColorizer colorizer elementmap = do
stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
stdHandle ButtonEvent{ ev_event_type = t, ev_x = x, ev_y = y } contEventloop
| t == buttonRelease = do
s@TwoDState{ td_paneX = px
, td_paneY = py
, td_gsconfig = GSConfig{ gs_cellheight = ch
, gs_cellwidth = cw
, gs_cancelOnEmptyClick = cancelOnEmptyClick
}
} <- get
s@TwoDState { td_paneX = px, td_paneY = py,
td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _ _) } <- get
let gridX = (fi x - (px - cw) `div` 2) `div` cw
gridY = (fi y - (py - ch) `div` 2) `div` ch
case lookup (gridX,gridY) (td_elementmap s) of
Just (_,el) -> return (Just el)
Nothing -> if cancelOnEmptyClick
then return Nothing
else contEventloop
Nothing -> contEventloop
| otherwise = contEventloop
stdHandle ExposeEvent{} contEventloop = updateAllElements >> contEventloop
@ -658,7 +648,7 @@ gridselect gsconfig elements =
liftIO $ mapWindow dpy win
liftIO $ selectInput dpy win (exposureMask .|. keyPressMask .|. buttonReleaseMask)
status <- io $ grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime
void $ io $ grabPointer dpy win True buttonReleaseMask grabModeAsync grabModeAsync none none currentTime
io $ grabPointer dpy win True buttonReleaseMask grabModeAsync grabModeAsync none none currentTime
font <- initXMF (gs_font gsconfig)
let screenWidth = toInteger $ rect_width scr
screenHeight = toInteger $ rect_height scr
@ -716,7 +706,7 @@ decorateName' w = do
-- | Builds a default gs config from a colorizer function.
buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) "white" True
buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) "white"
-- | Brings selected window to the current workspace.
bringSelected :: GSConfig Window -> X ()

221
XMonad/Actions/OnScreen.hs
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
--

59
XMonad/Actions/PhysicalScreens.hs
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.

545
XMonad/Actions/Profiles.hs
View File

@ -1,545 +0,0 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DerivingVia #-}
--------------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.Profiles
-- Description : Group your workspaces by similarity.
-- Copyright : (c) Mislav Zanic
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Mislav Zanic <mislavzanic3@gmail.com>
-- Stability : experimental
-- Portability : unportable
--
--------------------------------------------------------------------------------
module XMonad.Actions.Profiles
( -- * Overview
-- $overview
-- * Usage
-- $usage
-- * Types
ProfileId
, Profile(..)
, ProfileConfig(..)
-- * Hooks
, addProfiles
, addProfilesWithHistory
-- * Switching profiles
, switchToProfile
-- * Workspace navigation and keybindings
, wsFilter
, bindOn
-- * Loggers and pretty printers
, excludeWSPP
, profileLogger
-- * Prompts
, switchProfilePrompt
, addWSToProfilePrompt
, removeWSFromProfilePrompt
, switchProfileWSPrompt
, shiftProfileWSPrompt
-- * Utilities
, currentProfile
, profileIds
, previousProfile
, profileHistory
, allProfileWindows
, profileWorkspaces
)where
--------------------------------------------------------------------------------
import Data.Map.Strict (Map)
import Data.List
import qualified Data.Map.Strict as Map
import Control.DeepSeq
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import XMonad.Actions.CycleWS
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.Loggers (Logger)
import XMonad.Prompt.Window (XWindowMap)
import XMonad.Actions.WindowBringer (WindowBringerConfig(..))
import XMonad.Actions.OnScreen (greedyViewOnScreen)
import XMonad.Hooks.Rescreen (addAfterRescreenHook)
import XMonad.Hooks.DynamicLog (PP(ppRename))
import XMonad.Prompt
--------------------------------------------------------------------------------
-- $overview
-- This module allows you to group your workspaces into 'Profile's based on certain similarities.
-- The idea is to expand upon the philosophy set by "XMonad.Actions.TopicSpace"
-- which states that you can look at a topic/workspace as a
-- single unit of work instead of multiple related units of work.
-- This comes in handy if you have lots of workspaces with windows open and need only to
-- work with a few of them at a time. With 'Profile's, you can focus on those few workspaces that
-- require your attention by not displaying, or allowing you to switch to the rest of the workspaces.
-- The best example is having a profile for development and a profile for leisure activities.
--------------------------------------------------------------------------------
-- $usage
-- To use @Profiles@ you need to add it to your XMonad configuration
-- and configure your profiles.
--
-- First you'll need to handle the imports.
--
-- > import XMonad.Actions.Profiles
-- > import XMonad.Util.EZConfig -- for keybindings
-- > import qualified XMonad.StackSet as W
-- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO -- for workspace navigation
--
-- Next you'll need to define your profiles.
--
-- > myStartingProfile :: ProfileId
-- > myStartingProfile = "Work"
-- >
-- > myProfiles :: [Profile]
-- > myProfiles =
-- > [ Profile { profileId = "Home"
-- > , profileWS = [ "www"
-- > , "rss"
-- > , "vid"
-- > , "vms"
-- > , "writing"
-- > , "notes"
-- > ]
-- > }
-- > , Profile { profileId = "Work"
-- > , profileWS = [ "www"
-- > , "slack"
-- > , "dev"
-- > , "k8s"
-- > , "notes"
-- > ]
-- > }
-- > ]
--
-- So, while using @Home@ 'Profile', you'll only be able to see, navigate to and
-- do actions with @["www", "rss", "vid", "vms", "writing", "notes"]@ workspaces.
--
-- You may also need to define some keybindings. Since @M-1@ .. @M-9@ are
-- sensible keybindings for switching workspaces, you'll need to use
-- 'bindOn' to have different keybindings per profile.
-- Here, we'll use "XMonad.Util.EZConfig" syntax:
--
-- > myKeys :: [(String, X())]
-- > myKeys =
-- > [ ("M-p", switchProfilePrompt xpConfig)
-- > , ("M-g", switchProfileWSPrompt xpConfig)
-- > , ("M1-j", DO.moveTo Next wsFilter)
-- > , ("M1-k", DO.moveTo Prev wsFilter)
-- > ]
-- > <>
-- > [ ("M-" ++ m ++ k, bindOn $ map (\x -> (fst x, f $ snd x)) i)
-- > | (i, k) <- map (\(x:xs) -> (map fst (x:xs), snd x)) $ sortGroupBy snd tupleList
-- > , (f, m) <- [(mby $ windows . W.greedyView, ""), (mby $ windows . W.shift, "S-")]
-- > ]
-- > where
-- > mby f wid = if wid == "" then return () else f wid
-- > sortGroupBy f = groupBy (\ x y -> f x == f y) . sortBy (\x y -> compare (f x) (f y))
-- > tupleList = concatMap (\p -> zip (map (\wid -> (profileId p, wid)) (profileWS p <> repeat "")) (map show [1..9 :: Int])) myProfiles
--
-- After that, you'll need to hook @Profiles@ into your XMonad config:
--
-- > main = xmonad $ addProfiles def { profiles = myProfiles
-- > , startingProfile = myStartingProfile
-- > }
-- > $ def `additionalKeysP` myKeys
--
--------------------------------------------------------------------------------
type ProfileId = String
type ProfileMap = Map ProfileId Profile
--------------------------------------------------------------------------------
-- | Profile representation.
data Profile = Profile
{ profileId :: !ProfileId -- ^ Profile name.
, profileWS :: ![WorkspaceId] -- ^ A list of workspaces contained within a profile.
}
--------------------------------------------------------------------------------
-- | Internal profile state.
data ProfileState = ProfileState
{ profilesMap :: !ProfileMap
, current :: !(Maybe Profile)
, previous :: !(Maybe ProfileId)
}
--------------------------------------------------------------------------------
-- | User config for profiles.
data ProfileConfig = ProfileConfig
{ workspaceExcludes :: ![WorkspaceId] -- ^ A list of workspaces to exclude from the @profileHistoryHook@.
, profiles :: ![Profile] -- ^ A list of user-defined profiles.
, startingProfile :: !ProfileId -- ^ Profile shown on startup.
}
--------------------------------------------------------------------------------
instance Default ProfileConfig where
def = ProfileConfig { workspaceExcludes = []
, profiles = []
, startingProfile = ""
}
--------------------------------------------------------------------------------
instance ExtensionClass ProfileState where
initialValue = ProfileState Map.empty Nothing Nothing
--------------------------------------------------------------------------------
-- Internal type for history tracking.
-- Main problem with @XMonad.Hooks.HistoryHook@ is that it isn't profile aware.
-- Because of that, when switching to a previous workspace, you might switch to
-- a workspace
newtype ProfileHistory = ProfileHistory
{ history :: Map ProfileId [(ScreenId, WorkspaceId)]
}
deriving (Read, Show)
deriving NFData via Map ProfileId [(Int, WorkspaceId)]
--------------------------------------------------------------------------------
instance ExtensionClass ProfileHistory where
extensionType = PersistentExtension
initialValue = ProfileHistory Map.empty
--------------------------------------------------------------------------------
newtype ProfilePrompt = ProfilePrompt String
--------------------------------------------------------------------------------
instance XPrompt ProfilePrompt where
showXPrompt (ProfilePrompt x) = x
--------------------------------------------------------------------------------
defaultProfile :: Profile
defaultProfile = defaultProfile
--------------------------------------------------------------------------------
-- | Returns current profile.
currentProfile :: X ProfileId
currentProfile = profileId . fromMaybe defaultProfile . current <$> XS.get
--------------------------------------------------------------------------------
-- | Returns previous profile.
previousProfile :: X (Maybe ProfileId)
previousProfile = XS.gets previous
--------------------------------------------------------------------------------
-- | Returns the history of viewed workspaces per profile.
profileHistory :: X (Map ProfileId [(ScreenId, WorkspaceId)])
profileHistory = XS.gets history
--------------------------------------------------------------------------------
profileMap :: X ProfileMap
profileMap = XS.gets profilesMap
--------------------------------------------------------------------------------
-- | Returns ids of all profiles.
profileIds :: X [ProfileId]
profileIds = Map.keys <$> XS.gets profilesMap
--------------------------------------------------------------------------------
currentProfileWorkspaces :: X [WorkspaceId]
currentProfileWorkspaces = XS.gets current <&> profileWS . fromMaybe defaultProfile
--------------------------------------------------------------------------------
-- | Hook profiles into XMonad. This function adds a startup hook that
-- sets up ProfileState. Also adds an afterRescreenHook for viewing correct
-- workspaces when adding new screens.
addProfiles :: ProfileConfig -> XConfig a -> XConfig a
addProfiles profConf conf = addAfterRescreenHook hook $ conf
{ startupHook = profileStartupHook' <> startupHook conf
}
where
profileStartupHook' :: X()
profileStartupHook' = profilesStartupHook (profiles profConf) (startingProfile profConf)
hook = currentProfile >>= switchWSOnScreens
--------------------------------------------------------------------------------
-- | Hooks profiles into XMonad and enables Profile history logging.
addProfilesWithHistory :: ProfileConfig -> XConfig a -> XConfig a
addProfilesWithHistory profConf conf = conf'
{ logHook = profileHistoryHookExclude (workspaceExcludes profConf) <> logHook conf
}
where
conf' = addProfiles profConf conf
--------------------------------------------------------------------------------
profileHistoryHookExclude :: [WorkspaceId] -> X()
profileHistoryHookExclude ews = do
cur <- gets $ W.current . windowset
vis <- gets $ W.visible . windowset
pws <- currentProfileWorkspaces
p <- currentProfile
updateHist p $ workspaceScreenPairs $ filterWS pws $ cur:vis
where
workspaceScreenPairs wins = zip (W.screen <$> wins) (W.tag . W.workspace <$> wins)
filterWS pws = filter ((\wid -> (wid `elem` pws) && (wid `notElem` ews)) . W.tag . W.workspace)
--------------------------------------------------------------------------------
updateHist :: ProfileId -> [(ScreenId, WorkspaceId)] -> X()
updateHist pid xs = profileWorkspaces pid >>= XS.modify' . update
where
update pws hs = force $ hs { history = doUpdate pws $ history hs }
doUpdate pws hist = foldl (\acc (sid, wid) -> Map.alter (f pws sid wid) pid acc) hist xs
f pws sid wid val = case val of
Nothing -> pure [(sid, wid)]
Just hs -> pure $ let new = (sid, wid) in new:filterWS pws new hs
filterWS :: [WorkspaceId] -> (ScreenId, WorkspaceId) -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
filterWS pws new = filter (\x -> snd x `elem` pws && x /= new)
--------------------------------------------------------------------------------
-- | Adds profiles to ProfileState and sets current profile using .
profilesStartupHook :: [Profile] -> ProfileId -> X ()
profilesStartupHook ps pid = XS.modify go >> switchWSOnScreens pid
where
go :: ProfileState -> ProfileState
go s = s {profilesMap = update $ profilesMap s, current = setCurrentProfile $ Map.fromList $ map entry ps}
update :: ProfileMap -> ProfileMap
update = Map.union (Map.fromList $ map entry ps)
entry :: Profile -> (ProfileId, Profile)
entry p = (profileId p, p)
setCurrentProfile :: ProfileMap -> Maybe Profile
setCurrentProfile s = case Map.lookup pid s of
Nothing -> Just $ Profile pid []
Just pn -> Just pn
--------------------------------------------------------------------------------
setPrevious :: ProfileId -> X()
setPrevious name = XS.modify update
where
update ps = ps { previous = doUpdate ps }
doUpdate ps = case Map.lookup name $ profilesMap ps of
Nothing -> previous ps
Just p -> Just $ profileId p
--------------------------------------------------------------------------------
setProfile :: ProfileId -> X ()
setProfile p = currentProfile >>= setPrevious >> setProfile' p
--------------------------------------------------------------------------------
setProfile' :: ProfileId -> X ()
setProfile' name = XS.modify update
where
update ps = ps { current = doUpdate ps }
doUpdate ps = case Map.lookup name $ profilesMap ps of
Nothing -> current ps
Just p -> Just p
--------------------------------------------------------------------------------
-- | Switch to a profile.
switchToProfile :: ProfileId -> X()
switchToProfile pid = setProfile pid >> switchWSOnScreens pid
--------------------------------------------------------------------------------
-- | Returns the workspace ids associated with a profile id.
profileWorkspaces :: ProfileId -> X [WorkspaceId]
profileWorkspaces pid = profileMap >>= findPWs
where
findPWs pm = return . profileWS . fromMaybe defaultProfile $ Map.lookup pid pm
--------------------------------------------------------------------------------
-- | Prompt for adding a workspace id to a profile.
addWSToProfilePrompt :: XPConfig -> X()
addWSToProfilePrompt c = do
ps <- profileIds
mkXPrompt (ProfilePrompt "Add ws to profile:") c (mkComplFunFromList' c ps) f
where
f :: String -> X()
f p = do
vis <- gets $ fmap (W.tag . W.workspace) . W.visible . windowset
cur <- gets $ W.tag . W.workspace . W.current . windowset
hid <- gets $ fmap W.tag . W.hidden . windowset
let
arr = cur:(vis <> hid)
in mkXPrompt (ProfilePrompt "Ws to add to profile:") c (mkComplFunFromList' c arr) (`addWSToProfile` p)
--------------------------------------------------------------------------------
-- | Prompt for switching profiles.
switchProfilePrompt :: XPConfig -> X()
switchProfilePrompt c = do
ps <- profileIds
mkXPrompt (ProfilePrompt "Profile: ") c (mkComplFunFromList' c ps) switchToProfile
--------------------------------------------------------------------------------
-- | Prompt for switching workspaces.
switchProfileWSPrompt :: XPConfig -> X ()
switchProfileWSPrompt c = mkPrompt =<< currentProfileWorkspaces
where
mkPrompt pws = mkXPrompt (ProfilePrompt "Switch to workspace:") c (mkComplFunFromList' c pws) mbygoto
mbygoto wid = do
pw <- profileWorkspaces =<< currentProfile
unless (wid `notElem` pw) (windows . W.greedyView $ wid)
--------------------------------------------------------------------------------
-- | Prompt for shifting windows to a different workspace.
shiftProfileWSPrompt :: XPConfig -> X ()
shiftProfileWSPrompt c = mkPrompt =<< currentProfileWorkspaces
where
mkPrompt pws = mkXPrompt (ProfilePrompt "Send window to workspace:") c (mkComplFunFromList' c pws) mbyshift
mbyshift wid = do
pw <- profileWorkspaces =<< currentProfile
unless (wid `notElem` pw) (windows . W.shift $ wid)
--------------------------------------------------------------------------------
addWSToProfile :: WorkspaceId -> ProfileId -> X()
addWSToProfile wid pid = XS.modify go
where
go :: ProfileState -> ProfileState
go ps = ps {profilesMap = update $ profilesMap ps, current = update' $ fromMaybe defaultProfile $ current ps}
update :: ProfileMap -> ProfileMap
update mp = case Map.lookup pid mp of
Nothing -> mp
Just p -> if wid `elem` profileWS p then mp else Map.adjust f pid mp
f :: Profile -> Profile
f p = Profile pid (wid : profileWS p)
update' :: Profile -> Maybe Profile
update' cp = if profileId cp == pid && wid `notElem` profileWS cp then Just (Profile pid $ wid:profileWS cp) else Just cp
--------------------------------------------------------------------------------
-- | Prompt for removing a workspace from a profile.
removeWSFromProfilePrompt :: XPConfig -> X()
removeWSFromProfilePrompt c = do
ps <- profileIds
mkXPrompt (ProfilePrompt "Remove ws from profile:") c (mkComplFunFromList' c ps) f
where
f :: String -> X()
f p = do
arr <- profileWorkspaces p
mkXPrompt (ProfilePrompt "Ws to remove from profile:") c (mkComplFunFromList' c arr) $
\ws -> do
cp <- currentProfile
ws `removeWSFromProfile` p
when (cp == p) $ currentProfile >>= switchWSOnScreens
--------------------------------------------------------------------------------
removeWSFromProfile :: WorkspaceId -> ProfileId -> X()
removeWSFromProfile wid pid = XS.modify go
where
go :: ProfileState -> ProfileState
go ps = ps {profilesMap = update $ profilesMap ps, current = update' $ fromMaybe defaultProfile $ current ps}
update :: ProfileMap -> ProfileMap
update mp = case Map.lookup pid mp of
Nothing -> mp
Just p -> if wid `elem` profileWS p then Map.adjust f pid mp else mp
f :: Profile -> Profile
f p = Profile pid (delete wid $ profileWS p)
update' :: Profile -> Maybe Profile
update' cp = if profileId cp == pid && wid `elem` profileWS cp then Just (Profile pid $ delete wid $ profileWS cp) else Just cp
--------------------------------------------------------------------------------
-- | Pretty printer for a bar. Prints workspace ids of current profile.
excludeWSPP :: PP -> X PP
excludeWSPP pp = modifyPP <$> currentProfileWorkspaces
where
modifyPP pws = pp { ppRename = ppRename pp . printTag pws }
printTag pws tag = if tag `elem` pws then tag else ""
--------------------------------------------------------------------------------
-- | For cycling through workspaces associated with the current.
wsFilter :: WSType
wsFilter = WSIs $ currentProfileWorkspaces >>= (\ws -> return $ (`elem` ws) . W.tag)
--------------------------------------------------------------------------------
-- Takes care of placing correct workspaces on their respective screens.
-- It does this by reducing the history of a Profile until it gets an array of length
-- equal to the number of screens with pairs that have unique workspace ids.
switchWSOnScreens :: ProfileId -> X()
switchWSOnScreens pid = do
hist <- profileHistory
vis <- gets $ W.visible . windowset
cur <- gets $ W.current . windowset
pws <- profileMap <&> (profileWS . fromMaybe (Profile pid []) . Map.lookup pid)
case Map.lookup pid hist of
Nothing -> switchScreens $ zip (W.screen <$> (cur:vis)) pws
Just xs -> compareAndSwitch (f (W.screen <$> cur:vis) xs) (cur:vis) pws
where
f :: [ScreenId] -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
f sids = reorderUniq . reorderUniq . reverse . filter ((`elem` sids) . fst)
reorderUniq :: (Ord k, Ord v) => [(k,v)] -> [(v,k)]
reorderUniq = map (\(x,y) -> (y,x)) . uniq
uniq :: (Ord k, Ord v) => [(k,v)] -> [(k,v)]
uniq = Map.toList . Map.fromList
viewWS fview sid wid = windows $ fview sid wid
switchScreens = mapM_ (uncurry $ viewWS greedyViewOnScreen)
compareAndSwitch hist wins pws | length hist < length wins = switchScreens $ hist <> populateScreens hist wins pws
| otherwise = switchScreens hist
populateScreens hist wins pws = zip (filter (`notElem` map fst hist) $ W.screen <$> wins) (filter (`notElem` map snd hist) pws)
--------------------------------------------------------------------------------
chooseAction :: (String -> X ()) -> X ()
chooseAction f = XS.gets current <&> (profileId . fromMaybe defaultProfile) >>= f
--------------------------------------------------------------------------------
-- | Create keybindings per profile.
bindOn :: [(String, X ())] -> X ()
bindOn bindings = chooseAction chooser
where
chooser profile = case lookup profile bindings of
Just action -> action
Nothing -> case lookup "" bindings of
Just action -> action
Nothing -> return ()
--------------------------------------------------------------------------------
-- | Loggs currentProfile and all profiles with hidden workspaces
-- (workspaces that aren't shown on a screen but have windows).
profileLogger :: (String -> String) -> (String -> String) -> Logger
profileLogger formatFocused formatUnfocused = do
hws <- gets $ W.hidden . windowset
p <- currentProfile
hm <- map fst
. filter (\(p', xs) -> any ((`elem` htags hws) . snd) xs || p' == p)
. Map.toList <$> profileHistory
return $ Just $ foldl (\a b -> a ++ " " ++ b) "" $ format p <$> hm
where
format p a = if a == p then formatFocused a else formatUnfocused a
htags wins = W.tag <$> filter (isJust . W.stack) wins
--------------------------------------------------------------------------------
-- | @XWindowMap@ of all windows contained in a profile.
allProfileWindows :: XWindowMap
allProfileWindows = allProfileWindows' def
--------------------------------------------------------------------------------
allProfileWindows' :: WindowBringerConfig -> XWindowMap
allProfileWindows' WindowBringerConfig{ windowTitler = titler, windowFilter = include } = do
pws <- currentProfileWorkspaces
windowSet <- gets windowset
Map.fromList . concat <$> mapM keyValuePairs (filter ((`elem` pws) . W.tag) $ W.workspaces windowSet)
where keyValuePairs ws = let wins = W.integrate' (W.stack ws)
in mapM (keyValuePair ws) =<< filterM include wins
keyValuePair ws w = (, w) <$> titler ws w

4
XMonad/Actions/Search.hs
View File

@ -437,14 +437,14 @@ namedEngine name (SearchEngine _ site) = searchEngineF name site
browser. -}
promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X ()
promptSearchBrowser config browser (SearchEngine name site) = do
hc <- historyCompletionP config ("Search [" `isPrefixOf`)
hc <- historyCompletionP ("Search [" `isPrefixOf`)
mkXPrompt (Search name) config hc $ search browser site
{- | Like 'promptSearchBrowser', but only suggest previous searches for the
given 'SearchEngine' in the prompt. -}
promptSearchBrowser' :: XPConfig -> Browser -> SearchEngine -> X ()
promptSearchBrowser' config browser (SearchEngine name site) = do
hc <- historyCompletionP config (searchName `isPrefixOf`)
hc <- historyCompletionP (searchName `isPrefixOf`)
mkXPrompt (Search name) config hc $ search browser site
where
searchName = showXPrompt (Search name)

26
XMonad/Actions/Submap.hs
View File

@ -18,7 +18,6 @@ module XMonad.Actions.Submap (
-- $usage
submap,
visualSubmap,
visualSubmapSorted,
submapDefault,
submapDefaultWithKey,
@ -89,32 +88,15 @@ visualSubmap :: WindowConfig -- ^ The config for the spawned window.
-> M.Map (KeyMask, KeySym) (String, X ())
-- ^ A map @keybinding -> (description, action)@.
-> X ()
visualSubmap = visualSubmapSorted id
-- | Like 'visualSubmap', but is able to sort the descriptions.
-- For example,
--
-- > import Data.Ord (comparing, Down)
-- >
-- > visualSubmapSorted (sortBy (comparing Down)) def
--
-- would sort the @(key, description)@ pairs by their keys in descending
-- order.
visualSubmapSorted :: ([((KeyMask, KeySym), String)] -> [((KeyMask, KeySym), String)])
-- ^ A function to resort the descriptions
-> WindowConfig -- ^ The config for the spawned window.
-> M.Map (KeyMask, KeySym) (String, X ())
-- ^ A map @keybinding -> (description, action)@.
-> X ()
visualSubmapSorted sorted wc keys =
visualSubmap wc keys =
withSimpleWindow wc descriptions waitForKeyPress >>= \(m', s) ->
maybe (pure ()) snd (M.lookup (m', s) keys)
where
descriptions :: [String]
descriptions =
map (\(key, desc) -> keyToString key <> ": " <> desc)
. sorted
$ zip (M.keys keys) (map fst (M.elems keys))
zipWith (\key desc -> keyToString key <> ": " <> desc)
(M.keys keys)
(map fst (M.elems keys))
-- | Give a name to an action.
subName :: String -> X () -> (String, X ())

169
XMonad/Actions/UpKeys.hs
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-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 ()

36
XMonad/Actions/WindowBringer.hs
View File

@ -22,7 +22,6 @@ module XMonad.Actions.WindowBringer (
WindowBringerConfig(..),
gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs',
bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs',
copyMenu, copyMenuConfig, copyMenu', copyMenuArgs, copyMenuArgs',
windowMap, windowAppMap, windowMap', bringWindow, actionMenu
) where
@ -34,7 +33,6 @@ import XMonad
import qualified XMonad as X
import XMonad.Util.Dmenu (menuMapArgs)
import XMonad.Util.NamedWindows (getName, getNameWMClass)
import XMonad.Actions.CopyWindow (copyWindow)
-- $usage
--
@ -46,7 +44,6 @@ import XMonad.Actions.CopyWindow (copyWindow)
--
-- > , ((modm .|. shiftMask, xK_g ), gotoMenu)
-- > , ((modm .|. shiftMask, xK_b ), bringMenu)
-- > , ((modm .|. shiftMask, xK_y ), copyMenu)
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
@ -93,37 +90,6 @@ gotoMenu' cmd = gotoMenuConfig def { menuArgs = [], menuCommand = cmd }
gotoMenuArgs' :: String -> [String] -> X ()
gotoMenuArgs' cmd args = gotoMenuConfig def { menuCommand = cmd, menuArgs = args }
-- | Pops open a dmenu with window titles. Choose one, and it will be copied into your current workspace.
copyMenu :: X ()
copyMenu = copyMenuArgs def
-- | Pops open a dmenu with window titles. Choose one, and it will be
-- copied into your current workspace. This version
-- accepts a configuration object.
copyMenuConfig :: WindowBringerConfig -> X ()
copyMenuConfig wbConfig = actionMenu wbConfig copyBringWindow
-- | Pops open a dmenu with window titles. Choose one, and it will be
-- copied into your current workspace. This version
-- takes a list of arguments to pass to dmenu.
copyMenuArgs :: [String] -> X ()
copyMenuArgs args = copyMenuConfig def { menuArgs = args }
-- | Pops open an application with window titles given over stdin. Choose one,
-- and it will be copied into your current workspace.
copyMenu' :: String -> X ()
copyMenu' cmd = copyMenuConfig def { menuArgs = [], menuCommand = cmd }
-- | Pops open an application with window titles given over stdin. Choose one,
-- and it will be copied into your current
-- workspace. This version allows arguments to the chooser to be specified.
copyMenuArgs' :: String -> [String] -> X ()
copyMenuArgs' cmd args = copyMenuConfig def { menuArgs = args, menuCommand = cmd }
-- | Brings a copy of the specified window into the current workspace.
copyBringWindow :: Window -> X.WindowSet -> X.WindowSet
copyBringWindow w ws = copyWindow w (W.currentTag ws) ws
-- | Pops open a dmenu with window titles. Choose one, and it will be
-- dragged, kicking and screaming, into your current workspace.
bringMenu :: X ()
@ -193,7 +159,7 @@ decorateName ws w = do
return $ name ++ " [" ++ W.tag ws ++ "]"
-- | Returns the window name as will be listed in dmenu. This will
-- return the executable name of the window along with its workspace
-- return the executable name of the window along with it's workspace
-- ID.
decorateAppName :: X.WindowSpace -> Window -> X String
decorateAppName ws w = do

361
XMonad/Actions/WindowNavigation.hs
View File

@ -1,12 +1,10 @@
{-# LANGUAGE TupleSections #-} -- I didn't want this, it's hlint's "suggestion" and it's apparently non-negotiable
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.WindowNavigation
-- Description : Experimental rewrite of "XMonad.Layout.WindowNavigation".
-- Copyright : (c) 2007 David Roundy <droundy@darcs.net>,
-- Devin Mullins <me@twifkak.com>
-- Maintainer : Devin Mullins <me@twifkak.com>,
-- Platon Pronko <platon7pronko@gmail.com>
-- Maintainer : Devin Mullins <me@twifkak.com>
-- License : BSD3-style (see LICENSE)
-- Stability : unstable
-- Portability : unportable
@ -39,19 +37,17 @@ module XMonad.Actions.WindowNavigation (
withWindowNavigationKeys,
WNAction(..),
go, swap,
goPure, swapPure,
Direction2D(..), WNState,
) where
import XMonad hiding (state)
import XMonad.Prelude (catMaybes, fromMaybe, sortOn)
import XMonad
import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, sortOn)
import XMonad.Util.Types (Direction2D(..))
import qualified XMonad.StackSet as W
import Control.Arrow (second)
import Data.IORef
import Data.Map (Map())
import Data.List (partition, find)
import qualified Data.Map as M
import qualified Data.Set as S
@ -105,60 +101,27 @@ withWindowNavigation (u,l,d,r) conf@XConfig{modMask=modm} =
withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
withWindowNavigationKeys wnKeys conf = do
stateRef <- newIORef M.empty
return conf { keys = \cnf -> M.fromList (map (second (fromWNAction stateRef)) wnKeys)
posRef <- newIORef M.empty
return conf { keys = \cnf -> M.fromList (map (second (fromWNAction posRef)) wnKeys)
`M.union` keys conf cnf,
logHook = logHook conf >> trackMovement stateRef }
where fromWNAction stateRef (WNGo dir) = go stateRef dir
fromWNAction stateRef (WNSwap dir) = swap stateRef dir
logHook = logHook conf >> trackMovement posRef }
where fromWNAction posRef (WNGo dir) = go posRef dir
fromWNAction posRef (WNSwap dir) = swap posRef dir
data WNAction = WNGo Direction2D | WNSwap Direction2D
type WNState = Map WorkspaceId Point
-- | Focus window in the given direction.
-- go:
-- 1. get current position, verifying it matches the current window
-- 2. get target windowrect
-- 3. focus window
-- 4. set new position
go :: IORef WNState -> Direction2D -> X ()
go stateRef dir = runPureAction stateRef (goPure dir)
go = withTargetWindow W.focusWindow
-- | Swap current window with the window in the given direction.
-- Note: doesn't work with floating windows (don't think it makes much sense to swap floating windows).
swap :: IORef WNState -> Direction2D -> X ()
swap stateRef dir = runPureAction stateRef (swapPure dir)
type WindowRectFn x = (Window -> x (Maybe Rectangle))
-- | (state, oldWindowSet, mappedWindows, windowRect)
type WNInput x = (WNState, WindowSet, S.Set Window, WindowRectFn x)
type WNOutput = (WNState, WindowSet)
-- | Run the pure action inside X monad.
runPureAction :: IORef WNState -> (WNInput X -> X WNOutput) -> X ()
runPureAction stateRef action = do
oldState <- io (readIORef stateRef)
oldWindowSet <- gets windowset
mappedWindows <- gets mapped
(newState, newWindowSet) <- action (oldState, oldWindowSet, mappedWindows, windowRectX)
windows (const newWindowSet)
io $ writeIORef stateRef newState
-- | Version of `go` not dependent on X monad (needed for testing).
goPure :: Monad x => Direction2D -> WNInput x -> x WNOutput
goPure dir input@(oldState, oldWindowSet, mappedWindows, _) =
if length (filter (`S.member` mappedWindows) $ W.integrate' $ W.stack $ W.workspace $ W.current oldWindowSet) == 1
then
-- Handle the special case of Full layout, when there's only one mapped window on a screen.
return ( oldState
, case dir of
U -> W.focusUp oldWindowSet
L -> W.focusDown oldWindowSet
D -> W.focusDown oldWindowSet
R -> W.focusUp oldWindowSet
)
else
withTargetWindow W.focusWindow dir input
-- | Version of `swap` not dependent on X monad (needed for testing).
swapPure :: Monad x => Direction2D -> WNInput x -> x WNOutput
swapPure = withTargetWindow swapWithFocused
swap = withTargetWindow swapWithFocused
where swapWithFocused targetWin winSet =
case W.peek winSet of
Just currentWin -> W.focusWindow currentWin $
@ -172,249 +135,87 @@ swapPure = withTargetWindow swapWithFocused
| win == win2 = win1
| otherwise = win
-- | Select a target window in the given direction and modify the WindowSet.
-- 1. Get current position, verifying it matches the current window (exit if no focused window).
-- 2. Get the target window.
-- 3. Execute an action on the target window and windowset.
-- 4. Set the new position.
withTargetWindow :: Monad x => (Window -> WindowSet -> WindowSet) -> Direction2D -> WNInput x -> x WNOutput
withTargetWindow adj dir input@(oldState, oldWindowSet, _, _) = do
whenJust' (getCurrentWindow input) (oldState, oldWindowSet) $ \(win, winRect, pos) -> do
targetMaybe <- find ((/= win) . fst) <$> navigableTargets input dir winRect pos
whenJust' (pure targetMaybe) (oldState, oldWindowSet) $ \(targetWin, newPos) ->
let newWindowSet = adj targetWin oldWindowSet
in return (modifyState newWindowSet newPos oldState, newWindowSet)
withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X ()
withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do
targets <- filter ((/= win) . fst) <$> navigableTargets pos dir
whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do
windows (adj targetWin)
setPosition posRef pos targetRect
-- | Update position on outside changes in windows.
trackMovement :: IORef WNState -> X ()
trackMovement stateRef = do
oldState <- io (readIORef stateRef)
oldWindowSet <- gets windowset
mappedWindows <- gets mapped
whenJust' (getCurrentWindow (oldState, oldWindowSet, mappedWindows, windowRectX)) () $ \(_, _, pos) -> do
io $ writeIORef stateRef $ modifyState oldWindowSet pos oldState
trackMovement posRef = fromCurrentPoint posRef $ \win pos ->
windowRect win >>= flip whenJust (setPosition posRef pos . snd)
-- | Get focused window and current position.
getCurrentWindow :: Monad x => WNInput x -> x (Maybe (Window, Rectangle, Point))
getCurrentWindow input@(_, oldWindowSet, _, _) =
whenJust' (pure $ W.peek oldWindowSet) Nothing $ \window -> do
(pos, rect) <- currentPosition input
return $ Just (window, rect, pos)
fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()
fromCurrentPoint posRef f = withFocused $ \win ->
currentPosition posRef >>= f win
-- | Gets the current position from the state passed in, or if nothing
-- (say, from a restart), derives the current position from the current window.
-- Also, verifies that the position is congruent with the current window
-- (say, if you moved focus using mouse or something).
-- Returns the window rectangle for convenience, since we'll need it later anyway.
currentPosition :: Monad x => WNInput x -> x (Point, Rectangle)
currentPosition (state, oldWindowSet, _, windowRect) = do
currentRect <- fromMaybe (Rectangle 0 0 0 0) <$> maybe (pure Nothing) windowRect (W.peek oldWindowSet)
let posMaybe = M.lookup (W.currentTag oldWindowSet) state
middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h)
return $ case posMaybe of
Nothing -> (middleOf currentRect, currentRect)
Just pos -> (centerPosition currentRect pos, currentRect)
-- Gets the current position from the IORef passed in, or if nothing (say, from
-- a restart), derives the current position from the current window. Also,
-- verifies that the position is congruent with the current window (say, if you
-- used mod-j/k or mouse or something).
currentPosition :: IORef WNState -> X Point
currentPosition posRef = do
root <- asks theRoot
currentWindow <- gets (W.peek . windowset)
currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow)
-- | Inserts new position into the state.
modifyState :: WindowSet -> Point -> WNState -> WNState
modifyState oldWindowSet =
M.insert (W.currentTag oldWindowSet)
wsid <- gets (W.currentTag . windowset)
mp <- M.lookup wsid <$> io (readIORef posRef)
-- | "Jumps" the current position into the middle of target rectangle.
-- (keeps the position as-is if it is already inside the target rectangle)
centerPosition :: Rectangle -> Point -> Point
centerPosition r@(Rectangle rx ry rw rh) pos@(Point x y) = do
if pointWithin x y r
then pos
else Point (midPoint rx rw) (midPoint ry rh)
return $ maybe (middleOf currentRect) (`inside` currentRect) mp
where middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h)
setPosition :: IORef WNState -> Point -> Rectangle -> X ()
setPosition posRef oldPos newRect = do
wsid <- gets (W.currentTag . windowset)
io $ modifyIORef posRef $ M.insert wsid (oldPos `inside` newRect)
inside :: Point -> Rectangle -> Point
Point x y `inside` Rectangle rx ry rw rh =
Point (x `within` (rx, rw)) (y `within` (ry, rh))
where pos `within` (lower, dim) = if pos >= lower && pos < lower + fromIntegral dim
then pos
else midPoint lower dim
midPoint :: Position -> Dimension -> Position
midPoint pos dim = pos + fromIntegral dim `div` 2
-- | Make a list of target windows we can navigate to,
-- sorted by desirability of navigation.
navigableTargets :: Monad x => WNInput x -> Direction2D -> Rectangle -> Point -> x [(Window, Point)]
navigableTargets input@(_, oldWindowSet, _, _) dir currentRect currentPos = do
allScreensWindowsAndRectangles <- mapSnd (rectTransform dir) <$> windowRects input
let
screenWindows = S.fromList $ W.integrate' $ W.stack $ W.workspace $ W.current oldWindowSet
(thisScreenWindowsAndRectangles, otherScreensWindowsAndRectangles) = partition (\(w, _) -> S.member w screenWindows) allScreensWindowsAndRectangles
navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)]
navigableTargets point dir = navigable dir point <$> windowRects
pos = pointTransform dir currentPos
wr = rectTransform dir currentRect
-- Filters and sorts the windows in terms of what is closest from the Point in
-- the Direction2D.
navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable d pt = sortby d . filter (inr d pt . snd)
rectInside r = (rect_p1 r >= rect_p1 wr && rect_p1 r < rect_p2 wr && rect_p2 r > rect_p1 wr && rect_p2 r <= rect_p2 wr) &&
((rect_o1 r >= rect_o1 wr && rect_o1 r < rect_o2 wr && rect_o2 r > rect_o1 wr && rect_o2 r <= rect_o2 wr) ||
(rect_o1 r <= rect_o1 wr && rect_o2 r >= rect_o2 wr)) -- include windows that fully overlaps current on the orthogonal axis
sortByP2 = sortOn (rect_p2 . snd)
posBeforeEdge r = point_p pos < rect_p2 r
-- Produces a list of normal-state windows, on any screen. Rectangles are
-- adjusted based on screen position relative to the current screen, because I'm
-- bad like that.
windowRects :: X [(Window, Rectangle)]
windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped
rectOverlapsEdge r = rect_p1 r <= rect_p2 wr && rect_p2 r > rect_p2 wr &&
rect_o1 r < rect_o2 wr && rect_o2 r > rect_o1 wr
rectOverlapsOneEdge r = rectOverlapsEdge r && rect_p1 r > rect_p1 wr
rectOverlapsBothEdges r = rectOverlapsEdge r &&
rect_o1 r > rect_o1 wr && rect_o2 r < rect_o2 wr && point_o pos >= rect_o1 r && point_o pos < rect_o2 r
distanceToRectEdge r = max (max 0 (rect_o1 r - point_o pos)) (max 0 (point_o pos + 1 - rect_o2 r))
distanceToRectCenter r =
let distance = (rect_o1 r + rect_o2 r) `div` 2 - point_o pos
in if distance <= 0
then distance + 1
else distance
sortByPosDistance = sortOn ((\r -> (rect_p1 r, distanceToRectEdge r, distanceToRectCenter r)) . snd)
rectOutside r = rect_p1 r < rect_p1 wr && rect_p2 r > rect_p2 wr &&
rect_o1 r < rect_o1 wr && rect_o2 r > rect_o2 wr
sortByLength = sortOn (rect_psize . snd)
rectAfterEdge r = rect_p1 r > rect_p2 wr
-- Modified from David Roundy and Devin Mullins original implementation of WindowNavigation:
inr r = point_p pos < rect_p2 r && point_o pos >= rect_o1 r && point_o pos < rect_o2 r
clamp v v1 v2 | v < v1 = v1
| v >= v2 = v2 - 1
| otherwise = v
dragPos r = DirPoint (max (point_p pos) (rect_p1 r)) (clamp (point_o pos) (rect_o1 r) (rect_o2 r))
return $ mapSnd (inversePointTransform dir) $ concat
[
-- First, navigate to windows that are fully inside current window
-- and have higher coordinate bigger than current position.
-- ┌──────────────────┐
-- │ current │ (all examples assume direction=R)
-- │ ┌──────────┐ │
-- │ ──┼─► inside │ │
-- │ └──────────┘ │
-- └──────────────────┘
-- Also include windows fully overlapping current on the orthogonal axis:
-- ┌──────────────┐
-- │ overlapping │
-- ┌───────────┤ ├────┐
-- │ current ──┼─► │ │
-- └───────────┤ ├────┘
-- └──────────────┘
mapSnd dragPos $ sortByP2 $ filterSnd posBeforeEdge $ filterSnd rectInside thisScreenWindowsAndRectangles
-- Then navigate to windows that touch or overlap the edge of current window in the chosen direction.
-- ┌──────────────┬─────────────┐ ┌───────────┐ ┌─────────────┐
-- │ current │ adjacent │ │ current │ │ current │
-- │ ──┼─► │ │ ┌───┴───────────────┐ │ ┌───┴─────────────┐
-- │ │ │ │ ──┼─► │ overlapping │ │ ──┼─► │
-- │ ├─────────────┘ │ └───┬───────────────┘ └─────────┤ overlapping │
-- │ │ │ │ │ │
-- └──────────────┘ └───────────┘ └─────────────────┘
, mapSnd dragPos $ sortByPosDistance $ filterSnd rectOverlapsOneEdge thisScreenWindowsAndRectangles
-- Windows fully overlapping current window "in the middle" on the parallel axis are also included,
-- if position is inside them:
-- ┌───────────┐
-- │ current │
-- ┌───┤-----------├────────────────┐
-- │ │ * ──┼─► overlapping │
-- └───┤-----------├────────────────┘
-- └───────────┘
, mapSnd (\_ -> DirPoint (rect_p2 wr) (point_o pos)) $ sortByPosDistance $ filterSnd rectOverlapsBothEdges thisScreenWindowsAndRectangles
-- Then navigate to windows that fully encompass the current window.
-- ┌─────────────────────┐
-- │ outer │
-- │ ┌─────────────┐ │
-- │ │ current ──┼─► │
-- │ └─────────────┘ │
-- └─────────────────────┘
, mapSnd (\_ -> DirPoint (rect_p2 wr) (point_o pos)) $ sortByLength $ filterSnd rectOutside thisScreenWindowsAndRectangles
-- Then navigate to windows that are fully after current window in the chosen direction.
-- ┌──────────────┐
-- │ current │ ┌────────────────┐
-- │ │ │ │
-- │ ──┼──┼─► not adjacent │
-- │ │ │ │
-- │ │ └────────────────┘
-- └──────────────┘
, mapSnd dragPos $ sortByPosDistance $ filterSnd rectAfterEdge thisScreenWindowsAndRectangles
-- Cast a ray from the current position, jump to the first window (on another screen) that intersects this ray.
, mapSnd dragPos $ sortByPosDistance $ filterSnd inr otherScreensWindowsAndRectangles
-- If everything else fails, then navigate to the window that is fully inside current window,
-- but is before the current position.
-- This can happen when we are at the last window on a screen, and attempt to navigate even further.
-- In this case it seems okay to jump to the remaining inner windows, since we don't have any other choice anyway,
-- and user is probably not so fully aware of the precise position anyway.
, mapSnd (\r -> DirPoint (rect_p2 r - 1) (clamp (point_o pos) (rect_o1 r) (rect_o2 r))) $
sortByP2 $ filterSnd (not . posBeforeEdge) $ filterSnd rectInside thisScreenWindowsAndRectangles
]
-- Structs for direction-independent space - equivalent to rotating points and rectangles such that
-- navigation direction points to the right.
-- Allows us to abstract over direction in the navigation functions.
data DirPoint = DirPoint
{ point_p :: Position -- coordinate parallel to the direction
, point_o :: Position -- coordinate orthogonal to the direction
}
data DirRectangle = DirRectangle
{ rect_p1 :: Position -- lower rectangle coordinate parallel to the direction
, rect_p2 :: Position -- higher rectangle coordinate parallel to the direction
, rect_o1 :: Position -- lower rectangle coordinate orthogonal to the direction
, rect_o2 :: Position -- higher rectangle coordinate orthogonal to the direction
}
{- HLINT ignore "Use camelCase" -}
rect_psize :: DirRectangle -> Dimension
rect_psize r = fromIntegral (rect_p2 r - rect_p1 r)
-- | Transform a point from screen space into direction-independent space.
pointTransform :: Direction2D -> Point -> DirPoint
pointTransform dir (Point x y) = case dir of
U -> DirPoint (negate y - 1) x
L -> DirPoint (negate x - 1) (negate y - 1)
D -> DirPoint y (negate x - 1)
R -> DirPoint x y
-- | Transform a point from direction-independent space back into screen space.
inversePointTransform :: Direction2D -> DirPoint -> Point
inversePointTransform dir p = case dir of
U -> Point (point_o p) (negate $ point_p p + 1)
L -> Point (negate $ point_p p + 1) (negate $ point_o p + 1)
D -> Point (negate $ point_o p + 1) (point_p p)
R -> Point (point_p p) (point_o p)
-- | Transform a rectangle from screen space into direction-independent space.
rectTransform :: Direction2D -> Rectangle -> DirRectangle
rectTransform dir (Rectangle x y w h) = case dir of
U -> DirRectangle (negate $ y + fromIntegral h) (negate y) x (x + fromIntegral w)
L -> DirRectangle (negate $ x + fromIntegral w) (negate x) (negate $ y + fromIntegral h) (negate y)
D -> DirRectangle y (y + fromIntegral h) (negate $ x + fromIntegral w) (negate x)
R -> DirRectangle x (x + fromIntegral w) y (y + fromIntegral h)
-- | Produces a list of normal-state windows on all screens, excluding currently focused window.
windowRects :: Monad x => WNInput x -> x [(Window, Rectangle)]
windowRects (_, oldWindowSet, mappedWindows, windowRect) =
let
allWindows = filter (\w -> w `notElem` W.peek oldWindowSet) $ S.toList mappedWindows
windowRect2 w = fmap (w,) <$> windowRect w
in catMaybes <$> mapM windowRect2 allWindows
windowRectX :: Window -> X (Maybe Rectangle)
windowRectX win = withDisplay $ \dpy -> do
windowRect :: Window -> X (Maybe (Window, Rectangle))
windowRect win = withDisplay $ \dpy -> do
(_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw)
return $ Just (win, Rectangle x y (w + 2 * bw) (h + 2 * bw))
`catchX` return Nothing
-- Maybe below functions can be replaced with some standard helper functions?
-- Modified from droundy's implementation of WindowNavigation:
-- | Execute a monadic action on the contents if Just, otherwise wrap default value and return it.
whenJust' :: Monad x => x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' monadMaybeValue deflt f = do
maybeValue <- monadMaybeValue
case maybeValue of
Nothing -> return deflt
Just value -> f value
inr :: Direction2D -> Point -> Rectangle -> Bool
inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w &&
py < ry + fromIntegral h
inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w &&
py > ry
inr R (Point px py) (Rectangle rx ry w h) = px < rx + fromIntegral w &&
py >= ry && py < ry + fromIntegral h
inr L (Point px py) (Rectangle rx ry _ h) = px > rx &&
py >= ry && py < ry + fromIntegral h
-- | Filter a list of tuples on the second tuple member.
filterSnd :: (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd f = filter (f . snd)
-- | Map a second tuple member in a list of tuples.
mapSnd :: (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd f = map (second f)
sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
sortby D = sortOn (rect_y . snd)
sortby R = sortOn (rect_x . snd)
sortby U = reverse . sortby D
sortby L = reverse . sortby R

2
XMonad/Actions/WorkspaceNames.hs
View File

@ -138,7 +138,7 @@ setCurrentWorkspaceName name = do
-- | Prompt for a new name for the current workspace and set it.
renameWorkspace :: XPConfig -> X ()
renameWorkspace conf = do
completion <- historyCompletionP conf (prompt ==)
completion <- historyCompletionP (prompt ==)
mkXPrompt (Wor prompt) conf completion setCurrentWorkspaceName
where
prompt = "Workspace name: "

1
XMonad/Config/Prime.hs
View File

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

1
XMonad/Hooks/DebugEvents.hs
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

100
XMonad/Hooks/EwmhDesktops.hs
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
@ -528,17 +459,10 @@ ewmhDesktopsEventHook'
a_aw <- getAtom "_NET_ACTIVE_WINDOW"
a_cw <- getAtom "_NET_CLOSE_WINDOW"
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 | 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)
| mt == a_cd ->
trace $ "Bad _NET_CURRENT_DESKTOP with data=" ++ show d
| not (w `W.member` s) ->
-- do nothing for unmanaged windows; it'd be just a useless
-- refresh which breaks menus/popups of misbehaving apps that
-- send _NET_ACTIVE_WINDOW requests for override-redirect wins
mempty
| mt == a_d, n : _ <- d, Just ww <- ws !? fi n ->
if W.findTag w s == Just (W.tag ww) then mempty else windows $ W.shiftWin (W.tag ww) w
| mt == a_d ->
@ -549,6 +473,8 @@ ewmhDesktopsEventHook'
if W.peek s == Just w then mempty else windows $ W.focusWindow w
| mt == a_aw -> do
if W.peek s == Just w then mempty else windows . appEndo =<< runQuery activateHook w
| mt == a_cw ->
killWindow w
| otherwise ->
-- The Message is unknown to us, but that is ok, not all are meant
-- to be handled by the window manager

126
XMonad/Hooks/FloatConfigureReq.hs
View File

@ -1,126 +0,0 @@
{-# LANGUAGE LambdaCase #-}
-- |
-- Module : XMonad.Hooks.FloatConfigureReq
-- Description : Customize handling of floating windows' move\/resize\/restack requests (ConfigureRequest).
-- Copyright : (c) 2024 Tomáš Janoušek <tomi@nomi.cz>
-- License : BSD3
-- Maintainer : Tomáš Janoušek <tomi@nomi.cz>
--
-- xmonad normally honours those requests by doing exactly what the client
-- application asked, and refreshing. There are some misbehaving clients,
-- however, that:
--
-- * try to move their window to the last known absolute position regardless
-- of the current xrandr/xinerama layout
--
-- * move their window to 0, 0 for no particular reason (e.g. rxvt-unicode)
--
-- * issue lots of no-op requests causing flickering (e.g. Steam)
--
-- This module provides a replacement handler for 'ConfigureRequestEvent' to
-- work around such misbehaviours.
--
module XMonad.Hooks.FloatConfigureReq (
-- * Usage
-- $usage
MaybeMaybeManageHook,
floatConfReqHook,
-- * Known workarounds
fixSteamFlicker,
fixSteamFlickerMMMH,
) where
import qualified Data.Map.Strict as M
import XMonad
import XMonad.Hooks.ManageHelpers
import XMonad.Prelude
import qualified XMonad.StackSet as W
-- $usage
-- To use this, include the following in your @xmonad.hs@:
--
-- > import XMonad.Hooks.FloatConfigureReq
-- > import XMonad.Hooks.ManageHelpers
--
-- > myFloatConfReqHook :: MaybeMaybeManageHook
-- > myFloatConfReqHook = composeAll
-- > [ … ]
--
-- > myEventHook :: Event -> X All
-- > myEventHook = mconcat
-- > [ …
-- > , floatConfReqHook myFloatConfReqHook
-- > , … ]
--
-- > main = xmonad $ …
-- > $ def{ handleEventHook = myEventHook
-- > , … }
--
-- Then fill the @myFloatConfReqHook@ with whatever custom rules you need.
--
-- As an example, the following will prevent rxvt-unicode from moving its
-- (floating) window to 0, 0 after a font change but still ensure its size
-- increment hints are respected:
--
-- > className =? "URxvt" -?> pure <$> doFloat
--
-- Another example that avoids flickering and xmonad slowdowns caused by the
-- Steam client (completely ignore all its requests, none of which are
-- meaningful in the context of a tiling WM):
--
-- > map toLower `fmap` className =? "steam" -?> mempty
--
-- (this example is also available as 'fixSteamFlickerMMMH' to be added to
-- one's @myFloatConfReqHook@ and also 'fixSteamFlicker' to be added directly
-- to one's 'handleEventHook')
-- | A variant of 'MaybeManageHook' that additionally may or may not make
-- changes to the 'WindowSet'.
type MaybeMaybeManageHook = Query (Maybe (Maybe (Endo WindowSet)))
-- | Customizable handler for a 'ConfigureRequestEvent'. If the event's
-- 'ev_window' is a managed floating window, the provided
-- 'MaybeMaybeManageHook' is consulted and its result interpreted as follows:
--
-- * @Nothing@ - no match, fall back to the default handler
--
-- * @Just Nothing@ - match but ignore, no refresh, just send ConfigureNotify
--
-- * @Just (Just a)@ - match, modify 'WindowSet', refresh, send ConfigureNotify
floatConfReqHook :: MaybeMaybeManageHook -> Event -> X All
floatConfReqHook mh ConfigureRequestEvent{ev_window = w} =
runQuery (join <$> (isFloatQ -?> mh)) w >>= \case
Nothing -> mempty
Just e -> do
whenJust e (windows . appEndo)
sendConfEvent
pure (All False)
where
sendConfEvent = withDisplay $ \dpy ->
withWindowAttributes dpy w $ \wa -> do
io . allocaXEvent $ \ev -> do
-- We may have made no changes to the window size/position
-- and thus the X server didn't emit any ConfigureNotify,
-- so we need to send the ConfigureNotify ourselves to make
-- sure there is a reply to this ConfigureRequestEvent and the
-- window knows we (possibly) ignored its request.
setEventType ev configureNotify
setConfigureEvent ev w w
(wa_x wa) (wa_y wa) (wa_width wa)
(wa_height wa) (wa_border_width wa) none (wa_override_redirect wa)
sendEvent dpy w False 0 ev
floatConfReqHook _ _ = mempty
-- | A 'Query' to determine if a window is floating.
isFloatQ :: Query Bool
isFloatQ = ask >>= \w -> liftX . gets $ M.member w . W.floating . windowset
-- | A pre-packaged 'floatConfReqHook' that fixes flickering of the Steam client by ignoring 'ConfigureRequestEvent's on any of its floating windows.
--
-- To use this, add 'fixSteamFlicker' to your 'handleEventHook'.
fixSteamFlicker :: Event -> X All
fixSteamFlicker = floatConfReqHook fixSteamFlickerMMMH
fixSteamFlickerMMMH :: MaybeMaybeManageHook
fixSteamFlickerMMMH = map toLower `fmap` className =? "steam" -?> mempty

10
XMonad/Hooks/ManageHelpers.hs
View File

@ -51,7 +51,6 @@ module XMonad.Hooks.ManageHelpers (
isFullscreen,
isMinimized,
isDialog,
isNotification,
pid,
desktop,
transientTo,
@ -192,18 +191,9 @@ isMinimized :: Query Bool
isMinimized = isInProperty "_NET_WM_STATE" "_NET_WM_STATE_HIDDEN"
-- | A predicate to check whether a window is a dialog.
--
-- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm46485863906176>.
isDialog :: Query Bool
isDialog = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG"
-- | A predicate to check whether a window is a notification.
--
-- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm46485863906176>.
isNotification :: Query Bool
isNotification =
isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_NOTIFICATION"
-- | This function returns 'Just' the @_NET_WM_PID@ property for a
-- particular window if set, 'Nothing' otherwise.
--

4
XMonad/Hooks/OnPropertyChange.hs
View File

@ -41,13 +41,13 @@ import XMonad.Prelude
-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Hooks.OnPropertyChange
-- > import XMonad.Hooks.DynamicProperty
--
-- Enable it by including in you handleEventHook definition:
--
-- > main = xmonad $ def
-- > { ...
-- > , handleEventHook = onXPropertyChange "WM_NAME" (title =? "Spotify" --> doShift "5")
-- > , handleEventHook = onXPropertyChange "WM_NAME" (title =? "Spotify" --> doShift "5"))
-- > , ...
-- > }
--

50
XMonad/Hooks/Rescreen.hs
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,

196
XMonad/Hooks/ScreenCorners.hs
View File

@ -1,51 +1,48 @@
{-# 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
-- 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
deriving (Eq, Ord, Show)
--------------------------------------------------------------------------------
-- ExtensibleState modifications
@ -54,89 +51,77 @@ 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
--------------------------------------------------------------------------------
-- "Translate" a ScreenCorner to real (x,y) Positions with proper width and
-- height.
-- "Translate" a ScreenCorner to real (x,y) Positions
createWindowAt :: ScreenCorner -> X Window
createWindowAt SCUpperLeft = createWindowAt' 0 0 1 1
createWindowAt SCUpperLeft = createWindowAt' 0 0
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
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)
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
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
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
createWindowAt SCLeft = withDisplay $ \dpy ->
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
in createWindowAt' (fi w) (fi h)
-- 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)
-- Create a new X window at a (x,y) Position
createWindowAt' :: Position -> Position -> X Window
createWindowAt' x y = withDisplay $ \dpy -> io $ do
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
w <- allocaSetWindowAttributes $ \attributes -> do
set_override_redirect attributes True
createWindow dpy -- display
rootw -- parent window
x -- x
y -- y
1 -- width
1 -- 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
@ -144,40 +129,42 @@ 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
-- features to XMonad. By moving your cursor into one of your screen corners
-- or edges, you can trigger an @X ()@ action, for example
-- @"XMonad.Actions.GridSelect".goToSelected@ or
-- This extension adds KDE-like screen corners to XMonad. By moving your cursor
-- into one of your screen corners you can trigger an @X ()@ action, for
-- example @"XMonad.Actions.GridSelect".goToSelected@ or
-- @"XMonad.Actions.CycleWS".nextWS@ etc.
--
-- To use it, import it on top of your @xmonad.hs@:
@ -189,7 +176,6 @@ screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout
-- > myStartupHook = do
-- > ...
-- > addScreenCorner SCUpperRight (goToSelected def { gs_cellwidth = 200})
-- > addScreenCorner SCBottom (goToSelected def)
-- > addScreenCorners [ (SCLowerRight, nextWS)
-- > , (SCLowerLeft, prevWS)
-- > ]

16
XMonad/Hooks/StatusBar.hs
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
@ -452,7 +452,7 @@ instance ExtensionClass ActiveSBs where
-- 'avoidStruts', check 'dynamicEasySBs'.
--
-- Heavily inspired by "XMonad.Hooks.DynamicBars"
dynamicSBs :: (ScreenId -> X StatusBarConfig) -> XConfig l -> XConfig l
dynamicSBs :: (ScreenId -> IO StatusBarConfig) -> XConfig l -> XConfig l
dynamicSBs f conf = addAfterRescreenHook (updateSBs f) $ conf
{ startupHook = startupHook conf >> killAllStatusBars >> updateSBs f
, logHook = logHook conf >> logSBs
@ -462,7 +462,7 @@ dynamicSBs f conf = addAfterRescreenHook (updateSBs f) $ conf
-- resulting config and adds 'avoidStruts' to the
-- layout.
dynamicEasySBs :: LayoutClass l Window
=> (ScreenId -> X StatusBarConfig)
=> (ScreenId -> IO StatusBarConfig)
-> XConfig l
-> XConfig (ModifiedLayout AvoidStruts l)
dynamicEasySBs f conf =
@ -471,7 +471,7 @@ dynamicEasySBs f conf =
-- | Given the function to create status bars, update
-- the status bars by killing those that shouldn't be
-- visible anymore and creates any missing status bars
updateSBs :: (ScreenId -> X StatusBarConfig) -> X ()
updateSBs :: (ScreenId -> IO StatusBarConfig) -> X ()
updateSBs f = do
actualScreens <- withWindowSet $ return . map W.screen . W.screens
(toKeep, toKill) <-
@ -480,7 +480,7 @@ updateSBs f = do
cleanSBs (map snd toKill)
-- Create new status bars if needed
let missing = actualScreens \\ map fst toKeep
added <- traverse (\s -> (s,) <$> f s) missing
added <- io $ traverse (\s -> (s,) <$> f s) missing
traverse_ (sbStartupHook . snd) added
XS.put (ASB (toKeep ++ added))

2
XMonad/Layout/AutoMaster.hs
View File

@ -35,7 +35,7 @@ import Control.Arrow (first)
-- in one row, in slave area underlying layout is run. Size of slave area
-- automatically increases when number of slave windows is increasing.
--
-- You can use this module by adding following in your @xmonad.hs@:
-- You can use this module by adding folowing in your @xmonad.hs@:
--
-- > import XMonad.Layout.AutoMaster
--

2
XMonad/Layout/CenteredMaster.hs
View File

@ -38,7 +38,7 @@ import Control.Arrow (first)
-- All other windows in background are managed by base layout.
-- topRightMaster is like centerMaster, but places master window in top right corner instead of center.
--
-- You can use this module by adding following in your @xmonad.hs@:
-- Yo can use this module by adding folowing in your @xmonad.hs@:
--
-- > import XMonad.Layout.CenteredMaster
--

2
XMonad/Layout/CircleEx.hs
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

8
XMonad/Layout/Column.hs
View File

@ -11,7 +11,7 @@
-- Portability : unportable
--
-- Provides Column layout that places all windows in one column. Windows
-- heights are calculated from the equation: H1/H2 = H2/H3 = ... = q, where q is
-- heights are calculated from equation: H1/H2 = H2/H3 = ... = q, where q is
-- given. With Shrink/Expand messages you can change the q value.
--
-----------------------------------------------------------------------------
@ -25,12 +25,12 @@ import XMonad
import qualified XMonad.StackSet as W
-- $usage
-- This module defines layout named Column. It places all windows in one
-- column. Windows heights are calculated from the equation: H1/H2 = H2/H3 = ... =
-- This module defines layot named Column. It places all windows in one
-- column. Windows heights are calculated from equation: H1/H2 = H2/H3 = ... =
-- q, where `q' is given (thus, windows heights are members of geometric
-- progression). With Shrink/Expand messages one can change the `q' value.
--
-- You can use this module by adding following in your @xmonad.hs@:
-- You can use this module by adding folowing in your @xmonad.hs@:
--
-- > import XMonad.Layout.Column
--

480
XMonad/Layout/Columns.hs
View File

@ -1,480 +0,0 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
-- |
-- Module: XMonad.Layout.Columns
-- Description: A layout which tiles the windows in columns.
-- Copyright: Jean-Charles Quillet
-- License: BSD-style (see LICENSE)
--
-- Maintainer: none
-- Stability: unstable
-- Portability: unportable
--
-- A layout which tiles the windows in columns. The windows can be moved and
-- resized in every directions.
--
-- The first window appears in a single column in the center of the screen. Its
-- width is configurable (See 'coOneWindowWidth').
--
-- The second window appears in a second column. Starting with two columns, they
-- fill up the screen.
--
-- Subsequent windows appear on the bottom of the last columns.
module XMonad.Layout.Columns
( -- * Usage
-- $usage
ColumnsLayout (..),
-- * Messages
Focus (..),
Move (..),
Resize (..),
-- * Tools
focusDown,
focusUp,
)
where
import Control.Applicative ((<|>))
import Control.Arrow (Arrow (first), second)
import Control.Monad (guard)
import Control.Monad.State (modify)
import Control.Monad.Trans.Maybe (MaybeT (..))
import Data.Foldable (Foldable (..))
import Data.List (scanl')
import Data.Maybe (listToMaybe)
import Data.Ratio ((%))
import XMonad
( LayoutClass (..),
Message,
Rectangle (..),
SomeMessage,
Window,
WindowSet,
X,
XState (..),
fromMessage,
gets,
scaleRationalRect,
sendMessage,
)
import qualified XMonad.Operations as O
import XMonad.StackSet
( RationalRect (..),
Screen (..),
Stack (..),
StackSet (..),
integrate,
peek,
)
import qualified XMonad.StackSet as StackSet
-- $usage
-- Add 'Columns' to your @layoutHook@ with an initial empty state:
--
-- > myLayout = Full ||| Columns 1 []
--
-- Here is an example of keybindings:
--
-- > -- Focus up/down
-- > ((modm, xK_Tab), focusDown),
-- > ((modm .|. shiftMask, xK_Tab), focusUp),
-- > -- Move windows around
-- > ((modm .|. shiftMask, xK_l), sendMessage MoveRight),
-- > ((modm .|. shiftMask, xK_h), sendMessage MoveLeft),
-- > ((modm .|. shiftMask, xK_k), sendMessage MoveUp),
-- > ((modm .|. shiftMask, xK_j), sendMessage MoveDown),
-- > -- Resize them
-- > ((modm .|. controlMask, xK_l), sendMessage HorizontalExpand),
-- > ((modm .|. controlMask, xK_h), sendMessage HorizontalShrink),
-- > ((modm .|. controlMask, xK_k), sendMessage VerticalExpand),
-- > ((modm .|. controlMask, xK_j), sendMessage VerticalShrink),
--
-- This layout is known to work with:
--
-- * "XMonad.Layout.WindowNavigation" for changing focus with a direction using
-- 'XMonad.Layout.WindowNavigation.Go' messages.
-- * 'XMonad.Layout.SubLayouts.subTabbed' for docking windows together with
-- tabs. Note that sometimes when undocking windows, the layout is reset. This is
-- a minor annoyance caused by the difficulty to track windows in the sublayout.
-- | The windows can be moved in every directions.
--
-- Horizontally, a window alone in its column cannot be moved before the first
-- or after the last column. If not alone, moving the window outside those
-- limits will create a new column.
-- The windows can also be moved vertically in their column.
data Move = MoveLeft | MoveRight | MoveUp | MoveDown deriving (Show, Read)
instance Message Move
-- | The windows can be resized in every directions.
--
-- When resizing horizontally:
--
-- * if the window to be resized is not in the last column
--
-- * then the right side of the window will be moved
-- * the last column will compensate the size change
--
-- * if the window is in the last column
--
-- * then the left side of the window will be moved
-- * the column on the left of the current one will compensate the size change
--
-- The same applies when resizing vertically using the bottom side of the
-- window unless it is the last window in the column in which case we use the
-- top side.
data Resize
= VerticalShrink
| VerticalExpand
| HorizontalShrink
| HorizontalExpand
deriving (Show, Read)
instance Message Resize
-- | The layout handles focus change messages.
--
-- Built-in focus cannot be used here because @XMonad@ does not make it easy to
-- change the order of windows in the focus list. See also 'focusUp' and
-- 'focusDown' functions.
data Focus = FocusUp | FocusDown
deriving (Show, Read)
instance Message Focus
-- | A column is a list of windows with their relative vertical dimensions.
type Column = [(Rational, Window)]
-- | The layout is a list of 'Column' with their relative horizontal dimensions.
type Columns = [(Rational, Column)]
data ColumnsLayout a = Columns
{ -- | With of the first column when there is only one window. Usefull on wide
-- screens.
coOneWindowWidth :: Rational,
-- | The current state
coColumns :: Columns
}
deriving (Show, Read)
instance LayoutClass ColumnsLayout Window where
description _ = layoutDescription
doLayout (Columns oneWindowWidth columns) rectangle stack =
pure (rectangles, Just (Columns oneWindowWidth columns'))
where
hackedColumns = hackForTabs columns stack
columns' = updateWindowList hackedColumns stack
rectangles = toRectangles rectangle' columns'
-- If there is only one window, we set the destination rectangle according
-- to the width in the layout setting.
rectangle'
| (length . toList $ stack) == 1 =
scaleRationalRect rectangle singleColumnRR
| otherwise = rectangle
singleColumnOffset = (1 - oneWindowWidth) / 2
singleColumnRR = RationalRect singleColumnOffset 0 oneWindowWidth 1
handleMessage layout@(Columns oneWindowWidth columns) message = do
mbStack <- runMaybeT $ handleFocus' =<< getStack
changedFocus <- traverse updateStack' mbStack
movedOrResized <-
runMaybeT $
Columns oneWindowWidth
<$> (handleMoveOrResize' =<< peekFocus)
pure $ movedOrResized <|> changedFocus
where
getStack = MaybeT . gets $ StackSet.stack . workspace . current . windowset
handleFocus' = hoistMaybe . handleFocus columns message
-- A 'Just' needs to be return for the new stack to be taken into account
updateStack' s = modify (setStack s) >> pure layout
peekFocus = MaybeT . gets $ peek . windowset
handleMoveOrResize' = hoistMaybe . handleMoveOrResize columns message
hoistMaybe = MaybeT . pure
layoutDescription :: String
layoutDescription = "Columns"
-- | Change the keyboard focus to the previous window
focusUp :: X ()
focusUp =
sendMsgOrOnWindowsSet FocusUp StackSet.focusUp
=<< getCurrentLayoutDescription
-- | Change the keyboard focus to the next window
focusDown :: X ()
focusDown =
sendMsgOrOnWindowsSet FocusDown StackSet.focusDown
=<< getCurrentLayoutDescription
sendMsgOrOnWindowsSet :: (Message a) => a -> (WindowSet -> WindowSet) -> String -> X ()
sendMsgOrOnWindowsSet message f description'
| description' == layoutDescription = sendMessage message
| otherwise = O.windows f
getCurrentLayoutDescription :: X String
getCurrentLayoutDescription =
gets
( description
. StackSet.layout
. workspace
. current
. windowset
)
setStack :: Stack Window -> XState -> XState
setStack stack state =
state
{ windowset =
(windowset state)
{ current =
(current $ windowset state)
{ workspace =
(workspace . current $ windowset state)
{ StackSet.stack = Just stack
}
}
}
}
handleFocus :: Columns -> SomeMessage -> Stack Window -> Maybe (Stack Window)
handleFocus columns message stack
| Just FocusDown <- fromMessage message = setFocus' stack <$> mbNext
| Just FocusUp <- fromMessage message = setFocus' stack <$> mbPrevious
| otherwise = Nothing
where
focused = focus stack
windows = columnsToWindows columns
exists = focused `elem` windows
mbNext = guard exists >> next focused windows
mbPrevious = guard exists >> previous focused windows
setFocus' = flip setFocus
previous a = next a . reverse
setFocus w = until ((==) w . focus) StackSet.focusDown'
next _ [] = Nothing
next a (x : xs)
| a == x = listToMaybe xs
| otherwise = next a (xs <> [x])
oldNewWindows :: Columns -> Stack Window -> ([Window], [Window])
oldNewWindows columns stack = (old, new)
where
old = filter (`notElem` stackList) windows
new = filter (`notElem` windows) stackList
stackList = toList stack
windows = columnsToWindows columns
-- | Add the new windows to the layout and remove the old ones.
updateWindowList :: Columns -> Stack Window -> Columns
updateWindowList columns stack = addWindows newWindows (removeWindows oldWindows columns)
where
(oldWindows, newWindows) = oldNewWindows columns stack
-- | If one window disappeared and another appeared, we assume that the sublayout
-- tabs just changed focused.
hackForTabs :: Columns -> Stack Window -> Columns
hackForTabs columns stack = mapWindow replace columns
where
replace window
| (w1 : _, [w2]) <- oldNewWindows columns stack =
if window == w1
then w2
else window
| otherwise = window
toRectangles :: Rectangle -> [(Rational, [(Rational, a)])] -> [(a, Rectangle)]
toRectangles rectangle columns =
second (scaleRationalRect rectangle) <$> windowsAndRectangles
where
offsetsAndRatios = toOffsetRatio (second toOffsetRatio <$> columns)
windowsAndRectangles = foldMap toWindowAndRectangle offsetsAndRatios
toWindowAndRectangle (x, w, cs) = (\(y, h, ws) -> (ws, RationalRect x y w h)) <$> cs
onFocused :: (a -> a) -> Stack a -> Stack a
onFocused f (Stack a before after) = Stack (f a) before after
onFocusedM :: (Monad m) => (a -> m a) -> Stack a -> m (Stack a)
onFocusedM f (Stack a before after) = Stack <$> f a <*> pure before <*> pure after
onFocusedOrPrevious :: (a -> a) -> Stack a -> Stack a
onFocusedOrPrevious f (Stack a (a' : others) []) = Stack a (f a' : others) []
onFocusedOrPrevious f stack = onFocused f stack
handleMoveOrResize :: Columns -> SomeMessage -> Window -> Maybe Columns
handleMoveOrResize columns message window
| Just msg <- fromMessage message = move msg window columns
| Just HorizontalShrink <- fromMessage message =
onFocusedOrPrevious' shrink <$> findInColumns window columns
| Just HorizontalExpand <- fromMessage message =
onFocusedOrPrevious' expand <$> findInColumns window columns
| Just VerticalExpand <- fromMessage message =
onFocusedM'
(fmap (onFocusedOrPrevious' shrink) . findInColumn window)
=<< findInColumns window columns
| Just VerticalShrink <- fromMessage message =
onFocusedM'
(fmap (onFocusedOrPrevious' expand) . findInColumn window)
=<< findInColumns window columns
| otherwise = Nothing
where
expand = first $ flip (+) (3 / 100)
shrink = first $ flip (-) (3 / 100)
onFocusedM' f = fmap integrate . onFocusedM (sequence . second f)
onFocusedOrPrevious' f = sanitize . integrate . onFocusedOrPrevious f
move :: Move -> Window -> Columns -> Maybe Columns
move direction window columns =
case (direction, findInColumns window columns) of
(MoveRight, Just (Stack (_, [(_, _)]) _ [])) -> Nothing
(MoveLeft, Just (Stack (_, [(_, _)]) [] _)) -> Nothing
(MoveRight, Just (Stack column@(_, [(_, _)]) before (next : others))) ->
let (column', next') = swapWindowBetween window column next
in Just . integrate $ Stack column' before (next' : others)
(MoveLeft, Just (Stack column@(_, [(_, _)]) (previous : others) after)) ->
let (column', previous') = swapWindowBetween window column previous
in Just . integrate $ Stack column' (previous' : others) after
(MoveRight, Just stack) ->
let (newColumns', Stack column before after) = rationalize newColumns stack
windows = removeWindow window column
in Just . integrate $ Stack windows before (newColumns' <> after)
(MoveLeft, Just stack) ->
let (newColumns', Stack column before after) = rationalize newColumns stack
windows = removeWindow window column
in Just . integrate $ Stack windows (newColumns' <> before) after
(MoveUp, Just stack) -> integrate <$> onFocusedM (swapWindowUp window) stack
(MoveDown, Just stack) -> integrate <$> onFocusedM (swapWindowDown window) stack
_ -> Nothing
where
newColumns = [[(1, window)]]
mapWindow :: (Window -> Window) -> Columns -> Columns
mapWindow = fmap . fmap . fmap . fmap
columnsToWindows :: Columns -> [Window]
columnsToWindows = foldMap ((: []) . snd) . foldMap snd
swapWindowBetween ::
Window ->
(Rational, Column) ->
(Rational, Column) ->
((Rational, Column), (Rational, Column))
swapWindowBetween window from to = (removed, added)
where
removed = removeWindow window from
added = appendWindows [window] to
swapWindowUp :: Window -> (Rational, Column) -> Maybe (Rational, Column)
swapWindowUp window (width, column)
| Just (Stack (height, _) (previous : before') after) <- findInColumn window column =
Just (width, integrate $ Stack previous ((height, window) : before') after)
| otherwise = Nothing
swapWindowDown :: Window -> (Rational, Column) -> Maybe (Rational, Column)
swapWindowDown window (width, column)
| Just (Stack (height, _) before (next : others)) <- findInColumn window column =
Just (width, integrate $ Stack next before ((height, window) : others))
| otherwise = Nothing
-- | Adjust the ratio of a list or a stack of elts so that when adding new
-- elements:
-- - the new elements are distributed according to the total number of elements
-- - the existing elements keep their proportion in the remaining space
rationalize ::
(Functor f, Foldable f) =>
[a] ->
f (Rational, a) ->
([(Rational, a)], f (Rational, a))
rationalize new existing = (new', existing')
where
nbNew = fromIntegral $ length new
nbInColumn = fromIntegral $ length existing
newRatio = nbNew % (nbNew + nbInColumn)
existingRatio = 1 - newRatio
new' = fitElements newRatio new
existing' = first (* existingRatio) <$> existing
append :: [a] -> [(Rational, a)] -> [(Rational, a)]
append new existing = uncurry (flip mappend) (rationalize new existing)
appendWindows ::
[Window] ->
(Rational, [(Rational, Window)]) ->
(Rational, [(Rational, Window)])
appendWindows windows = second (append windows)
fitElements :: Rational -> [a] -> [(Rational, a)]
fitElements dimension elts = (dimension',) <$> elts
where
dimension' = dimension / fromIntegral (length elts)
singleColumn :: Rational -> Rational -> [Window] -> Columns
singleColumn width height windows = [(width, fitElements height windows)]
findElement' :: (a -> Bool) -> [(Rational, a)] -> Maybe (Stack (Rational, a))
findElement' predicate list
| (before, c : after) <- break (predicate . snd) list =
Just $ Stack c (reverse before) after
| otherwise = Nothing
findInColumns :: Window -> Columns -> Maybe (Stack (Rational, Column))
findInColumns window = findElement' (any ((== window) . snd))
findInColumn :: Window -> Column -> Maybe (Stack (Rational, Window))
findInColumn window = findElement' (== window)
removeWindows :: [Window] -> Columns -> Columns
removeWindows windows = removeEmptyColumns . fmap (second removeWindows')
where
inWindows (_, window) = window `notElem` windows
removeWindows' = normalize . filter inWindows
removeEmptyColumns = normalize . filter (not . null . snd)
removeWindow :: Window -> (Rational, Column) -> (Rational, Column)
removeWindow window = second (normalize . filter ((/= window) . snd))
addWindows :: [Window] -> Columns -> Columns
addWindows [] columns = columns
-- When there is only one column, create a new one on the right
addWindows windows [(_, windows')] = (1 % 2, windows') : singleColumn (1 % 2) 1 windows
-- When there is more, append the windows to the last column
addWindows windows columns
| Just (columns', column) <- unsnoc columns =
sanitizeColumns $ columns' <> [appendWindows windows column]
| otherwise = singleColumn 1 1 windows
-- | Make sure the sum of all dimensions is 1
normalize :: [(Rational, a)] -> [(Rational, a)]
normalize elts = fmap (first (/ total)) elts
where
total = sum (fst <$> elts)
-- | Update the last dimension so that the sum of all dimensions is 1
sanitize :: [(Rational, a)] -> [(Rational, a)]
sanitize list
| Just (elts, (_, a)) <- unsnoc list = elts <> [(1 - sum (fst <$> elts), a)]
| otherwise = []
-- | Same on the whole layout
sanitizeColumns :: Columns -> Columns
sanitizeColumns = sanitize . fmap (second sanitize)
toOffsetRatio :: [(Rational, a)] -> [(Rational, Rational, a)]
toOffsetRatio ra = zipWith toTruple ra positions
where
toTruple (dimension, a) position = (position, dimension, a)
positions = scanl' (\position (dimension, _) -> position + dimension) 0 ra
unsnoc :: [a] -> Maybe ([a], a)
unsnoc [] = Nothing
unsnoc (x : xs)
| Just (is, l) <- unsnoc xs = Just (x : is, l)
| otherwise = Just ([], x)

1
XMonad/Layout/FixedAspectRatio.hs
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

2
XMonad/Layout/Hidden.hs
View File

@ -118,7 +118,7 @@ popHiddenWindow = sendMessage . PopSpecificHiddenWindow
--------------------------------------------------------------------------------
hideWindowMsg :: HiddenWindows a -> Window -> X (Maybe (HiddenWindows a))
hideWindowMsg (HiddenWindows hidden) win = do
modifyWindowSet $ W.delete' win
modify (\s -> s { windowset = W.delete' win $ windowset s })
return . Just . HiddenWindows $ hidden ++ [win]
--------------------------------------------------------------------------------

2
XMonad/Layout/IfMax.hs
View File

@ -36,7 +36,7 @@ import qualified XMonad.StackSet as W
-- IfMax layout will run one layout if number of windows on workspace is as
-- maximum N, and else will run another layout.
--
-- You can use this module by adding following in your @xmonad.hs@:
-- You can use this module by adding folowing in your @xmonad.hs@:
--
-- > import XMonad.Layout.IfMax
--

17
XMonad/Layout/IndependentScreens.hs
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

11
XMonad/Layout/NoBorders.hs
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'

43
XMonad/Layout/OnHost.hs
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

4
XMonad/Layout/TabBarDecoration.hs
View File

@ -46,8 +46,8 @@ import XMonad.Prompt ( XPPosition (..) )
-- 'tabBar' will give you the possibility of setting a custom shrinker
-- and a custom theme.
--
-- The default theme can be dynamically changed with the xmonad theme
-- selector. See "XMonad.Prompt.Theme". For more themes, look at
-- The deafult theme can be dynamically change with the xmonad theme
-- selector. See "XMonad.Prompt.Theme". For more themse, look at
-- "XMonad.Util.Themes"
-- | Add, on the top of the screen, a simple bar of tabs to a given

2
XMonad/Prelude.hs
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'.

24
XMonad/Prompt.hs
View File

@ -562,7 +562,7 @@ mkXPromptImplementation historyKey conf om = do
s <- gets $ screenRect . W.screenDetail . W.current . windowset
cleanMask <- cleanKeyMask
cachedir <- asks (cacheDir . directories)
hist <- io $ readHistory conf cachedir
hist <- io $ readHistory cachedir
fs <- initXMF (font conf)
let width = getWinWidth s (position conf)
st' <- io $
@ -582,7 +582,7 @@ mkXPromptImplementation historyKey conf om = do
releaseXMF fs
when (successful st') $ do
let prune = take (historySize conf)
io $ writeHistory conf cachedir $
io $ writeHistory cachedir $
M.insertWith
(\xs ys -> prune . historyFilter conf $ xs ++ ys)
historyKey
@ -1690,18 +1690,16 @@ emptyHistory = M.empty
getHistoryFile :: FilePath -> FilePath
getHistoryFile cachedir = cachedir ++ "/prompt-history"
readHistory :: XPConfig -> FilePath -> IO History
readHistory (XPC { historySize = 0 }) _ = return emptyHistory
readHistory _ cachedir = readHist `E.catch` \(SomeException _) -> return emptyHistory
readHistory :: FilePath -> IO History
readHistory cachedir = readHist `E.catch` \(SomeException _) -> return emptyHistory
where
readHist = do
let path = getHistoryFile cachedir
xs <- withFile path ReadMode hGetLine
readIO xs
writeHistory :: XPConfig -> FilePath -> History -> IO ()
writeHistory (XPC { historySize = 0 }) _ _ = return ()
writeHistory _ cachedir hist = do
writeHistory :: FilePath -> History -> IO ()
writeHistory cachedir hist = do
let path = getHistoryFile cachedir
filtered = M.filter (not . null) hist
writeFile path (show filtered) `E.catch` \(SomeException e) ->
@ -1795,17 +1793,17 @@ breakAtSpace s
-- | 'historyCompletion' provides a canned completion function much like
-- 'getShellCompl'; you pass it to mkXPrompt, and it will make completions work
-- from the query history stored in the XMonad cache directory.
historyCompletion :: XPConfig -> X ComplFunction
historyCompletion conf = historyCompletionP conf (const True)
historyCompletion :: X ComplFunction
historyCompletion = historyCompletionP (const True)
-- | Like 'historyCompletion' but only uses history data from Prompts whose
-- name satisfies the given predicate.
historyCompletionP :: XPConfig -> (String -> Bool) -> X ComplFunction
historyCompletionP conf p = do
historyCompletionP :: (String -> Bool) -> X ComplFunction
historyCompletionP p = do
cd <- asks (cacheDir . directories)
pure $ \x ->
let toComplList = deleteConsecutive . filter (isInfixOf x) . M.foldr (++) []
in toComplList . M.filterWithKey (const . p) <$> readHistory conf cd
in toComplList . M.filterWithKey (const . p) <$> readHistory cd
-- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off
-- laziness and stability for efficiency.

77
XMonad/Prompt/OrgMode.hs
View File

@ -53,7 +53,6 @@ module XMonad.Prompt.OrgMode (
Date (..),
Time (..),
TimeOfDay (..),
OrgTime (..),
DayOfWeek (..),
#endif
@ -123,9 +122,7 @@ Monday and you schedule something for Monday, you will actually schedule
it for the /next/ Monday (the one in seven days).
The time is specified in the @HH:MM@ or @HHMM@ format. The minutes may
be omitted, in which case we assume a full hour is specified. It is also
possible to enter a time span using the syntax @HH:MM-HH:MM@ or @HH:MM+HH@.
In the former case, minutes may be omitted.
be omitted, in which case we assume a full hour is specified.
A few examples are probably in order. Suppose we have bound the key
above, pressed it, and are now confronted with a prompt:
@ -140,10 +137,6 @@ above, pressed it, and are now confronted with a prompt:
- @hello +d today 12:30@ works just like above, but creates a
deadline.
- @hello +d today 12:30-14:30@ works like the above, but gives the
event a duration of two hours. An alternative way to specify
this would be @hello +d today 12:30+2@.
- @hello +s thu@ would schedule the note for next thursday.
- @hello +s 11@ would schedule it for the 11th of this month and this
@ -363,30 +356,21 @@ refile (asString -> parent) (asString -> fp) =
-- @HH:MM@ time.
data Time = Time
{ date :: Date
, tod :: Maybe OrgTime
, tod :: Maybe TimeOfDay
}
deriving (Eq, Show)
-- | The time in HH:MM.
data TimeOfDay = HHMM Int Int
data TimeOfDay = TimeOfDay Int Int
deriving (Eq)
instance Show TimeOfDay where
show :: TimeOfDay -> String
show (HHMM h m) = pad h <> ":" <> pad m
show (TimeOfDay h m) = pad h <> ":" <> pad m
where
pad :: Int -> String
pad n = (if n <= 9 then "0" else "") <> show n
-- | The time—possibly as a span—in HH:MM format.
data OrgTime = MomentInTime TimeOfDay | TimeSpan TimeOfDay TimeOfDay
deriving (Eq)
instance Show OrgTime where
show :: OrgTime -> String
show (MomentInTime tod) = show tod
show (TimeSpan tod tod') = show tod <> "-" <> show tod'
-- | Type for specifying exactly which day one wants.
data Date
= Today
@ -399,7 +383,7 @@ data Date
-- ^ Manual date entry in the format DD [MM] [YYYY]
deriving (Eq, Ord, Show)
toOrgFmt :: Maybe OrgTime -> Day -> String
toOrgFmt :: Maybe TimeOfDay -> Day -> String
toOrgFmt tod day =
mconcat ["<", isoDay, " ", take 3 $ show (dayOfWeek day), time, ">"]
where
@ -514,8 +498,8 @@ ppNote clp todo = \case
-- | Parse the given string into a 'Note'.
pInput :: String -> Maybe Note
pInput inp = (`runParser` inp) . choice $
[ Scheduled <$> (getLast "+s" <* " ") <*> join (fixTime <$> pDate <*> pOrgTime) <*> pPriority
, Deadline <$> (getLast "+d" <* " ") <*> join (fixTime <$> pDate <*> pOrgTime) <*> pPriority
[ Scheduled <$> getLast "+s" <*> (Time <$> pDate <*> pTimeOfDay) <*> pPriority
, Deadline <$> getLast "+d" <*> (Time <$> pDate <*> pTimeOfDay) <*> pPriority
, do s <- munch1 (pure True)
let (s', p) = splitAt (length s - 3) s
pure $ case tryPrio p of
@ -523,12 +507,6 @@ pInput inp = (`runParser` inp) . choice $
Nothing -> NormalMsg s NoPriority
]
where
fixTime :: Maybe Date -> Maybe OrgTime -> Parser Time
fixTime d tod = case (d, tod) of
(Nothing, Nothing) -> mempty -- no day and no time
(Nothing, Just{}) -> pure (Time Today tod) -- no day, but a time
(Just d', _) -> pure (Time d' tod) -- day given
tryPrio :: String -> Maybe Priority
tryPrio [' ', '#', x]
| x `elem` ("Aa" :: String) = Just A
@ -555,33 +533,21 @@ pInput inp = (`runParser` inp) . choice $
-- | Parse a 'Priority'.
pPriority :: Parser Priority
pPriority = option NoPriority $
skipSpaces *> choice
" " *> skipSpaces *> choice
[ "#" *> foldCase "a" $> A
, "#" *> foldCase "b" $> B
, "#" *> foldCase "c" $> C
]
-- | Try to parse a 'Time'.
pOrgTime :: Parser (Maybe OrgTime)
pOrgTime = option Nothing $
between skipSpaces (void " " <|> eof) $
Just <$> choice
[ TimeSpan <$> (pTimeOfDay <* ("--" <|> "-" <|> "–")) <*> pTimeOfDay
-- Org is not super smart around times with this syntax, so
-- we pretend not to be as well.
, do from@(HHMM h m) <- pTimeOfDay <* "+"
off <- pHour
pure $ TimeSpan from (HHMM (h + off) m)
, MomentInTime <$> pTimeOfDay
]
where
pTimeOfDay :: Parser TimeOfDay
pTimeOfDay = choice
[ HHMM <$> pHour <* ":" <*> pMinute -- HH:MM
, pHHMM -- HHMM
, HHMM <$> pHour <*> pure 0 -- HH
pTimeOfDay :: Parser (Maybe TimeOfDay)
pTimeOfDay = option Nothing $
skipSpaces >> Just <$> choice
[ TimeOfDay <$> pHour <* ":" <*> pMinute -- HH:MM
, pHHMM -- HHMM
, TimeOfDay <$> pHour <*> pure 0 -- HH
]
where
pHHMM :: Parser TimeOfDay
pHHMM = do
let getTwo = count 2 (satisfy isDigit)
@ -589,19 +555,18 @@ pOrgTime = option Nothing $
guard (hh >= 0 && hh <= 23)
mm <- read <$> getTwo
guard (mm >= 0 && mm <= 59)
pure $ HHMM hh mm
pure $ TimeOfDay hh mm
pHour :: Parser Int = pNumBetween 0 23
pMinute :: Parser Int = pNumBetween 0 59
-- | Try to parse a 'Date'.
pDate :: Parser (Maybe Date)
pDate = skipSpaces *> optional (choice
-- | Parse a 'Date'.
pDate :: Parser Date
pDate = skipSpaces *> choice
[ pPrefix "tod" "ay" Today
, pPrefix "tom" "orrow" Tomorrow
, Next <$> pNext
, Date <$> pDate'
])
]
where
pNext :: Parser DayOfWeek = choice
[ pPrefix "m" "onday" Monday , pPrefix "tu" "esday" Tuesday
@ -620,7 +585,7 @@ pDate = skipSpaces *> optional (choice
pDate' :: Parser (Int, Maybe Int, Maybe Integer)
pDate' =
(,,) <$> (pNumBetween 1 31 <* (void " " <|> eof)) -- day
(,,) <$> pNumBetween 1 31 -- day
<*> optional (skipSpaces *> choice
[ pPrefix "ja" "nuary" 1 , pPrefix "f" "ebruary" 2
, pPrefix "mar" "ch" 3 , pPrefix "ap" "ril" 4

5
XMonad/Util/EZConfig.hs
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
@ -553,8 +552,8 @@ doKeymapCheck :: XConfig l -> [(String,a)] -> ([String], [String])
doKeymapCheck conf km = (bad,dups)
where ks = map ((readKeySequence conf &&& id) . fst) km
bad = nub . map snd . filter (isNothing . fst) $ ks
dups = map (snd . NE.head . notEmpty)
. filter ((>1) . length)
dups = map (snd . NE.head)
. mapMaybe nonEmpty
. groupBy ((==) `on` fst)
. sortBy (comparing fst)
. map (first fromJust)

52
XMonad/Util/Grab.hs
View File

@ -29,12 +29,15 @@ module XMonad.Util.Grab
) where
-- core
import XMonad
import XMonad hiding (mkGrabs)
import Control.Monad ( when )
import Data.Bits ( setBit )
import Data.Foldable ( traverse_ )
-- base
import qualified Data.Map.Strict as M
import Data.Semigroup ( All(..) )
import Data.Traversable ( for )
-- }}}
@ -67,8 +70,9 @@ grabUngrab
-> [(KeyMask, KeySym)] -- ^ Keys to ungrab
-> X ()
grabUngrab gr ugr = do
traverse_ (uncurry ungrabKP) =<< mkGrabs ugr
traverse_ (uncurry grabKP) =<< mkGrabs gr
f <- mkGrabs
traverse_ (uncurry ungrabKP) (f ugr)
traverse_ (uncurry grabKP) (f gr)
-- | A convenience function to grab keys. This also ungrabs all
-- previously grabbed keys.
@ -84,9 +88,49 @@ customRegrabEvHook regr = \case
e@MappingNotifyEvent{} -> do
io (refreshKeyboardMapping e)
when (ev_request e `elem` [mappingKeyboard, mappingModifier])
$ cacheNumlockMask
$ setNumlockMask
>> regr
pure (All False)
_ -> pure (All True)
-- }}}
-- --< Private Utils >-- {{{
-- | Private action shamelessly copied and restyled from XMonad.Main source.
setNumlockMask :: X ()
setNumlockMask = withDisplay $ \dpy -> do
ms <- io (getModifierMapping dpy)
xs <- sequence
[ do
ks <- io (keycodeToKeysym dpy kc 0)
pure $ if ks == xK_Num_Lock
then setBit 0 (fromIntegral m)
else 0 :: KeyMask
| (m, kcs) <- ms
, kc <- kcs
, kc /= 0
]
modify $ \s -> s { numberlockMask = foldr (.|.) 0 xs }
-- | Private function shamelessly copied and refactored from XMonad.Main source.
mkGrabs :: X ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)])
mkGrabs = withDisplay $ \dpy -> do
let (minCode, maxCode) = displayKeycodes dpy
allCodes = [fromIntegral minCode .. fromIntegral maxCode]
syms <- io . for allCodes $ \code -> keycodeToKeysym dpy code 0
let keysymMap = M.fromListWith (++) (zip syms $ pure <$> allCodes)
keysymToKeycodes sym = M.findWithDefault [] sym keysymMap
extraMods <- extraModifiers
pure $ \ks -> do
(mask, sym) <- ks
keycode <- keysymToKeycodes sym
extraMod <- extraMods
pure (mask .|. extraMod, keycode)
-- }}}
-- NOTE: there is some duplication between this module and core. The
-- latter probably will never change, but this needs to be kept in sync
-- with any potential bugs that might arise.

4
XMonad/Util/Hacks.hs
View File

@ -40,14 +40,10 @@ module XMonad.Util.Hacks (
trayerPaddingXmobarEventHook,
trayPaddingXmobarEventHook,
trayPaddingEventHook,
-- * Steam flickering fix
fixSteamFlicker,
) where
import XMonad
import XMonad.Hooks.FloatConfigureReq (fixSteamFlicker)
import XMonad.Hooks.StatusBar (xmonadPropLog')
import XMonad.Prelude (All (All), fi, filterM, when)
import System.Posix.Env (putEnv)

2
XMonad/Util/NamedScratchpad.hs
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

2
XMonad/Util/Rectangle.hs
View File

@ -67,7 +67,7 @@ data PointRectangle a = PointRectangle
-- @[N,N+1]@, as though each real-valued coordinate had been rounded (either
-- down or up) to the nearest integers. So each pixel, from zero, is listed as:
-- @[0,0]@, @[1,1]@, @[2,2]@, and so on. Rather than a coordinate system, this
-- considers pixels as row/column indices. While easiest to reason with,
-- considers pixels as row/colum indices. While easiest to reason with,
-- indices are unable to represent zero-dimension rectangles.
--
-- Consider pixels as indices. Do not use this on empty rectangles.

6
flake.nix
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;

2
scripts/build/build-with-cabal.sh
View File

@ -15,7 +15,7 @@ output="$1"
if [ "$SRC_DIR" = "" ]; then
# look for the config directory, fall back to the old one
SRC_DIR="${XMONAD_CONFIG_DIR:-${XDG_CONFIG_HOME:-$HOME/.config}/xmonad}"
SRC_DIR="${XMONAD_CONFIG_DIR:-${XDG_CONFIG_HOME:-$HOME/.config/xmonad}}"
if test -f "$SRC_DIR/build"; then
:
else

2
stack.yaml
View File

@ -8,7 +8,7 @@ packages:
extra-deps:
- X11-1.10.2
- xmonad-0.18.0
- xmonad-0.17.0
nix:
packages:

2
tests/Main.hs
View File

@ -14,7 +14,6 @@ import qualified CycleRecentWS
import qualified OrgMode
import qualified GridSelect
import qualified EZConfig
import qualified WindowNavigation
main :: IO ()
main = hspec $ do
@ -54,4 +53,3 @@ main = hspec $ do
context "OrgMode" OrgMode.spec
context "GridSelect" GridSelect.spec
context "EZConfig" EZConfig.spec
context "WindowNavigation" WindowNavigation.spec

35
tests/OrgMode.hs
View File

@ -45,7 +45,7 @@ spec = do
`shouldBe` Just
( Deadline
"todo"
(Time {date = Date (1, Nothing, Nothing), tod = Just $ MomentInTime(HHMM 1 1)})
(Time {date = Date (1, Nothing, Nothing), tod = Just $ TimeOfDay 1 1})
NoPriority
)
it "works with todo +d 22 jan 2021 01:01 #b" $ do
@ -53,23 +53,9 @@ spec = do
`shouldBe` Just
( Deadline
"todo"
(Time {date = Date (22, Just 1, Just 2021), tod = Just $ MomentInTime(HHMM 1 1)})
(Time {date = Date (22, Just 1, Just 2021), tod = Just $ TimeOfDay 1 1})
B
)
it "parses no day as today when given a time" $ do
pInput "todo +s 12:00"
`shouldBe` Just (Scheduled "todo" (Time {date = Today, tod = Just $ MomentInTime(HHMM 12 0)}) NoPriority)
pInput "todo +d 14:05 #B"
`shouldBe` Just (Deadline "todo" (Time {date = Today, tod = Just $ MomentInTime(HHMM 14 5)}) B)
it "parses `blah+d`, `blah +d`, `blah +d `, and `blah +d #B` as normal messages" $ do
pInput "blah+d"
`shouldBe` Just (NormalMsg "blah+d" NoPriority)
pInput "blah +d"
`shouldBe` Just (NormalMsg "blah +d" NoPriority)
pInput "blah +d "
`shouldBe` Just (NormalMsg "blah +d " NoPriority)
pInput "blah +d #B"
`shouldBe` Just (NormalMsg "blah +d" B)
context "no priority#b" $ do
it "parses to the correct thing" $
@ -114,10 +100,10 @@ ppPrio = \case
prio -> " #" <> show prio
ppTime :: Time -> String
ppTime (Time d t) = ppDate d <> ppOrgTime t
ppTime (Time d t) = ppDate d <> ppTOD t
where
ppOrgTime :: Maybe OrgTime -> String
ppOrgTime = maybe "" ((' ' :) . show)
ppTOD :: Maybe TimeOfDay -> String
ppTOD = maybe "" ((' ' :) . show)
ppDate :: Date -> String
ppDate dte = case days !? dte of
@ -193,7 +179,7 @@ instance Arbitrary Date where
[ pure Today
, pure Tomorrow
, Next . toEnum <$> choose (0, 6)
, do d <- posInt `suchThat` (<= 31)
, do d <- posInt
m <- mbPos `suchThat` (<= Just 12)
Date . (d, m, ) <$> if isNothing m
then pure Nothing
@ -202,14 +188,7 @@ instance Arbitrary Date where
instance Arbitrary TimeOfDay where
arbitrary :: Gen TimeOfDay
arbitrary = HHMM <$> hourInt <*> minuteInt
instance Arbitrary OrgTime where
arbitrary :: Gen OrgTime
arbitrary = oneof
[ MomentInTime <$> arbitrary
, TimeSpan <$> arbitrary <*> arbitrary
]
arbitrary = TimeOfDay <$> hourInt <*> minuteInt
------------------------------------------------------------------------
-- Util

635
tests/WindowNavigation.hs
View File

@ -1,635 +0,0 @@
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module WindowNavigation where
import Test.Hspec
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Functor.Identity
import XMonad
import XMonad.Util.Types (Direction2D(..))
import XMonad.Actions.WindowNavigation (goPure, swapPure, WNState)
import qualified XMonad.StackSet as W
spec :: Spec
spec = do
it "two-window adjacent go right (empty state)" $ do
-- Simplest case - just move the focus once.
-- ┌─────┬──────┐
-- │ 1 ──┼─► 2 │
-- └─────┴──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)
runNav R M.empty (mkws 1 [] [2])
`shouldBe` (mkstate 960 640, mkws 2 [1] [])
it "two-window adjacent go right (populated state)" $ do
-- Like the previous test, but this time internal stat is already populated with a position.
-- ┌─────┬──────┐
-- │ 1 ──┼─► 2 │
-- └─────┴──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)
runNav R (mkstate 100 100) (mkws 1 [] [2])
`shouldBe` (mkstate 960 100, mkws 2 [1] [])
it "two-window adjacent go right (incorrectly-populated state)" $ do
-- This time we set the position incorrectly, testing if it will be reset to the center of focused window.
-- ┌─────┬──────┐
-- │ 1 ──┼─► 2 │
-- └─────┴──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)
runNav R (mkstate 1000 100) (mkws 1 [] [2])
`shouldBe` (mkstate 960 640, mkws 2 [1] [])
it "swap windows" $ do
-- Swap windows around.
-- ┌─────┬──────┐
-- │ 1 ◄─┼─► 2 │
-- └─────┴──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
]
runIdentity (swapPure R (M.empty, mkws 1 [] [2], S.fromList [1, 2], windowRect))
`shouldBe` (mkstate 960 640, mkws 1 [2] [])
it "tall layout, go up" $ do
-- ┌─────┬─────┐
-- │ │ 2 ▲ │
-- │ 1 ├───┼─┤
-- │ │ 3 │ │
-- └─────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 640)
, (3, Rectangle 960 640 960 640)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2, 3], windowRect)
runNav U M.empty (mkws 3 [] [1, 2])
`shouldBe` (mkstate 1440 639, mkws 2 [1, 3] [])
it "tall layout, go down" $ do
-- ┌─────┬─────┐
-- │ │ 2 │
-- │ ├─────┤
-- │ 1 │ 3 │ │
-- │ ├───┼─┤
-- │ │ 4 ▼ │
-- └─────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 400)
, (3, Rectangle 960 400 960 400)
, (4, Rectangle 960 800 960 480)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
runNav D M.empty (mkws 3 [] [1, 2, 4])
`shouldBe` (mkstate 1440 800, mkws 4 [2, 1, 3] [])
it "tall layout, go left" $ do
-- ┌─────┬─────┐
-- │ ◄─┼── 2 │
-- │ ├─────┤
-- │ 1 │ 3 │
-- │ ├─────┤
-- │ │ 4 │
-- └─────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 400)
, (3, Rectangle 960 400 960 400)
, (4, Rectangle 960 800 960 480)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
runNav L M.empty (mkws 2 [] [1, 3, 4])
`shouldBe` (mkstate 959 200, mkws 1 [2] [3, 4])
it "tall layout, go left and then right (window 2)" $ do
-- ┌─────┬─────┐
-- │ ◄─┼── 2 │
-- │ ──┼─► │
-- │ ├─────┤
-- │ 1 │ 3 │
-- │ ├─────┤
-- │ │ 4 │
-- └─────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 400)
, (3, Rectangle 960 400 960 400)
, (4, Rectangle 960 800 960 480)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
let (st2, ws2) = runNav L M.empty (mkws 2 [] [1, 3, 4])
(st2, ws2) `shouldBe` (mkstate 959 200, mkws 1 [2] [3, 4])
let (st3, ws3) = runNav R st2 ws2
(st3, ws3) `shouldBe` (mkstate 960 200, mkws 2 [] [1, 3, 4])
it "tall layout, go left and then right (window 3)" $ do
-- ┌─────┬─────┐
-- │ │ 2 │
-- │ ├─────┤
-- │ 1 ◄─┼── 3 │
-- │ ──┼─► │
-- │ ├─────┤
-- │ │ 4 │
-- └─────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 400)
, (3, Rectangle 960 400 960 400)
, (4, Rectangle 960 800 960 480)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
let (st2, ws2) = runNav L M.empty (mkws 3 [] [1, 2, 4])
(st2, ws2) `shouldBe` (mkstate 959 600, mkws 1 [3] [2, 4])
let (st3, ws3) = runNav R st2 ws2
(st3, ws3) `shouldBe` (mkstate 960 600, mkws 3 [] [1, 2, 4])
it "tall layout, go left and then right (window 4)" $ do
-- ┌─────┬─────┐
-- │ │ 2 │
-- │ ├─────┤
-- │ 1 │ 3 │
-- │ ├─────┤
-- │ ◄─┼── 4 │
-- │ ──┼─► │
-- └─────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 400)
, (3, Rectangle 960 400 960 400)
, (4, Rectangle 960 800 960 480)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
let (st2, ws2) = runNav L M.empty (mkws 4 [] [1, 2, 3])
(st2, ws2) `shouldBe` (mkstate 959 1040, mkws 1 [4] [2, 3])
let (st3, ws3) = runNav R st2 ws2
(st3, ws3) `shouldBe` (mkstate 960 1040, mkws 4 [] [1, 2, 3])
it "grid layout, go in a circle" $ do
-- ┌─────┬─────┐
-- │ 1 ──┼─► 2 │
-- │ │ │
-- │ ▲ │ │ │
-- ├─┼───┼───┼─┤
-- │ │ │ ▼ │
-- │ │ │
-- │ 3 ◄─┼── 4 │
-- └─────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 640)
, (2, Rectangle 960 0 960 640)
, (3, Rectangle 0 640 960 640)
, (4, Rectangle 960 640 960 640)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
let (st2, ws2) = runNav R M.empty (mkws 1 [] [2, 3, 4])
(st2, ws2) `shouldBe` (mkstate 960 320, mkws 2 [1] [3, 4])
let (st3, ws3) = runNav D st2 ws2
(st3, ws3) `shouldBe` (mkstate 960 640, mkws 4 [3, 2, 1] [])
let (st4, ws4) = runNav L st3 ws3
(st4, ws4) `shouldBe` (mkstate 959 640, mkws 3 [2, 1] [4])
let (st5, ws5) = runNav U st4 ws4
(st5, ws5) `shouldBe` (mkstate 959 639, mkws 1 [] [2, 3, 4])
it "ignore window that fully overlaps the current window in parallel direction when pos is outside it" $ do
-- ┌─────┬──────┬──────┐
-- │ ┌───┴──────┴────┐ │
-- │ │ | 4 | │ │
-- │ └───┬──────┬────┘ │
-- │ 1 │ 2 ──┼─► 3 │
-- └─────┴──────┴──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 600 1280)
, (2, Rectangle 600 0 600 1280)
, (3, Rectangle 1200 0 720 1280)
, (4, Rectangle 200 200 1520 400)
]
runIdentity (goPure R (mkstate 900 900, mkws 2 [] [1, 3, 4], S.fromList [1..4], windowRect))
`shouldBe` (mkstate 1200 900, mkws 3 [1,2] [4])
it "go to window that fully overlaps the current window in parallel direction when pos is inside it" $ do
-- ┌─────────────────┐
-- │ ┌──────┐ │
-- │ 1 │ │ │
-- ├─────┤------├────┤
-- │ │ │ │
-- │ 2 │ 4 ──┼─► │
-- │ │ │ │
-- ├─────┤------├────┤
-- │ 3 │ │ │
-- │ └──────┘ │
-- └─────────────────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 1920 400)
, (2, Rectangle 0 400 1920 400)
, (3, Rectangle 0 800 1920 480)
, (4, Rectangle 800 200 400 880)
]
runIdentity (goPure R (mkstate 1000 600, mkws 4 [] [1, 2, 3], S.fromList [1..4], windowRect))
`shouldBe` (mkstate 1200 600, mkws 2 [1,4] [3])
it "go from inner window to outer" $ do
-- ┌───────────────┐
-- │ ┌──────┐ │
-- │ 1 ◄─┼── 2 │ │
-- │ └──────┘ │
-- └───────────────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 1920 1280)
, (2, Rectangle 600 600 600 600)
]
runIdentity (goPure L (M.empty, mkws 2 [] [1], S.fromList [1, 2], windowRect))
`shouldBe` (mkstate 599 900, mkws 1 [2] [])
it "if there are multiple outer windows, go to the smaller one" $ do
-- ┌────────────────────────┐
-- │ ┌───────────────┐ │
-- │ │ ┌──────┐ │ │
-- │ │ 2 ◄─┼── 3 │ │ 1 │
-- │ │ └──────┘ │ │
-- │ └───────────────┘ │
-- └────────────────────────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 1920 1280)
, (2, Rectangle 200 200 1520 880)
, (3, Rectangle 400 400 400 400)
]
runIdentity (goPure L (M.empty, mkws 3 [] [1, 2], S.fromList [1..3], windowRect))
`shouldBe` (mkstate 399 600, mkws 2 [1, 3] [])
it "two tiled and one floating, floating fully inside" $ do
-- ┌───────────────────┬─────┐
-- │ ┌───────┐ │ │
-- │ ──┼─► ──┼─► ──┼─► │
-- │ │ 3 │ 1 │ 2 │
-- │ │ ◄─┼── ◄─┼── │
-- │ └───────┘ │ │
-- └───────────────────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
, (3, Rectangle 400 400 400 400)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)
let (st2, ws2) = runNav R (mkstate 100 100) (mkws 1 [] [2, 3])
(st2, ws2) `shouldBe` (mkstate 400 400, mkws 3 [2, 1] [])
let (st3, ws3) = runNav R st2 ws2
(st3, ws3) `shouldBe` (mkstate 800 400, mkws 1 [] [2, 3])
let (st4, ws4) = runNav R st3 ws3
(st4, ws4) `shouldBe` (mkstate 960 400, mkws 2 [1] [3])
let (st5, ws5) = runNav L st4 ws4
(st5, ws5) `shouldBe` (mkstate 959 400, mkws 1 [] [2, 3])
let (st6, ws6) = runNav L st5 ws5
(st6, ws6) `shouldBe` (mkstate 799 400, mkws 3 [2, 1] [])
it "two floating windows inside one big tiled one" $ do
-- ┌─────────┐
-- │ │ │
-- │ ┌──┼──┐ │
-- │ │ ▼ │ │
-- │ │ 3 │ │
-- │ └──┼──┘ │
-- │ ▼ │
-- │ 1 │
-- │ ┌──┼──┐ │
-- │ │ ▼ │ │
-- │ │ 4 │ │
-- │ └──┼──┘ │
-- │ ▼ │
-- ├────┼────┤
-- │ ▼ │
-- │ 2 │
-- └─────────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 1920 640)
, (2, Rectangle 0 640 1920 640)
, (3, Rectangle 200 200 100 100)
, (4, Rectangle 1000 400 100 100)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
let (st2, ws2) = runNav D (mkstate 1000 250) (mkws 1 [] [2, 3, 4])
(st2, ws2) `shouldBe` (mkstate 299 250, mkws 3 [2, 1] [4])
let (st3, ws3) = runNav D st2 ws2
(st3, ws3) `shouldBe` (mkstate 299 300, mkws 1 [] [2, 3, 4])
let (st4, ws4) = runNav D st3 ws3
(st4, ws4) `shouldBe` (mkstate 1000 400, mkws 4 [3, 2, 1] [])
let (st5, ws5) = runNav D st4 ws4
(st5, ws5) `shouldBe` (mkstate 1000 500, mkws 1 [] [2, 3, 4])
let (st6, ws6) = runNav D st5 ws5
(st6, ws6) `shouldBe` (mkstate 1000 640, mkws 2 [1] [3, 4])
it "floating window between two tiled ones" $ do
-- ┌───────┬────────┐
-- │ 1 ┌───┴───┐ 2 │
-- │ ──┼─► 3 ──┼─► │
-- │ └───┬───┘ │
-- └───────┴────────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
, (3, Rectangle 860 540 200 200)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)
let (st2, ws2) = runNav R M.empty (mkws 1 [] [2, 3])
(st2, ws2) `shouldBe` (mkstate 860 640, mkws 3 [2, 1] [])
let (st3, ws3) = runNav R st2 ws2
(st3, ws3) `shouldBe` (mkstate 960 640, mkws 2 [1] [3])
it "floating window overlapping four tiled ones" $ do
-- ┌───────┬───────┐
-- │ ┌───┴───┐ │
-- │ 1 │ │ 2 │
-- ├───┤ ├───┤
-- │ ──┼─► 5 ──┼─► │
-- │ 3 └───┬───┘ 4 │
-- └───────┴───────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 640)
, (2, Rectangle 960 0 960 640)
, (3, Rectangle 0 640 960 640)
, (4, Rectangle 960 640 960 640)
, (5, Rectangle 760 440 400 400)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..5], windowRect)
let (st2, ws2) = runNav R (mkstate 480 640) (mkws 3 [] [1, 2, 4, 5])
(st2, ws2) `shouldBe` (mkstate 760 640, mkws 5 [4, 2, 1, 3] [])
let (st3, ws3) = runNav R st2 ws2
(st3, ws3) `shouldBe` (mkstate 960 640, mkws 4 [2, 1, 3] [5])
it "sequential inner floating windows" $ do
-- ┌───────────────────────────────────┬──────┐
-- │ ┌───────┐ │ │
-- │ │ │ ┌───────┐ │ │
-- │ ──┼─► 3 ──┼─► 1 ──┼─► 4 ──┼─► ──┼─► 2 │
-- │ ◄─┼── ◄─┼── ◄─┼── ◄─┼── ◄─┼── │
-- │ └───────┘ │ │ │ │
-- │ └───────┘ │ │
-- └───────────────────────────────────┴──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
, (3, Rectangle 200 200 200 200)
, (4, Rectangle 600 600 200 200)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
let (st2, ws2) = runNav R (mkstate 100 100) (mkws 1 [] [2, 3, 4])
(st2, ws2) `shouldBe` (mkstate 200 200, mkws 3 [2,1] [4])
let (st3, ws3) = runNav R st2 ws2
(st3, ws3) `shouldBe` (mkstate 400 200, mkws 1 [] [2, 3, 4])
let (st4, ws4) = runNav R st3 ws3
(st4, ws4) `shouldBe` (mkstate 600 600, mkws 4 [3, 2, 1] [])
let (st5, ws5) = runNav R st4 ws4
(st5, ws5) `shouldBe` (mkstate 800 600, mkws 1 [] [2, 3, 4])
let (st6, ws6) = runNav R st5 ws5
(st6, ws6) `shouldBe` (mkstate 960 600, mkws 2 [1] [3, 4])
let (st7, ws7) = runNav L st6 ws6
(st7, ws7) `shouldBe` (mkstate 959 600, mkws 1 [] [2, 3, 4])
let (st8, ws8) = runNav L st7 ws7
(st8, ws8) `shouldBe` (mkstate 799 600, mkws 4 [3, 2, 1] [])
let (st9, ws9) = runNav L st8 ws8
(st9, ws9) `shouldBe` (mkstate 599 600, mkws 1 [] [2, 3, 4])
let (st10, ws10) = runNav L st9 ws9
(st10, ws10) `shouldBe` (mkstate 399 399, mkws 3 [2, 1] [4])
let (st11, ws11) = runNav L st10 ws10
(st11, ws11) `shouldBe` (mkstate 199 399, mkws 1 [] [2, 3, 4])
it "overlapping inner floating windows" $ do
-- ┌─────────────────────┬──────┐
-- │ ┌─────────┐ │ │
-- │ │ 3 ┌────┴─┐ │ │
-- │ │ ──┼─► ──┼─► 1 ──┼─► 2 │
-- │ │ ◄─┼── ◄─┼── ◄─┼── │
-- │ │ │ 4 │ │ │
-- │ └────┤ │ │ │
-- │ └──────┘ │ │
-- └─────────────────────┴──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
, (3, Rectangle 200 200 400 400)
, (4, Rectangle 300 300 400 400)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
let (st2, ws2) = runNav R M.empty (mkws 3 [] [1, 2, 4])
(st2, ws2) `shouldBe` (mkstate 400 400, mkws 4 [2, 1, 3] [])
let (st3, ws3) = runNav R st2 ws2
(st3, ws3) `shouldBe` (mkstate 700 400, mkws 1 [3] [2, 4])
let (st4, ws4) = runNav R st3 ws3
(st4, ws4) `shouldBe` (mkstate 960 400, mkws 2 [1, 3] [4])
let (st5, ws5) = runNav L st4 ws4
(st5, ws5) `shouldBe` (mkstate 959 400, mkws 1 [3] [2, 4])
let (st6, ws6) = runNav L st5 ws5
(st6, ws6) `shouldBe` (mkstate 699 400, mkws 4 [2, 1, 3] [])
let (st7, ws7) = runNav L st6 ws6
(st7, ws7) `shouldBe` (mkstate 599 400, mkws 3 [] [1, 2, 4])
it "bounce back from the wall to the floating window" $ do
-- ┌────────────────┬─────┐
-- │ 1 ┌──────┐ │ │
-- │ ┌───┼─► 3 │ │ 2 │
-- │ └── │ │ │ │
-- │ └──────┘ │ │
-- └────────────────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
, (3, Rectangle 400 400 200 200)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)
runNav L (mkstate 100 640) (mkws 1 [] [2, 3])
`shouldBe` (mkstate 400 599, mkws 3 [2, 1] [])
it "jump between screens" $ do
-- ┌─────┬──────┐ ┌────────┐
-- │ │ 2 │ │ 5 │
-- │ ├──────┤ ├────────┤
-- │ 1 │ 3 ──┼──┼─► 6 │
-- │ ├──────┤ └────────┘
-- │ │ 4 │
-- └─────┴──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 400)
, (3, Rectangle 960 400 960 400)
, (4, Rectangle 960 800 960 480)
, (5, Rectangle 1920 0 1280 384)
, (6, Rectangle 1920 384 1280 384)
]
initWindowSet =
W.StackSet
{ W.current =
W.Screen
{ W.workspace =
W.Workspace
{ W.tag = "A"
, W.layout = Layout NullLayout
, W.stack = Just $ W.Stack { W.focus = 3, W.up = [], W.down = [1, 2, 4] }
}
, W.screen = 1
, W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }
}
, W.visible =
[ W.Screen
{ W.workspace =
W.Workspace
{ W.tag = "B"
, W.layout = Layout NullLayout
, W.stack = Just $ W.Stack { W.focus = 5, W.up = [], W.down = [6] }
}
, W.screen = 2
, W.screenDetail = SD { screenRect = Rectangle 1920 0 1280 768 }
}
]
, W.hidden = []
, W.floating = M.empty
}
expectedWindowSet =
W.StackSet
{ W.current =
W.Screen
{ W.workspace =
W.Workspace
{ W.tag = "B"
, W.layout = Layout NullLayout
, W.stack = Just $ W.Stack { W.focus = 6, W.up = [5], W.down = [] }
}
, W.screen = 2
, W.screenDetail = SD { screenRect = Rectangle 1920 0 1280 768 }
}
, W.visible =
[ W.Screen
{ W.workspace =
W.Workspace
{ W.tag = "A"
, W.layout = Layout NullLayout
, W.stack = Just $ W.Stack { W.focus = 3, W.up = [], W.down = [1, 2, 4] }
}
, W.screen = 1
, W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }
}
]
, W.hidden = []
, W.floating = M.empty
}
runIdentity (goPure R (M.empty, initWindowSet, S.fromList [1..6], windowRect))
`shouldBe` (M.fromList [("B", Point 1920 600)], expectedWindowSet)
it "floating window overlapping fully in the orthogonal direction" $ do
-- ┌─────┬──────────────────┐
-- │ │ ┌───────┐ │
-- │ │ 2 │ │ │
-- │ ├──────┤-------├───┤
-- │ 1 │ 3 │ │ 3 │
-- │ ◄─┼── ◄─┼── 5 ◄─┼── │
-- │ ├──────┤-------├───┤
-- │ │ 4 │ │ │
-- │ │ └───────┘ │
-- └─────┴──────────────────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 400)
, (3, Rectangle 960 400 960 400)
, (4, Rectangle 960 800 960 480)
, (5, Rectangle 1360 200 200 800)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..5], windowRect)
let (st2, ws2) = runNav L (mkstate 1800 600) (mkws 3 [] [1, 2, 4, 5])
(st2, ws2) `shouldBe` (mkstate 1559 600, mkws 5 [4, 2, 1, 3] [])
let (st3, ws3) = runNav L st2 ws2
(st3, ws3) `shouldBe` (mkstate 1359 600, mkws 3 [] [1, 2, 4, 5])
let (st4, ws4) = runNav L st3 ws3
(st4, ws4) `shouldBe` (mkstate 959 600, mkws 1 [3] [2, 4, 5])
it "navigation to free-floating windows on the same screen" $ do
-- ┌──────┐
-- │ │ ┌──────┐
-- │ │ │ │
-- │ ──┼──┼─► 2 │
-- │ │ │ │
-- │ 1 │ └──────┘
-- │ │
-- │ │
-- └──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 1200 400 400 400)
]
runIdentity (goPure R (M.empty, mkws 1 [] [2], S.fromList [1, 2], windowRect))
`shouldBe` (mkstate 1200 640, mkws 2 [1] [])
it "switch between windows in Full layout" $ do
let windowRect w = Identity $ M.lookup w $ M.fromList [(1, Rectangle 0 0 1920 1280)]
runIdentity (goPure D (M.empty, mkws 1 [] [2, 3], S.fromList [1], windowRect))
`shouldBe` (M.empty, mkws 2 [1] [3])
data NullLayout a = NullLayout deriving (Show, Read, Eq)
instance LayoutClass NullLayout a
-- to make WindowSets comparable
instance Eq (Layout w) where
(==) a b = show a == show b
(/=) a b = show a /= show b
-- make a state with a position for a single workspace
mkstate :: Position -> Position -> WNState
mkstate px py = M.fromList [("A", Point px py)]
-- make a single-workspace WindowSet
mkws :: Window -> [Window] -> [Window] -> WindowSet
mkws focusedWindow upWindows downWindows = W.StackSet
{ W.current = W.Screen
{ W.workspace = W.Workspace
{ W.tag = "A"
, W.layout = Layout NullLayout
, W.stack = Just $ W.Stack { W.focus = focusedWindow, W.up = upWindows, W.down = downWindows }
}
, W.screen = 1
, W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }
}
, W.visible = []
, W.hidden = []
, W.floating = M.empty
}

36
xmonad-contrib.cabal
View File

@ -1,5 +1,5 @@
name: xmonad-contrib
version: 0.18.1.9
version: 0.18.0
-- ^ 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.4 || == 9.8.1
source-repository head
type: git
@ -54,33 +54,32 @@ flag pedantic
manual: True
library
build-depends: base >= 4.12 && < 5,
build-depends: base >= 4.11 && < 5,
bytestring >= 0.10 && < 0.13,
containers >= 0.5 && < 0.9,
containers >= 0.5 && < 0.8,
directory,
filepath,
time >= 1.8 && < 1.15,
time >= 1.8 && < 1.13,
process,
random,
mtl >= 1 && < 3,
transformers,
unix,
X11 >= 1.10 && < 1.11,
xmonad >= 0.18.0 && < 0.19,
xmonad >= 0.16.99999 && < 0.19,
utf8-string,
deepseq
default-language: Haskell2010
cpp-options: -DXMONAD_CONTRIB_VERSION_MAJOR=0
-DXMONAD_CONTRIB_VERSION_MINOR=18
-DXMONAD_CONTRIB_VERSION_PATCH=1
-DXMONAD_CONTRIB_VERSION_PATCH=0
ghc-options: -Wall -Wno-unused-do-bind
if flag(pedantic)
ghc-options: -Werror -Wwarn=deprecations
ghc-options: -Werror -Wwarn=deprecations -Wwarn=dodgy-imports
-- 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
@ -131,7 +130,6 @@ library
XMonad.Actions.PhysicalScreens
XMonad.Actions.Plane
XMonad.Actions.Prefix
XMonad.Actions.Profiles
XMonad.Actions.Promote
XMonad.Actions.RandomBackground
XMonad.Actions.RepeatAction
@ -154,7 +152,6 @@ library
XMonad.Actions.TreeSelect
XMonad.Actions.UpdateFocus
XMonad.Actions.UpdatePointer
XMonad.Actions.UpKeys
XMonad.Actions.Warp
XMonad.Actions.WindowBringer
XMonad.Actions.WindowGo
@ -194,7 +191,6 @@ library
XMonad.Hooks.EwmhDesktops
XMonad.Hooks.FadeInactive
XMonad.Hooks.FadeWindows
XMonad.Hooks.FloatConfigureReq
XMonad.Hooks.FloatNext
XMonad.Hooks.Focus
XMonad.Hooks.InsertPosition
@ -238,7 +234,6 @@ library
XMonad.Layout.Circle
XMonad.Layout.CircleEx
XMonad.Layout.Column
XMonad.Layout.Columns
XMonad.Layout.Combo
XMonad.Layout.ComboP
XMonad.Layout.Cross
@ -430,9 +425,7 @@ test-suite tests
RotateSome
Selective
SwapWorkspaces
WindowNavigation
Utils
XMonad.Actions.CopyWindow
XMonad.Actions.CycleRecentWS
XMonad.Actions.CycleWS
XMonad.Actions.FocusNth
@ -444,13 +437,10 @@ test-suite tests
XMonad.Actions.SwapWorkspaces
XMonad.Actions.TagWindows
XMonad.Actions.WindowBringer
XMonad.Actions.WindowGo
XMonad.Actions.WindowNavigation
XMonad.Hooks.ManageDocks
XMonad.Hooks.ManageHelpers
XMonad.Hooks.UrgencyHook
XMonad.Hooks.WorkspaceHistory
XMonad.Hooks.StatusBar.PP
XMonad.Layout.Decoration
XMonad.Layout.LayoutModifier
XMonad.Layout.LimitWindows
@ -484,13 +474,13 @@ test-suite tests
XMonad.Util.XUtils
XPrompt
hs-source-dirs: tests, .
build-depends: base >= 4.12 && < 5
build-depends: base
, QuickCheck >= 2
, X11 >= 1.10 && < 1.11
, bytestring >= 0.10 && < 0.13
, containers
, directory
, time >= 1.8 && < 1.15
, time >= 1.8 && < 1.13
, hspec >= 2.4.0 && < 3
, mtl
, random
@ -504,10 +494,10 @@ test-suite tests
default-language: Haskell2010
if flag(pedantic)
ghc-options: -Werror -Wwarn=deprecations
ghc-options: -Werror -Wwarn=deprecations -Wwarn=dodgy-imports
-- 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