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

Merge branch 'master' into dzen-dock

Browse Source
This commit is contained in:
Brent Yorgey 2020-12-02 13:15:01 -06:00 committed by GitHub
commit 317eb23654
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
178 changed files with 9443 additions and 1616 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.github/PULL_REQUEST_TEMPLATE.md vendored
View File

@ -10,3 +10,5 @@ behind them.
- [ ] I tested my changes with [xmonad-testing](https://github.com/xmonad/xmonad-testing)
- [ ] I updated the `CHANGES.md` file
- [ ] I updated the `XMonad.Doc.Extending` file (if appropriate)

3
.gitignore vendored
View File

@ -24,3 +24,6 @@ tags
# stack artifacts
/.stack-work/
/cabal.project.local
stack.yaml.lock

216
.travis.yml
View File

@ -1,91 +1,149 @@
# This file has been generated -- see https://github.com/hvr/multi-ghc-travis
# This Travis job script has been generated by a script via
#
# haskell-ci '-o' '.travis.yml' 'xmonad-contrib.cabal' '--apt' 'libxrandr-dev'
#
# For more information, see https://github.com/haskell-CI/haskell-ci
#
# version: 0.5.20190916
#
language: c
sudo: false
dist: xenial
git:
# whether to recursively clone submodules
submodules: false
cache:
directories:
- $HOME/.cabsnap
- $HOME/.cabal/packages
- $HOME/.cabal/store
before_cache:
- rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
- rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar
- rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
# remove files that are regenerated by 'cabal update'
- rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
- rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
- rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
- rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
- rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
- rm -rfv $CABALHOME/packages/head.hackage
matrix:
include:
- env: CABALVER=1.16 GHCVER=7.6.3
compiler: ": #GHC 7.6.3"
addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}}
- env: CABALVER=1.18 GHCVER=7.8.4
compiler: ": #GHC 7.8.4"
addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
- env: CABALVER=1.22 GHCVER=7.10.3
compiler: ": #GHC 7.10.3"
addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}
- env: CABALVER=1.24 GHCVER=8.0.1
compiler: ": #GHC 8.0.1"
addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
- compiler: ghc-8.8.1
addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0","libxrandr-dev"]}}
- compiler: ghc-8.6.5
addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-3.0","libxrandr-dev"]}}
- compiler: ghc-8.4.4
addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-3.0","libxrandr-dev"]}}
- compiler: ghc-8.2.2
addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-3.0","libxrandr-dev"]}}
- compiler: ghc-8.0.2
addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-3.0","libxrandr-dev"]}}
before_install:
- unset CC
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
- HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
- WITHCOMPILER="-w $HC"
- HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')
- HCPKG="$HC-pkg"
- unset CC
- CABAL=/opt/ghc/bin/cabal
- CABALHOME=$HOME/.cabal
- export PATH="$CABALHOME/bin:$PATH"
- TOP=$(pwd)
- "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
- echo $HCNUMVER
- CABAL="$CABAL -vnormal+nowrap+markoutput"
- set -o pipefail
- |
echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk
echo 'BEGIN { state = "output"; }' >> .colorful.awk
echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk
echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk
echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk
echo ' if (state == "cabal") {' >> .colorful.awk
echo ' print blue($0)' >> .colorful.awk
echo ' } else {' >> .colorful.awk
echo ' print $0' >> .colorful.awk
echo ' }' >> .colorful.awk
echo '}' >> .colorful.awk
- cat .colorful.awk
- |
color_cabal_output () {
awk -f $TOP/.colorful.awk
}
- echo text | color_cabal_output
install:
# build xmonad from HEAD
- git clone https://github.com/xmonad/xmonad.git
- cabal --version
- echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
- if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];
then
zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >
$HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
fi
- travis_retry cabal update -v
- sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
- cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt
- sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt
# check whether current requested install-plan matches cached package-db snapshot
- if diff -u $HOME/.cabsnap/installplan.txt installplan.txt;
then
echo "cabal build-cache HIT";
rm -rfv .ghc;
cp -a $HOME/.cabsnap/ghc $HOME/.ghc;
cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;
else
echo "cabal build-cache MISS";
rm -rf $HOME/.cabsnap;
mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;
cabal install --only-dependencies --enable-tests --enable-benchmarks;
fi
# snapshot package-db on cache miss
- if [ ! -d $HOME/.cabsnap ];
then
echo "snapshotting package-db to build-cache";
mkdir $HOME/.cabsnap;
cp -a $HOME/.ghc $HOME/.cabsnap/ghc;
cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;
fi
- cabal install xmonad/
# Here starts the actual work to be performed for the package under test;
# any command which exits with a non-zero exit code causes the build to fail.
- ${CABAL} --version
- echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
- TEST=--enable-tests
- BENCH=--enable-benchmarks
- HEADHACKAGE=false
- rm -f $CABALHOME/config
- |
echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
echo "remote-build-reporting: anonymous" >> $CABALHOME/config
echo "write-ghc-environment-files: always" >> $CABALHOME/config
echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
echo "world-file: $CABALHOME/world" >> $CABALHOME/config
echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
echo "install-dirs user" >> $CABALHOME/config
echo " prefix: $CABALHOME" >> $CABALHOME/config
echo "repository hackage.haskell.org" >> $CABALHOME/config
echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
- |
echo "program-default-options" >> $CABALHOME/config
echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
- cat $CABALHOME/config
- rm -fv cabal.project cabal.project.local cabal.project.freeze
- travis_retry ${CABAL} v2-update -v
# Generate cabal.project
- rm -rf cabal.project cabal.project.local cabal.project.freeze
- touch cabal.project
- |
echo "packages: ." >> cabal.project
- |
- "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(xmonad-contrib)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
- cat cabal.project || true
- cat cabal.project.local || true
- if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
- ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output
- "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
- rm cabal.project.freeze
- ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output
- ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output
script:
- if [ -f configure.ac ]; then autoreconf -i; fi
- cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging
- cabal build # this builds all libraries and executables (including tests/benchmarks)
- cabal test
# - cabal check # complains about -Werror even though it is
# hidden behind a manual flag with default false
- cabal sdist # tests that a source-distribution can be generated
# Check that the resulting source distribution can be built & installed.
# If there are no other `.tar.gz` files in `dist`, this can be even simpler:
# `cabal install --force-reinstalls dist/*-*.tar.gz`
- SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&
(cd dist && cabal install --force-reinstalls "$SRC_TGZ")
- DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
# Packaging...
- ${CABAL} v2-sdist all | color_cabal_output
# Unpacking...
- mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
- cd ${DISTDIR} || false
- find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
- find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;
- PKGDIR_xmonad_contrib="$(find . -maxdepth 1 -type d -regex '.*/xmonad-contrib-[0-9.]*')"
# Generate cabal.project
- rm -rf cabal.project cabal.project.local cabal.project.freeze
- touch cabal.project
- |
echo "packages: ${PKGDIR_xmonad_contrib}" >> cabal.project
- |
- "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(xmonad-contrib)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
- cat cabal.project || true
- cat cabal.project.local || true
# Building...
# this builds all libraries and executables (without tests/benchmarks)
- ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output
# Building with tests and benchmarks...
# build & run tests, build benchmarks
- ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output
# cabal check...
- (cd ${PKGDIR_xmonad_contrib} && ${CABAL} -vnormal check)
# haddock...
- ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all | color_cabal_output
# Building without installed constraints for packages in global-db...
- rm -f cabal.project.local
- ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output
# REGENDATA ["-o",".travis.yml","xmonad-contrib.cabal","--apt","libxrandr-dev"]
# EOF

742
CHANGES.md
View File

@ -1,27 +1,488 @@
# Change Log / Release Notes
## 0.14 (Not Yet)
## unknown
### Breaking Changes
* `XMonad.Prompt`
Now `mkComplFunFromList` and `mkComplFunFromList'` take an
additional `XPConfig` argument, so that they can take into
account the given `searchPredicate`.
A `complCaseSensitivity` field has been added to `XPConfig`, indicating
whether case-sensitivity is desired when performing completion.
* `XMonad.Hooks.EwmhDesktops`
It is no longer recommended to use `fullscreenEventHook` directly.
Instead, use `ewmhFullscreen` which additionally advertises fullscreen
support in `_NET_SUPPORTED` and fixes fullscreening of applications that
explicitly check it, e.g. mupdf-gl, sxiv, …
`XMonad.Layout.Fullscreen.fullscreenSupport` now advertises it as well,
and no configuration changes are required in this case.
* `XMonad.Hooks.EwmhDesktops`
`ewmh` function will use `logHook` for handling activated window. And now
by default window activation will do nothing.
You can use regular `ManageHook` combinators for changing window
activation behavior and then add resulting `ManageHook` using
`activateLogHook` to your `logHook`. Also, module `X.H.Focus` provides
additional combinators.
* `XMonad.Prompt.Directory`
The `Dir` constructor now takes an additional `ComplCaseSensitivity`
argument to indicate whether directory completion is case sensitive.
* All modules still exporting a `defaultFoo` constructor
All of these were now removed. You can use the re-exported `def` from
`Data.Default` instead.
### New Modules
* `XMonad.Util.ActionCycle`
A module providing a simple way to implement "cycling" `X` actions,
useful for things like alternating toggle-style keybindings.
* `XMonad.Actions.RotateSome`
Functions for rotating some elements around the stack while keeping others
anchored in place. Useful in combination with layouts that dictate window
visibility based on stack position, such as "XMonad.Layout.LimitWindows".
Export 'surfaceNext' and 'surfacePrev' actions, which treat the focused window
and any hidden windows as a ring that can be rotated through the focused position.
Export 'rotateSome', a pure function that rotates some elements around a stack
while keeping others anchored in place.
* `XMonad.Actions.Sift`
Provide 'siftUp' and 'siftDown' actions, which behave like 'swapUp' and 'swapDown'
but handle the wrapping case by exchanging the windows at either end of the stack
instead of rotating the stack.
* `XMonad.Hooks.WindowSwallowing`
A handleEventHook that implements window swallowing:
Hide parent windows like terminals when opening other programs (like image viewers) from within them,
restoring them once the child application closes.
* `XMonad.Actions.TiledWindowDragging`
An action that allows you to change the position of windows by dragging them around.
* `XMonad.Layout.ResizableThreeColumns`
A layout based on 'XMonad.Layout.ThreeColumns' but with each slave window's
height resizable.
* `XMonad.Layout.TallMastersCombo`
A layout combinator that support Shrink, Expand, and IncMasterN just as
the 'Tall' layout, and also support operations of two master windows:
a main master, which is the original master window;
a sub master, the first window of the second pane.
This combinator can be nested, and has a good support for using
'XMonad.Layout.Tabbed' as a sublayout.
* `XMonad.Actions.PerWindowKeys`
Create actions that run on a `Query Bool`, usually associated with
conditions on a window, basis. Useful for creating bindings that are
excluded or exclusive for some windows.
* `XMonad.Util.DynamicScratchpads`
Declare any window as a scratchpad on the fly. Once declared, the
scratchpad behaves like `XMonad.Util.NamedScratchpad`.
* `XMonad.Prompt.Zsh`
A version of `XMonad.Prompt.Shell` that lets you use completions supplied by
zsh.
* `XMonad.Util.ClickableWorkspaces`
Provides clickablePP, which when applied to the PP pretty-printer used by
`XMonad.Hooks.DynamicLog.dynamicLogWithPP`, will make the workspace tags
clickable in XMobar (for switching focus).
* `XMonad.Layout.VoidBorders`
Provides a modifier that semi-permanently (requires manual intervention)
disables borders for windows from the layout it modifies.
* `XMonad.Hooks.Focus`
Extends ManageHook EDSL to work on focused windows and current workspace.
### Bug Fixes and Minor Changes
* `XMonad.Actions.DynamicProjects`
The `changeProjectDirPrompt` function respects the `complCaseSensitivity` field
of `XPConfig` when performing directory completion.
* `XMonad.Layout.WorkspaceDir`
- The `changeDir` function respects the `complCaseSensitivity` field of `XPConfig`
when performing directory completion.
- `Chdir` message is exported, so it's now possible to change the
directory programmaticaly, not just via a user prompt.
* `XMonad.Prompt.Directory`
- Added `directoryMultipleModes'`, like `directoryMultipleModes` with an additional
`ComplCaseSensitivity` argument.
- Directory completions are now sorted.
* `XMonad.Prompt.FuzzyMatch`
`fuzzySort` will now accept cases where the input is not a subsequence of
every completion.
* `XMonad.Prompt.Shell`
Added `getShellCompl'`, like `getShellCompl` with an additional `ComplCaseSensitivity`
argument.
Added `compgenDirectories` and `compgenFiles` to get the directory/filename completion
matches returned by the compgen shell builtin.
* `XMonad.Prompt.Unicode`
Reworked internally to be call `spawnPipe` (asynchronous) instead of
`runProcessWithInput` (synchronous), which fixes `typeUnicodePrompt`.
Now respects `searchPredicate` and `sorter` from user-supplied `XPConfig`.
* `XMonad.Hooks.DynamicLog`
- Added `statusBar'` function, like existing `statusBar` but accepts a pretty
printing options argument embedded in the X monad, to allow for dynamically
modified options such as `workspaceNamesPP`.
- Added `shortenLeft` function, like existing `shorten` but shortens by
truncating from left instead of right. Useful for showing directories.
* `XMonad.Layout.BoringWindows`
Added boring-aware `swapUp`, `swapDown`, `siftUp`, and `siftDown` functions.
* `XMonad.Util.NamedScratchpad`
Added two new exported functions to the module:
- `customRunNamedScratchpadAction`
(provides the option to customize the `X ()` action the scratchpad is launched by)
- `spawnHereNamedScratchpadAction`
(uses `XMonad.Actions.SpawnOn.spawnHere` to initially start the scratchpad on the workspace it was launched on)
* `XMonad.Util.Run`
Added two new functions to the module:
`spawnPipeWithLocaleEncoding` and
`spawnPipeWithUtf8Encoding`. `spawnPipe` is now alias for
`spawnPipeWithLocaleEncoding`.
Added the function `spawnPipeWithNoEncoding` for cases where
binary handle is required.
* `XMonad.Prompt.Window`
Added 'allApplications' function which maps application executable
names to it's underlying window.
* `XMonad.Prompt.WindowBringer`
Added 'windowApMap' function which maps application executable
names to it's underlying window.
* `XMonad.Actions.Search`
- The `hoogle` function now uses the new URL `hoogle.haskell.org`.
- Added `promptSearchBrowser'` function to only suggest previous searches of
the selected search engine (instead of all search engines).
* `XMonad.Layout.BoringWindows`
Added 'markBoringEverywhere' function, to mark the currently
focused window boring on all layouts, when using 'XMonad.Actions.CopyWindow'.
* `XMonad.Layout.MouseResizableTile`
When we calculate dragger widths, we first try to get the border width of
the focused window, before failing over to using the initial `borderWidth`.
* `XMonad.Actions.CycleRecentWS`
- Added `cycleRecentNonEmptyWS` function which behaves like `cycleRecentWS`
but is constrainded to non-empty workspaces.
- Added `toggleRecentWS` and `toggleRecentNonEmptyWS` functions which toggle
between the current and most recent workspace, and continue to toggle back
and forth on repeated presses, rather than cycling through other workspaces.
- Added `recentWS` function which allows the recency list to be filtered with
a user-provided predicate.
* `XMonad.Prompt.Window`
- Added a `WithWindow` constructor to `WindowPrompt` to allow executing
actions of type `Window -> X ()` on the chosen window.
* `XMonad.Layout.Hidden`
- Export `HiddenWindows` type constructor.
- Export `popHiddenWindow` function restoring a specific window.
* `XMonad.Hooks.ManageDocks`
- Export `AvoidStruts` constructor
* `XMonad.Hooks.ManageHelpers`
- Export `doSink`
* `XMonad.Util.EZConfig`
- Added support for XF86Bluetooth.
* `XMonad.Util.Loggers`
- Make `battery` and `loadAvg` distro-independent.
* `XMonad.Hooks.DynamicLog`
- Added `xmobarBorder` function to create borders around strings.
* `XMonad.Layout.Minimize`
- Export `Minimize` type constructor.
* `XMonad.Actions.WorkspaceNames`
- Added `workspaceNamesListTransform` which makes workspace names visible
to external pagers.
* Several `LayoutClass` instances now have an additional `Typeable`
constraint which may break some advanced configs. The upside is that we
can now add `Typeable` to `LayoutClass` in `XMonad.Core` and make it
possible to introspect the current layout and its modifiers.
* `XMonad.Actions.TopicSpace`
- `switchTopic` now correctly updates the last used topics.
- `setLastFocusedTopic` will now check whether we have exceeded the
`maxTopicHistory` and prune the topic history as necessary, as well as
cons the given topic onto the list __before__ filtering it.
- Added `switchNthLastFocusedExclude`, which works like
`switchNthLastFocused` but is able to exclude certain topics.
- Added `switchTopicWith`, which works like `switchTopic`, but one is able
to give `setLastFocusedTopic` a custom filtering function as well.
- Instead of a hand-rolled history, use the oneu from
`XMonad.Hooks.WorkspaceHistory`.
- Added the screen-aware functions `getLastFocusedTopicsByScreen` and
`switchNthLastFocusedByScreen`.
* `XMonad.Hooks.WorkspaceHistory`
- Added `workspaceHistoryModify` to modify the workspace history with a pure
function.
* `XMonad.Hooks.DynamicLog`
- Add the -dock argument to the dzen spawn arguments
## 0.16
### Breaking Changes
* `XMonad.Layout.Decoration`
- Added `Theme` record fields for controlling decoration border width for active/inactive/urgent windows.
* `XMonad.Prompt`
- Prompt ships a vim-like keymap, see `vimLikeXPKeymap` and
`vimLikeXPKeymap'`. A reworked event loop supports new vim-like prompt
actions.
- Prompt supports dynamic colors. Colors are now specified by the `XPColor`
type in `XPState` while `XPConfig` colors remain unchanged for backwards
compatibility.
- Fixes `showCompletionOnTab`.
- The behavior of `moveWord` and `moveWord'` has changed; brought in line
with the documentation and now internally consistent. The old keymaps
retain the original behavior; see the documentation to do the same your
XMonad configuration.
* `XMonad.Util.Invisble`
- Requires `MonadFail` for `Read` instance
### New Modules
* `XMonad.Layout.TwoPanePersistent`
A layout that is like TwoPane but keeps track of the slave window that is
currently beside the master. In TwoPane, the default behavior when the master
is focused is to display the next window in the stack on the slave pane. This
is a problem when a different slave window is selected without changing the stack
order.
* `XMonad.Util.ExclusiveScratchpads`
Named scratchpads that can be mutually exclusive: This new module extends the
idea of named scratchpads such that you can define "families of scratchpads"
that are exclusive on the same screen. It also allows to remove this
constraint of being mutually exclusive with another scratchpad.
* `XMonad.Actions.Prefix`
A module that allows the user to use an Emacs-style prefix
argument (raw or numeric).
### Bug Fixes and Minor Changes
* `XMonad.Layout.Tabbed`
tabbedLeft and tabbedRight will set their tabs' height and width according to decoHeight/decoWidth
* `XMonad.Prompt`
Added `sorter` to `XPConfig` used to sort the possible completions by how
well they match the search string (example: `XMonad.Prompt.FuzzyMatch`).
Fixes a potential bug where an error during prompt execution would
leave the window open and keep the keyboard grabbed. See issue
[#180](https://github.com/xmonad/xmonad-contrib/issues/180).
Fixes [issue #217](https://github.com/xmonad/xmonad-contrib/issues/217), where
using tab to wrap around the completion rows would fail when maxComplRows is
restricting the number of rows of output.
* `XMonad.Prompt.Pass`
Added 'passOTPPrompt' to support getting OTP type password. This require
pass-otp (https://github.com/tadfisher/pass-otp) has been setup in the running
machine.
Added 'passGenerateAndCopyPrompt', which both generates a new password and
copies it to the clipboard. These two actions are commonly desirable to
take together, e.g. when establishing a new account.
Made password prompts traverse symlinks when gathering password names for
autocomplete.
* `XMonad.Actions.DynamicProjects`
Make the input directory read from the prompt in `DynamicProjects`
absolute wrt the current directory.
Before this, the directory set by the prompt was treated like a relative
directory. This means that when you switch from a project with directory
`foo` into a project with directory `bar`, xmonad actually tries to `cd`
into `foo/bar`, instead of `~/bar` as expected.
* `XMonad.Actions.DynamicWorkspaceOrder`
Add a version of `withNthWorkspace` that takes a `[WorkspaceId] ->
[WorkspaceId]` transformation to apply over the list of workspace tags
resulting from the dynamic order.
* `XMonad.Actions.GroupNavigation`
Add a utility function `isOnAnyVisibleWS :: Query Bool` to allow easy
cycling between all windows on all visible workspaces.
* `XMonad.Hooks.WallpaperSetter`
Preserve the aspect ratio of wallpapers that xmonad sets. When previous
versions would distort images to fit the screen size, it will now find a
best fit by cropping instead.
* `XMonad.Util.Themes`
Add adwaitaTheme and adwaitaDarkTheme to match their respective
GTK themes.
* 'XMonad.Layout.BinarySpacePartition'
Add a new `SplitShiftDirectional` message that allows moving windows by
splitting its neighbours.
* `XMonad.Prompt.FuzzyMatch`
Make fuzzy sort show shorter strings first.
## 0.15
### Breaking Changes
* `XMonad.Layout.Groups` & `XMonad.Layout.Groups.Helpers`
The layout will no longer perform refreshes inside of its message handling.
If you have been relying on it to in your xmonad.hs, you will need to start
sending its messages in a manner that properly handles refreshing, e.g. with
`sendMessage`.
### New Modules
* `XMonad.Util.Purex`
Unlike the opaque `IO` actions that `X` actions can wrap, regular reads from
the `XConf` and modifications to the `XState` are fundamentally pure --
contrary to the current treatment of such actions in most xmonad code. Pure
modifications to the `WindowSet` can be readily composed, but due to the
need for those modifications to be properly handled by `windows`, other pure
changes to the `XState` cannot be interleaved with those changes to the
`WindowSet` without superfluous refreshes, hence breaking composability.
This module aims to rectify that situation by drawing attention to it and
providing `PureX`: a pure type with the same monadic interface to state as
`X`. The `XLike` typeclass enables writing actions generic over the two
monads; if pure, existing `X` actions can be generalised with only a change
to the type signature. Various other utilities are provided, in particular
the `defile` function which is needed by end-users.
### Bug Fixes and Minor Changes
* Add support for GHC 8.6.1.
* `XMonad.Actions.MessageHandling`
Refresh-performing functions updated to better reflect the new `sendMessage`.
## 0.14
### Breaking Changes
* `XMonad.Layout.Spacing`
Rewrite `XMonad.Layout.Spacing`. Borders are no longer uniform but composed
of four sides each with its own border width. The screen and window borders
are now separate and can be independently toggled on/off. The screen border
examines the window/rectangle list resulting from 'runLayout' rather than
the stack, which makes it compatible with layouts such as the builtin
`Full`. The child layout will always be called with the screen border. If
only a single window is displayed (and `smartBorder` enabled), it will be
expanded into the original layout rectangle. Windows that are displayed but
not part of the stack, such as those created by 'XMonad.Layout.Decoration',
will be shifted out of the way, but not scaled (not possible for windows
created by XMonad). This isn't perfect, so you might want to disable
`Spacing` on such layouts.
* `XMonad.Util.SpawnOnce`
- Added `spawnOnOnce`, `spawnNOnOnce` and `spawnAndDoOnce`. These are useful in startup hooks
to shift spawned windows to a specific workspace.
* Adding handling of modifySpacing message in smartSpacing and smartSpacingWithEdge layout modifier
* `XMonad.Actions.GridSelect`
- Added field `gs_bordercolor` to `GSConfig` to specify border color.
* `ewmh` function from `X.H.EwmhDesktops` will use `manageHook` for handling
activated window. That means, actions, which you don't want to happen on
activated windows, should be guarded by
not <$> activated
predicate. By default, with empty `ManageHook`, window activation will do
nothing.
Also, you can use regular 'ManageHook' combinators for changing window
activation behavior.
* `XMonad.Layout.Minimize`
Though the interface it offers is quite similar, this module has been
@ -32,20 +493,111 @@
sending messages to `Minimized` layout. `XMonad.Hooks.RestoreMinimized` has
been completely deprecated, and its functions have no effect.
* `XMonad.Prompt.Unicode`
- `unicodePrompt :: String -> XPConfig -> X ()` now additionally takes a
filepath to the `UnicodeData.txt` file containing unicode data.
* `XMonad.Actions.PhysicalScreens`
`getScreen`, `viewScreen`, `sendToScreen`, `onNextNeighbour`, `onPrevNeighbour` now need a extra parameter
of type `ScreenComparator`. This allow the user to specify how he want his screen to be ordered default
value are:
- `def`(same as verticalScreenOrderer) will keep previous behavior
- `verticalScreenOrderer`
- `horizontalScreenOrderer`
One can build his custom ScreenOrderer using:
- `screenComparatorById` (allow to order by Xinerama id)
- `screenComparatorByRectangle` (allow to order by screen coordonate)
- `ScreenComparator` (allow to mix ordering by screen coordonate and xinerama id)
* `XMonad.Util.WorkspaceCompare`
`getXineramaPhysicalWsCompare` now need a extra argument of type `ScreenComparator` defined in
`XMonad.Actions.PhysicalScreens` (see changelog of this module for more information)
* `XMonad.Hooks.EwmhDesktops`
- Simplify ewmhDesktopsLogHookCustom, and remove the gnome-panel specific
remapping of all visible windows to the active workspace (#216).
- Handle workspace renames that might be occuring in the custom function
that is provided to ewmhDesktopsLogHookCustom.
* `XMonad.Hooks.DynamicLog`
- Support xmobar's \<action> and \<raw> tags; see `xmobarAction` and
`xmobarRaw`.
* `XMonad.Layout.NoBorders`
The layout now maintains a list of windows that never have borders, and a
list of windows that always have borders. Use `BorderMessage` to manage
these lists and the accompanying event hook (`borderEventHook`) to remove
destroyed windows from them. Also provides the `hasBorder` manage hook.
Two new conditions have been added to `Ambiguity`: `OnlyLayoutFloat` and
`OnlyLayoutFloatBelow`; `OnlyFloat` was renamed to `OnlyScreenFloat`. See
the documentation for more information.
The type signature of `hiddens` was changed to accept a new `Rectangle`
parameter representing the bounds of the parent layout, placed after the
`WindowSet` parameter. Anyone defining a new instance of `SetsAmbiguous`
will need to update their configuration. For example, replace "`hiddens amb
wset mst wrs =`" either with "`hiddens amb wset _ mst wrs =`" or to make
use of the new parameter with "`hiddens amb wset lr mst wrs =`".
* `XMonad.Actions.MessageFeedback`
- Follow the naming conventions of `XMonad.Operations`. Functions returning
`X ()` are named regularly (previously these ended in underscore) while
those returning `X Bool` are suffixed with an uppercase 'B'.
- Provide all `X Bool` and `SomeMessage` variations for `sendMessage` and
`sendMessageWithNoRefresh`, not just `sendMessageWithNoRefreshToCurrent`
(renamed from `send`).
- The new `tryInOrderB` and `tryMessageB` functions accept a parameter of
type `SomeMessage -> X Bool`, which means you are no longer constrained
to the behavior of the `sendMessageWithNoRefreshToCurrent` dispatcher.
- The `send*Messages*` family of funtions allows for sequencing arbitrary
sets of messages with minimal refresh. It makes little sense for these
functions to support custom message dispatchers.
- Remain backwards compatible. Maintain deprecated aliases of all renamed
functions:
- `send` -> `sendMessageWithNoRefreshToCurrentB`
- `sendSM` -> `sendSomeMessageWithNoRefreshToCurrentB`
- `sendSM_` -> `sendSomeMessageWithNoRefreshToCurrent`
- `tryInOrder` -> `tryInOrderWithNoRefreshToCurrentB`
- `tryInOrder_` -> `tryInOrderWithNoRefreshToCurrent`
- `tryMessage` -> `tryMessageWithNoRefreshToCurrentB`
- `tryMessage_` -> `tryMessageWithNoRefreshToCurrent`
### New Modules
* `XMonad.Hooks.Focus`
* `XMonad.Layout.MultiToggle.TabBarDecoration`
A new module extending ManageHook EDSL to work on focused windows and
current workspace.
Provides a simple transformer for use with `XMonad.Layout.MultiToggle` to
dynamically toggle `XMonad.Layout.TabBarDecoration`.
This module will enable window activation (`_NET_ACTIVE_WINDOW`) and apply
`manageHook` to activated window too. Thus, it may lead to unexpected
results, when `manageHook` previously working only for new windows, start
working for activated windows too. It may be solved, by adding
`not <$> activated` before those part of `manageHook`, which should not be
called for activated windows. But this lifts `manageHook` into
`FocusHook` and it needs to be converted back later using `manageFocus`.
* `XMonad.Hooks.RefocusLast`
Provides hooks and actions that keep track of recently focused windows on a
per workspace basis and automatically refocus the last window on loss of the
current (if appropriate as determined by user specified criteria).
* `XMonad.Layout.StateFull`
Provides `StateFull`: a stateful form of `Full` that does not misbehave when
floats are focused, and the `FocusTracking` layout transformer by means of
which `StateFull` is implemented. `FocusTracking` simply holds onto the last
true focus it was given and continues to use it as the focus for the
transformed layout until it sees another. It can be used to improve the
behaviour of a child layout that has not been given the focused window.
* `XMonad.Actions.SwapPromote`
Module for tracking master window history per workspace, and associated
functions for manipulating the stack using such history.
* `XMonad.Actions.CycleWorkspaceByScreen`
@ -56,8 +608,85 @@
Also provides the `repeatableAction` helper function which can be used to
build actions that can be repeated while a modifier key is held down.
* `XMonad.Prompt.FuzzyMatch`
Provides a predicate `fuzzyMatch` that is much more lenient in matching
completions in `XMonad.Prompt` than the default prefix match. Also provides
a function `fuzzySort` that allows sorting the fuzzy matches by "how well"
they match.
* `XMonad.Utils.SessionStart`
A new module that allows to query if this is the first time xmonad is
started of the session, or a xmonad restart.
Currently needs manual setting of the session start flag. This could be
automated when this moves to the core repository.
* `XMonad.Layout.MultiDishes`
A new layout based on Dishes, however it accepts additional configuration
to allow multiple windows within a single stack.
* `XMonad.Util.Rectangle`
A new module for handling pixel rectangles.
* `XMonad.Layout.BinaryColumn`
A new module which provides a simple grid layout, halving the window
sizes of each window after master.
This is similar to Column, but splits the window in a way
that maintains window sizes upon adding & removing windows as well as the
option to specify a minimum window size.
### Bug Fixes and Minor Changes
* `XMonad.Layout.Grid`
Fix as per issue #223; Grid will no longer calculate more columns than there
are windows.
* `XMonad.Hooks.FadeWindows`
Added support for GHC version 8.4.x by adding a Semigroup instance for
Monoids
* `XMonad.Hooks.WallpaperSetter`
Added support for GHC version 8.4.x by adding a Semigroup instance for
Monoids
* `XMonad.Hooks.Mosaic`
Added support for GHC version 8.4.x by adding a Semigroup instance for
Monoids
* `XMonad.Actions.Navigation2D`
Added `sideNavigation` and a parameterised variant, providing a navigation
strategy with fewer quirks for tiled layouts using X.L.Spacing.
* `XMonad.Layout.Fullscreen`
The fullscreen layouts will now not render any window that is totally
obscured by fullscreen windows.
* `XMonad.Layout.Gaps`
Extended the sendMessage interface with `ModifyGaps` to allow arbitrary
modifications to the `GapSpec`.
* `XMonad.Layout.Groups`
Added a new `ModifyX` message type that allows the modifying
function to return values in the `X` monad.
* `XMonad.Actions.Navigation2D`
Generalised (and hence deprecated) hybridNavigation to hybridOf.
* `XMonad.Layout.LayoutHints`
Preserve the window order of the modified layout, except for the focused
@ -106,7 +735,12 @@
* `XMonad.Hooks.ManageHelpers`
Make type of ManageHook combinators more general.
- Make type of ManageHook combinators more general.
- New manage hook `doSink` for sinking windows (as upposed to the `doFloat` manage hook)
* `XMonad.Prompt`
Export `insertString`.
* `XMonad.Prompt.Window`
@ -124,9 +758,67 @@
changed and you want to re-sort windows into the appropriate
sub-layout.
* `XMonad.Actions.Minimize`
- Now has `withFirstMinimized` and `withFirstMinimized'` so you can perform
actions with both the last and first minimized windows easily.
* `XMonad.Config.Gnome`
- Update logout key combination (modm+shift+Q) to work with modern
* `XMonad.Prompt.Pass`
- New function `passTypePrompt` which uses `xdotool` to type in a password
from the store, bypassing the clipboard.
- New function `passEditPrompt` for editing a password from the
store.
- Now handles password labels with spaces and special characters inside
them.
* `XMonad.Prompt.Unicode`
- Persist unicode data cache across XMonad instances due to
`ExtensibleState` now used instead of `unsafePerformIO`.
- `typeUnicodePrompt :: String -> XPConfig -> X ()` provided to insert the
Unicode character via `xdotool` instead of copying it to the paste buffer.
- `mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()`
acts as a generic function to pass the selected Unicode character to any
program.
* `XMonad.Prompt.AppendFile`
- New function `appendFilePrompt'` which allows for transformation of the
string passed by a user before writing to a file.
* `XMonad.Hooks.DynamicLog`
- Add the -dock argument to the dzen spawn arguments
- Added a new function `dzenWithFlags` which allows specifying the arguments
passed to `dzen2` invocation. The behaviour of current `dzen` function is
unchanged.
* `XMonad.Util.Dzen`
- Now provides functions `fgColor` and `bgColor` to specify foreground and
background color, `align` and `slaveAlign` to set text alignment, and
`lineCount` to enable a second (slave) window that displays lines beyond
the initial (title) one.
* `XMonad.Hooks.DynamicLog`
- Added optional `ppVisibleNoWindows` to differentiate between empty
and non-empty visible workspaces in pretty printing.
* `XMonad.Actions.DynamicWorkspaceOrder`
- Added `updateName` and `removeName` to better control ordering when
workspace names are changed or workspaces are removed.
* `XMonad.Config.Azerty`
* Added `belgianConfig` and `belgianKeys` to support Belgian AZERTY
keyboards, which are slightly different from the French ones in the top
row.
## 0.13 (February 10, 2017)

19
README.md
View File

@ -1,14 +1,15 @@
# xmonad-contrib: Third Party Extensions to the xmonad Window Manager
[![Build Status](https://travis-ci.org/xmonad/xmonad-contrib.svg?branch=master)](https://travis-ci.org/xmonad/xmonad-contrib)
[![Open Source Helpers](https://www.codetriage.com/xmonad/xmonad-contrib/badges/users.svg)](https://www.codetriage.com/xmonad/xmonad-contrib)
You need the ghc compiler and xmonad window manager installed in
order to use these extensions.
For installation and configuration instructions, please see the
[xmonad website] [xmonad], the documents included with the
[xmonad source distribution] [xmonad-git], and the
[online haddock documentation] [xmonad-docs].
[xmonad website][xmonad], the documents included with the
[xmonad source distribution][xmonad-git], and the
[online haddock documentation][xmonad-docs].
## Getting or Updating XMonadContrib
@ -17,7 +18,7 @@ For installation and configuration instructions, please see the
* Git version: <https://github.com/xmonad/xmonad-contrib>
(To use git xmonad-contrib you must also use the
[git version of xmonad] [xmonad-git].)
[git version of xmonad][xmonad-git].)
## Contributing
@ -28,15 +29,15 @@ example, to use the Grid layout, one would import:
XMonad.Layout.Grid
For further details, see the [documentation] [developing] for the
`XMonad.Doc.Developing` module and the [xmonad website] [xmonad].
For further details, see the [documentation][developing] for the
`XMonad.Doc.Developing` module, XMonad's [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md) and the [xmonad website][xmonad].
## License
Code submitted to the contrib repo is licensed under the same license as
xmonad itself, with copyright held by the authors.
[xmonad]: http://xmonad.org
[xmonad-git]: https://github.com/xmonad/xmonad
[xmonad-docs]: http://www.xmonad.org/xmonad-docs
[developing]: http://xmonad.org/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html
[xmonad-docs]: http://hackage.haskell.org/package/xmonad
[developing]: http://hackage.haskell.org/package/xmonad-contrib/docs/XMonad-Doc-Developing.html

14
XMonad/Actions/Commands.hs
View File

@ -19,6 +19,7 @@ module XMonad.Actions.Commands (
-- $usage
commandMap,
runCommand,
runCommandConfig,
runCommand',
workspaceCommands,
screenCommands,
@ -103,11 +104,18 @@ defaultCommands = do
]
-- | Given a list of command\/action pairs, prompt the user to choose a
-- command and return the corresponding action.
-- command using dmenu and return the corresponding action.
runCommand :: [(String, X ())] -> X ()
runCommand cl = do
runCommand = runCommandConfig dmenu
-- | Given a list of command\/action pairs, prompt the user to choose a
-- command using dmenu-compatible launcher and return the corresponding action.
-- See X.U.Dmenu for compatible launchers.
runCommandConfig :: ([String] -> X String) -> [(String, X ())] -> X()
runCommandConfig f cl = do
let m = commandMap cl
choice <- dmenu (M.keys m)
choice <- f (M.keys m)
fromMaybe (return ()) (M.lookup choice m)
-- | Given the name of a command from 'defaultCommands', return the

56
XMonad/Actions/CycleRecentWS.hs
View File

@ -19,11 +19,16 @@ module XMonad.Actions.CycleRecentWS (
-- * Usage
-- $usage
cycleRecentWS,
cycleWindowSets
cycleRecentNonEmptyWS,
cycleWindowSets,
toggleRecentWS,
toggleRecentNonEmptyWS,
toggleWindowSets,
recentWS
) where
import XMonad hiding (workspaces)
import XMonad.StackSet
import XMonad.StackSet hiding (filter)
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
@ -47,9 +52,41 @@ cycleRecentWS :: [KeySym] -- ^ A list of modifier keys used when invoking this a
-> KeySym -- ^ Key used to switch to previous (more recent) workspace.
-- If it's the same as the nextWorkspace key, it is effectively ignored.
-> X ()
cycleRecentWS = cycleWindowSets options
where options w = map (view `flip` w) (recentTags w)
recentTags w = map tag $ tail (workspaces w) ++ [head (workspaces w)]
cycleRecentWS = cycleWindowSets $ recentWS (const True)
-- | Like 'cycleRecentWS', but restricted to non-empty workspaces.
cycleRecentNonEmptyWS :: [KeySym] -- ^ A list of modifier keys used when invoking this action.
-- As soon as one of them is released, the final switch is made.
-> KeySym -- ^ Key used to switch to next (less recent) workspace.
-> KeySym -- ^ Key used to switch to previous (more recent) workspace.
-- If it's the same as the nextWorkspace key, it is effectively ignored.
-> X ()
cycleRecentNonEmptyWS = cycleWindowSets $ recentWS (not . null . stack)
-- | Switch to the most recent workspace. The stack of most recently used workspaces
-- is updated, so repeated use toggles between a pair of workspaces.
toggleRecentWS :: X ()
toggleRecentWS = toggleWindowSets $ recentWS (const True)
-- | Like 'toggleRecentWS', but restricted to non-empty workspaces.
toggleRecentNonEmptyWS :: X ()
toggleRecentNonEmptyWS = toggleWindowSets $ recentWS (not . null . stack)
-- | Given a predicate p and the current WindowSet w, create a list of recent WindowSets,
-- most recent first, where the focused workspace satisfies p.
recentWS :: (WindowSpace -> Bool) -- ^ A workspace predicate.
-> WindowSet -- ^ The current WindowSet
-> [WindowSet]
recentWS p w = map (`view` w) recentTags
where recentTags = map tag
$ filter p
$ map workspace (visible w)
++ hidden w
++ [workspace (current w)]
cycref :: [a] -> Int -> a
@ -83,3 +120,12 @@ cycleWindowSets genOptions mods keyNext keyPrev = do
io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
setOption 0
io $ ungrabKeyboard d currentTime
-- | Switch to the first of a finite list of WindowSets.
toggleWindowSets :: (WindowSet -> [WindowSet]) -> X ()
toggleWindowSets genOptions = do
options <- gets $ genOptions . windowset
case options of
[] -> return ()
o:_ -> windows (const o)

2
XMonad/Actions/CycleWS.hs
View File

@ -262,7 +262,7 @@ wsTypeToPred HiddenEmptyWS = do ne <- wsTypeToPred EmptyWS
hi <- wsTypeToPred HiddenWS
return (\w -> hi w && ne w)
wsTypeToPred AnyWS = return (const True)
wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) `fmap` gets windowset
wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) <$> gets windowset
return $ (cur ==).groupName
where groupName = takeWhile (/=sep).tag
wsTypeToPred (WSIs p) = p

31
XMonad/Actions/DynamicProjects.hs
View File

@ -50,7 +50,7 @@ import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe, isNothing)
import Data.Monoid ((<>))
import System.Directory (setCurrentDirectory, getHomeDirectory)
import System.Directory (setCurrentDirectory, getHomeDirectory, makeAbsolute)
import XMonad
import XMonad.Actions.DynamicWorkspaces
import XMonad.Prompt
@ -145,24 +145,24 @@ instance ExtensionClass ProjectState where
--------------------------------------------------------------------------------
-- Internal types for working with XPrompt.
data ProjectPrompt = ProjectPrompt ProjectMode [ProjectName]
data ProjectPrompt = ProjectPrompt XPConfig ProjectMode [ProjectName]
data ProjectMode = SwitchMode | ShiftMode | RenameMode | DirMode
instance XPrompt ProjectPrompt where
showXPrompt (ProjectPrompt submode _) =
showXPrompt (ProjectPrompt _ submode _) =
case submode of
SwitchMode -> "Switch or Create Project: "
ShiftMode -> "Send Window to Project: "
RenameMode -> "New Project Name: "
DirMode -> "Change Project Directory: "
completionFunction (ProjectPrompt RenameMode _) = return . (:[])
completionFunction (ProjectPrompt DirMode _) =
let xpt = directoryMultipleModes "" (const $ return ())
completionFunction (ProjectPrompt _ RenameMode _) = return . (:[])
completionFunction (ProjectPrompt c DirMode _) =
let xpt = directoryMultipleModes' (complCaseSensitivity c) "" (const $ return ())
in completionFunction xpt
completionFunction (ProjectPrompt _ ns) = mkComplFunFromList' ns
completionFunction (ProjectPrompt c _ ns) = mkComplFunFromList' c ns
modeAction (ProjectPrompt SwitchMode _) buf auto = do
modeAction (ProjectPrompt _ SwitchMode _) buf auto = do
let name = if null auto then buf else auto
ps <- XS.gets projects
@ -171,18 +171,19 @@ instance XPrompt ProjectPrompt where
Nothing | null name -> return ()
| otherwise -> switchProject (defProject name)
modeAction (ProjectPrompt ShiftMode _) buf auto = do
modeAction (ProjectPrompt _ ShiftMode _) buf auto = do
let name = if null auto then buf else auto
ps <- XS.gets projects
shiftToProject . fromMaybe (defProject name) $ Map.lookup name ps
modeAction (ProjectPrompt RenameMode _) name _ =
modeAction (ProjectPrompt _ RenameMode _) name _ =
when (not (null name) && not (all isSpace name)) $ do
renameWorkspaceByName name
modifyProject (\p -> p { projectName = name })
modeAction (ProjectPrompt DirMode _) buf auto = do
let dir = if null auto then buf else auto
modeAction (ProjectPrompt _ DirMode _) buf auto = do
let dir' = if null auto then buf else auto
dir <- io $ makeAbsolute dir'
modifyProject (\p -> p { projectDirectory = dir })
--------------------------------------------------------------------------------
@ -230,7 +231,7 @@ dynamicProjectsStartupHook ps = XS.modify go
--------------------------------------------------------------------------------
-- | Find a project based on its name.
lookupProject :: ProjectName -> X (Maybe Project)
lookupProject name = Map.lookup name `fmap` XS.gets projects
lookupProject name = Map.lookup name <$> XS.gets projects
--------------------------------------------------------------------------------
-- | Fetch the current project (the one being used for the currently
@ -326,11 +327,11 @@ changeProjectDirPrompt = projectPrompt [ DirMode
-- | Prompt for a project name.
projectPrompt :: [ProjectMode] -> XPConfig -> X ()
projectPrompt submodes c = do
ws <- map W.tag `fmap` gets (W.workspaces . windowset)
ws <- map W.tag <$> gets (W.workspaces . windowset)
ps <- XS.gets projects
let names = sort (Map.keys ps `union` ws)
modes = map (\m -> XPT $ ProjectPrompt m names) submodes
modes = map (\m -> XPT $ ProjectPrompt c m names) submodes
mkXPromptWithModes modes c

4
XMonad/Actions/DynamicWorkspaceGroups.hs
View File

@ -133,7 +133,7 @@ instance XPrompt WSGPrompt where
promptWSGroupView :: XPConfig -> String -> X ()
promptWSGroupView xp s = do
gs <- fmap (M.keys . unWSG) XS.get
mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) viewWSGroup
mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' xp gs) viewWSGroup
-- | Prompt for a name for the current workspace group.
promptWSGroupAdd :: XPConfig -> String -> X ()
@ -144,4 +144,4 @@ promptWSGroupAdd xp s =
promptWSGroupForget :: XPConfig -> String -> X ()
promptWSGroupForget xp s = do
gs <- fmap (M.keys . unWSG) XS.get
mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) forgetWSGroup
mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' xp gs) forgetWSGroup

36
XMonad/Actions/DynamicWorkspaceOrder.hs
View File

@ -23,11 +23,14 @@ module XMonad.Actions.DynamicWorkspaceOrder
getWsCompareByOrder
, getSortByOrder
, swapWith
, updateName
, removeName
, moveTo
, moveToGreedy
, shiftTo
, withNthWorkspace'
, withNthWorkspace
) where
@ -152,6 +155,21 @@ swapOrder w1 w2 = do
XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1))
windows id -- force a status bar update
-- | Update the name of a workspace in the stored order.
updateName :: WorkspaceId -> WorkspaceId -> X ()
updateName oldId newId = XS.modify . withWSO $ changeKey oldId newId
-- | Remove a workspace from the stored order.
removeName :: WorkspaceId -> X ()
removeName = XS.modify . withWSO . M.delete
-- | Update a key in a Map.
changeKey :: Ord k => k -> k -> M.Map k a -> M.Map k a
changeKey oldKey newKey oldMap =
case M.updateLookupWithKey (\_ _ -> Nothing) oldKey oldMap of
(Nothing, _) -> oldMap
(Just val, newMap) -> M.insert newKey val newMap
-- | View the next workspace of the given type in the given direction,
-- where \"next\" is determined using the dynamic workspace order.
moveTo :: Direction1D -> WSType -> X ()
@ -166,13 +184,19 @@ moveToGreedy dir t = doTo dir t getSortByOrder (windows . W.greedyView)
shiftTo :: Direction1D -> WSType -> X ()
shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift)
-- | Do something with the nth workspace in the dynamic order after
-- transforming it. The callback is given the workspace's tag as well
-- as the 'WindowSet' of the workspace itself.
withNthWorkspace' :: ([WorkspaceId] -> [WorkspaceId]) -> (String -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace' tr job wnum = do
sort <- getSortByOrder
ws <- gets (tr . map W.tag . sort . W.workspaces . windowset)
case drop wnum ws of
(w:_) -> windows $ job w
[] -> return ()
-- | Do something with the nth workspace in the dynamic order. The
-- callback is given the workspace's tag as well as the 'WindowSet'
-- of the workspace itself.
withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace job wnum = do
sort <- getSortByOrder
ws <- gets (map W.tag . sort . W.workspaces . windowset)
case drop wnum ws of
(w:_) -> windows $ job w
[] -> return ()
withNthWorkspace = withNthWorkspace' id

2
XMonad/Actions/DynamicWorkspaces.hs
View File

@ -108,7 +108,7 @@ withWorkspaceIndex job widx = do
maybe (return ()) (windows . job) wtag
where
ilookup :: WorkspaceIndex -> X (Maybe WorkspaceTag)
ilookup idx = Map.lookup idx `fmap` XS.gets workspaceIndexMap
ilookup idx = Map.lookup idx <$> XS.gets workspaceIndexMap
mkCompl :: [String] -> String -> IO [String]

5
XMonad/Actions/FloatSnap.hs
View File

@ -27,7 +27,6 @@ module XMonad.Actions.FloatSnap (
ifClick') where
import XMonad
import Control.Applicative((<$>))
import Data.List (sort)
import Data.Maybe (listToMaybe,fromJust,isNothing)
import qualified XMonad.StackSet as W
@ -291,8 +290,8 @@ getSnap horiz collidedist d w = do
screen <- W.current <$> gets windowset
let sr = screenRect $ W.screenDetail screen
wl = W.integrate' . W.stack $ W.workspace screen
gr <- fmap ($sr) $ calcGap $ S.fromList [minBound .. maxBound]
wla <- filter (collides wa) `fmap` (io $ mapM (getWindowAttributes d) $ filter (/=w) wl)
gr <- ($sr) <$> calcGap (S.fromList [minBound .. maxBound])
wla <- filter (collides wa) <$> (io $ mapM (getWindowAttributes d) $ filter (/=w) wl)
return ( neighbours (back wa sr gr wla) (wpos wa)
, neighbours (front wa sr gr wla) (wpos wa + wdim wa)

19
XMonad/Actions/GridSelect.hs
View File

@ -28,7 +28,6 @@ module XMonad.Actions.GridSelect (
-- * Configuration
GSConfig(..),
def,
defaultGSConfig,
TwoDPosition,
buildDefaultGSConfig,
@ -107,13 +106,13 @@ import Data.Word (Word8)
--
-- Then add a keybinding, e.g.
--
-- > , ((modm, xK_g), goToSelected defaultGSConfig)
-- > , ((modm, xK_g), goToSelected def)
--
-- This module also supports displaying arbitrary information in a grid and letting
-- the user select from it. E.g. to spawn an application from a given list, you
-- can use the following:
--
-- > , ((modm, xK_s), spawnSelected defaultGSConfig ["xterm","gmplayer","gvim"])
-- > , ((modm, xK_s), spawnSelected def ["xterm","gmplayer","gvim"])
-- $commonGSConfig
--
@ -123,7 +122,7 @@ import Data.Word (Word8)
-- > {-# LANGUAGE NoMonomorphismRestriction #-}
-- > import XMonad
-- > ...
-- > gsconfig1 = defaultGSConfig { gs_cellheight = 30, gs_cellwidth = 100 }
-- > gsconfig1 = def { gs_cellheight = 30, gs_cellwidth = 100 }
--
-- An example where 'buildDefaultGSConfig' is used instead of 'defaultGSConfig'
-- in order to specify a custom colorizer is @gsconfig2@ (found in
@ -230,10 +229,6 @@ instance HasColorizer a where
instance HasColorizer a => Default (GSConfig a) where
def = buildDefaultGSConfig defaultColorizer
{-# DEPRECATED defaultGSConfig "Use def (from Data.Default, and re-exported from XMonad.Actions.GridSelect) instead." #-}
defaultGSConfig :: HasColorizer a => GSConfig a
defaultGSConfig = def
type TwoDPosition = (Integer, Integer)
type TwoDElementMap a = [(TwoDPosition,(String,a))]
@ -435,7 +430,7 @@ shadowWithKeymap keymap dflt keyEvent@(ks,_,m') = fromMaybe (dflt keyEvent) (M.l
select :: TwoD a (Maybe a)
select = do
s <- get
return $ fmap (snd . snd) $ findInElementMap (td_curpos s) (td_elementmap s)
return $ snd . snd <$> findInElementMap (td_curpos s) (td_elementmap s)
-- | Closes gridselect returning no element.
cancel :: TwoD a (Maybe a)
@ -711,11 +706,11 @@ windowMap = do
ws <- gets windowset
wins <- mapM keyValuePair (W.allWindows ws)
return wins
where keyValuePair w = flip (,) w `fmap` decorateName' w
where keyValuePair w = flip (,) w <$> decorateName' w
decorateName' :: Window -> X String
decorateName' w = do
fmap show $ getName w
show <$> getName w
-- | Builds a default gs config from a colorizer function.
buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
@ -770,7 +765,7 @@ gridselectWorkspace' conf func = withWindowSet $ \ws -> do
--
-- > import XMonad.Actions.DynamicWorkspaces (addWorkspace)
-- >
-- > gridselectWorkspace' defaultGSConfig
-- > gridselectWorkspace' def
-- > { gs_navigate = navNSearch
-- > , gs_rearranger = searchStringRearrangerGenerator id
-- > }

32
XMonad/Actions/GroupNavigation.hs
View File

@ -16,7 +16,7 @@
-- query.
--
-- Also provides a method for jumping back to the most recently used
-- window in any given group.
-- window in any given group, and predefined groups.
--
----------------------------------------------------------------------
@ -27,9 +27,14 @@ module XMonad.Actions.GroupNavigation ( -- * Usage
, nextMatchOrDo
, nextMatchWithThis
, historyHook
-- * Utilities
-- $utilities
, isOnAnyVisibleWS
) where
import Control.Monad.Reader
import Control.Monad.State
import Data.Foldable as Fold
import Data.Map as Map
import Data.Sequence as Seq
@ -122,7 +127,7 @@ focusNextMatchOrDo qry act = findM (runQuery qry)
-- Returns the list of windows ordered by workspace as specified in
-- ~/.xmonad/xmonad.hs
orderedWindowList :: Direction -> X (Seq Window)
orderedWindowList History = liftM (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get
orderedWindowList History = fmap (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get
orderedWindowList dir = withWindowSet $ \ss -> do
wsids <- asks (Seq.fromList . workspaces . config)
let wspcs = orderedWorkspaceList ss wsids
@ -142,7 +147,7 @@ orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs'
where
wspcs = SS.workspaces ss
wspcsMap = Fold.foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs
wspcs' = fmap (\wsid -> wspcsMap ! wsid) wsids
wspcs' = fmap (wspcsMap !) wsids
isCurWS ws = SS.tag ws == SS.tag (SS.workspace $ SS.current ss)
--- History navigation, requires a layout modifier -------------------
@ -167,7 +172,7 @@ updateHistory :: HistoryDB -> X HistoryDB
updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> do
let newcur = SS.peek ss
wins = Set.fromList $ SS.allWindows ss
newhist = flt (flip Set.member wins) (ins oldcur oldhist)
newhist = flt (`Set.member` wins) (ins oldcur oldhist)
return $ HistoryDB newcur (del newcur newhist)
where
ins x xs = maybe xs (<| xs) x
@ -216,3 +221,22 @@ findM cond xs = findM' cond (viewl xs)
if isMatch
then return (Just x')
else findM qry xs'
-- $utilities
-- #utilities#
-- Below are handy queries for use with 'nextMatch', 'nextMatchOrDo',
-- and 'nextMatchWithThis'.
-- | A query that matches all windows on visible workspaces. This is
-- useful for configurations with multiple screens, and matches even
-- invisible windows.
isOnAnyVisibleWS :: Query Bool
isOnAnyVisibleWS = do
w <- ask
ws <- liftX $ gets windowset
let allVisible = concat $ maybe [] SS.integrate . SS.stack . SS.workspace <$> SS.current ws:SS.visible ws
visibleWs = w `elem` allVisible
unfocused = maybe True (w /=) $ SS.peek ws
return $ visibleWs && unfocused

6
XMonad/Actions/Launcher.hs
View File

@ -62,8 +62,8 @@ type ExtensionActions = M.Map String (String -> X())
instance XPrompt CalculatorMode where
showXPrompt CalcMode = "calc %s> "
commandToComplete CalcMode = id --send the whole string to `calc`
completionFunction CalcMode = \s -> if (length s == 0) then return [] else do
fmap lines $ runProcessWithInput "calc" [s] ""
completionFunction CalcMode = \s -> if (length s == 0) then return [] else
lines <$> runProcessWithInput "calc" [s] ""
modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard
-- | Uses the program `hoogle` to search for functions
@ -88,7 +88,7 @@ instance XPrompt HoogleMode where
-- | Creates an autocompletion function for a programm given the program's name and a list of args to send to the command.
completionFunctionWith :: String -> [String] -> IO [String]
completionFunctionWith cmd args = do fmap lines $ runProcessWithInput cmd args ""
completionFunctionWith cmd args = lines <$> runProcessWithInput cmd args ""
-- | Creates a prompt with the given modes
launcherPrompt :: XPConfig -> [XPMode] -> X()

283
XMonad/Actions/MessageFeedback.hs
View File

@ -1,7 +1,8 @@
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.MessageFeedback
-- Copyright : (c) Quentin Moser <moserq@gmail.com>
-- Copyright : (c) -- Quentin Moser <moserq@gmail.com>
-- 2018 Yclept Nemo
-- License : BSD3
--
-- Maintainer : orphaned
@ -13,87 +14,263 @@
-- this facility.
-----------------------------------------------------------------------------
module XMonad.Actions.MessageFeedback (
-- * Usage
-- $usage
module XMonad.Actions.MessageFeedback
( -- * Usage
-- $usage
send
, tryMessage
, tryMessage_
, tryInOrder
, tryInOrder_
, sm
, sendSM
, sendSM_
) where
-- * Messaging variants
import XMonad.Core ( X (), Message, SomeMessage(..), LayoutClass(..), windowset, catchX )
import XMonad.StackSet ( current, workspace, layout, tag )
import XMonad.Operations ( updateLayout )
-- ** 'SomeMessage'
sendSomeMessageB, sendSomeMessage
, sendSomeMessageWithNoRefreshB, sendSomeMessageWithNoRefresh
, sendSomeMessageWithNoRefreshToCurrentB, sendSomeMessageWithNoRefreshToCurrent
import Control.Monad.State ( gets )
import Data.Maybe ( isJust )
import Control.Applicative ((<$>))
-- ** 'Message'
, sendMessageB
, sendMessageWithNoRefreshB
, sendMessageWithNoRefreshToCurrentB, sendMessageWithNoRefreshToCurrent
-- * Utility Functions
-- ** Send All
, sendSomeMessagesB, sendSomeMessages, sendMessagesB, sendMessages
-- ** Send Until
, tryInOrderB, tryInOrderWithNoRefreshToCurrentB, tryInOrderWithNoRefreshToCurrent
, tryMessageB, tryMessageWithNoRefreshToCurrentB, tryMessageWithNoRefreshToCurrent
-- ** Aliases
, sm
-- * Backwards Compatibility
-- $backwardsCompatibility
, send, sendSM, sendSM_
, tryInOrder, tryInOrder_
, tryMessage, tryMessage_
) where
import XMonad ( Window )
import XMonad.Core ( X(), Message, SomeMessage(..), LayoutClass(..), windowset, catchX, WorkspaceId, Layout, whenJust )
import XMonad.StackSet ( Workspace, current, workspace, layout, tag )
import XMonad.Operations ( updateLayout, windowBracket, modifyWindowSet )
import Data.Maybe ( isJust )
import Control.Monad ( void )
import Control.Monad.State ( gets )
import Control.Applicative ( liftA2 )
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.MessageFeedback
--
-- You can then use this module's functions wherever an action is expected.
-- You can then use this module's functions wherever an action is expected. All
-- feedback variants are supported:
--
-- * message to any workspace with no refresh
-- * message to current workspace with no refresh
-- * message to current workspace with refresh
--
-- Except "message to any workspace with refresh" which makes little sense.
--
-- Note that most functions in this module have a return type of @X Bool@
-- whereas configuration options will expect a @X ()@ action.
-- For example, the key binding
-- whereas configuration options will expect a @X ()@ action. For example, the
-- key binding:
--
-- > -- Shrink the master area of a tiled layout, or move the focused window
-- > -- to the left in a WindowArranger-based layout
-- > ((modKey, xK_Left), tryMessage Shrink (MoveLeft 50))
-- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrentB Shrink (MoveLeft 50))
--
-- is mis-typed. For this reason, this module provides alternatives (ending with
-- an underscore, e.g. tryMessage_) that discard their result and return an @X ()@.
-- For example, to correct the previous example:
-- is mis-typed. For this reason, this module provides alternatives (not ending
-- with an uppercase \"B\", e.g. 'XMonad.Operations.sendMessage' rather than
-- 'sendMessageB') that discard their boolean result and return an @X ()@. For
-- example, to correct the previous example:
--
-- > ((modKey, xK_Left), tryMessage_ Shrink (MoveLeft 50))
-- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrent Shrink (MoveLeft 50))
--
-- This module also provides 'SomeMessage' variants of each 'Message' function
-- for when the messages are of differing types (but still instances of
-- 'Message'). First box each message using 'SomeMessage' or the convenience
-- alias 'sm'. Then, for example, to send each message:
--
-- > sendSomeMessages [sm messageOfTypeA, sm messageOfTypeB]
--
-- This is /not/ equivalent to the following example, which will not refresh
-- the workspace unless the last message is handled:
--
-- > sendMessageWithNoRefreshToCurrent messageOfTypeA >> sendMessage messageOfTypeB
-- | Behaves like 'XMonad.Operations.sendMessage', but returns True of the
-- message was handled by the layout, False otherwise.
send :: Message a => a -> X Bool
send = sendSM . sm
-- | Variant of 'XMonad.Operations.sendMessage'. Accepts 'SomeMessage'; to use
-- 'Message' see 'sendMessageB'. Returns @True@ if the message was handled,
-- @False@ otherwise. Instead of using 'sendSomeMessageWithNoRefreshToCurrentB'
-- for efficiency this is pretty much an exact copy of the
-- 'XMonad.Operations.sendMessage' code - foregoes the O(n) 'updateLayout'.
sendSomeMessageB :: SomeMessage -> X Bool
sendSomeMessageB m = windowBracket id $ do
w <- workspace . current <$> gets windowset
ml <- handleMessage (layout w) m `catchX` return Nothing
whenJust ml $ \l ->
modifyWindowSet $ \ws -> ws { current = (current ws)
{ workspace = (workspace $ current ws)
{ layout = l }}}
return $ isJust ml
-- | Sends the first message, and if it was not handled, sends the second.
-- Returns True if either message was handled, False otherwise.
tryMessage :: (Message a, Message b) => a -> b -> X Bool
tryMessage m1 m2 = do b <- send m1
if b then return True else send m2
-- | Variant of 'sendSomeMessageB' that discards the result.
sendSomeMessage :: SomeMessage -> X ()
sendSomeMessage = void . sendSomeMessageB
tryMessage_ :: (Message a, Message b) => a -> b -> X ()
tryMessage_ m1 m2 = tryMessage m1 m2 >> return ()
-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh'. Accepts
-- 'SomeMessage'; to use 'Message' see 'sendMessageWithNoRefreshB'. Returns
-- @True@ if the message was handled, @False@ otherwise.
sendSomeMessageWithNoRefreshB :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X Bool
sendSomeMessageWithNoRefreshB m w
= handleMessage (layout w) m `catchX` return Nothing
>>= liftA2 (>>) (updateLayout $ tag w) (return . isJust)
-- | Tries sending every message of the list in order until one of them
-- is handled. Returns True if one of the messages was handled, False otherwise.
tryInOrder :: [SomeMessage] -> X Bool
tryInOrder [] = return False
tryInOrder (m:ms) = do b <- sendSM m
if b then return True else tryInOrder ms
-- | Variant of 'sendSomeMessageWithNoRefreshB' that discards the result.
sendSomeMessageWithNoRefresh :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X ()
sendSomeMessageWithNoRefresh m = void . sendSomeMessageWithNoRefreshB m
tryInOrder_ :: [SomeMessage] -> X ()
tryInOrder_ ms = tryInOrder ms >> return ()
-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh' that sends the
-- message to the current layout. Accepts 'SomeMessage'; to use 'Message' see
-- 'sendMessageWithNoRefreshToCurrentB'. Returns @True@ if the message was
-- handled, @False@ otherwise. This function is somewhat of a cross between
-- 'XMonad.Operations.sendMessage' (sends to the current layout) and
-- 'XMonad.Operations.sendMessageWithNoRefresh' (does not refresh).
sendSomeMessageWithNoRefreshToCurrentB :: SomeMessage -> X Bool
sendSomeMessageWithNoRefreshToCurrentB m
= (gets $ workspace . current . windowset)
>>= sendSomeMessageWithNoRefreshB m
-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' that discards the
-- result.
sendSomeMessageWithNoRefreshToCurrent :: SomeMessage -> X ()
sendSomeMessageWithNoRefreshToCurrent = void . sendSomeMessageWithNoRefreshToCurrentB
-- | Convenience shorthand for 'XMonad.Core.SomeMessage'.
-- | Variant of 'sendSomeMessageB' which like 'XMonad.Operations.sendMessage'
-- accepts 'Message' rather than 'SomeMessage'. Returns @True@ if the message
-- was handled, @False@ otherwise.
sendMessageB :: Message a => a -> X Bool
sendMessageB = sendSomeMessageB . SomeMessage
-- | Variant of 'sendSomeMessageWithNoRefreshB' which like
-- 'XMonad.Operations.sendMessageWithNoRefresh' accepts 'Message' rather than
-- 'SomeMessage'. Returns @True@ if the message was handled, @False@ otherwise.
sendMessageWithNoRefreshB :: Message a => a -> Workspace WorkspaceId (Layout Window) Window -> X Bool
sendMessageWithNoRefreshB = sendSomeMessageWithNoRefreshB . SomeMessage
-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' which accepts
-- 'Message' rather than 'SomeMessage'. Returns @True@ if the message was
-- handled, @False@ otherwise.
sendMessageWithNoRefreshToCurrentB :: Message a => a -> X Bool
sendMessageWithNoRefreshToCurrentB = sendSomeMessageWithNoRefreshToCurrentB . SomeMessage
-- | Variant of 'sendMessageWithNoRefreshToCurrentB' that discards the result.
sendMessageWithNoRefreshToCurrent :: Message a => a -> X ()
sendMessageWithNoRefreshToCurrent = void . sendMessageWithNoRefreshToCurrentB
-- | Send each 'SomeMessage' to the current layout without refresh (using
-- 'sendSomeMessageWithNoRefreshToCurrentB') and collect the results. If any
-- message was handled, refresh. If you want to sequence a series of messages
-- that would have otherwise used 'XMonad.Operations.sendMessage' while
-- minimizing refreshes, use this.
sendSomeMessagesB :: [SomeMessage] -> X [Bool]
sendSomeMessagesB
= windowBracket or
. mapM sendSomeMessageWithNoRefreshToCurrentB
-- | Variant of 'sendSomeMessagesB' that discards the results.
sendSomeMessages :: [SomeMessage] -> X ()
sendSomeMessages = void . sendSomeMessagesB
-- | Variant of 'sendSomeMessagesB' which accepts 'Message' rather than
-- 'SomeMessage'. Use this if all the messages are of the same type.
sendMessagesB :: Message a => [a] -> X [Bool]
sendMessagesB = sendSomeMessagesB . map SomeMessage
-- | Variant of 'sendMessagesB' that discards the results.
sendMessages :: Message a => [a] -> X ()
sendMessages = void . sendMessagesB
-- | Apply the dispatch function in order to each message of the list until one
-- is handled. Returns @True@ if so, @False@ otherwise.
tryInOrderB :: (SomeMessage -> X Bool) -> [SomeMessage] -> X Bool
tryInOrderB _ [] = return False
tryInOrderB f (m:ms) = do b <- f m
if b then return True else tryInOrderB f ms
-- | Variant of 'tryInOrderB' that sends messages to the current layout without
-- refresh using 'sendSomeMessageWithNoRefreshToCurrentB'.
tryInOrderWithNoRefreshToCurrentB :: [SomeMessage] -> X Bool
tryInOrderWithNoRefreshToCurrentB = tryInOrderB sendSomeMessageWithNoRefreshToCurrentB
-- | Variant of 'tryInOrderWithNoRefreshToCurrent' that discards the results.
tryInOrderWithNoRefreshToCurrent :: [SomeMessage] -> X ()
tryInOrderWithNoRefreshToCurrent = void . tryInOrderWithNoRefreshToCurrentB
-- | Apply the dispatch function to the first message, and if it was not
-- handled, apply it to the second. Returns @True@ if either message was
-- handled, @False@ otherwise.
tryMessageB :: (Message a, Message b) => (SomeMessage -> X Bool) -> a -> b -> X Bool
tryMessageB f m1 m2 = tryInOrderB f [sm m1,sm m2]
-- | Variant of 'tryMessageB' that sends messages to the current layout without
-- refresh using 'sendMessageWithNoRefreshToCurrentB'.
tryMessageWithNoRefreshToCurrentB :: (Message a, Message b) => a -> b -> X Bool
tryMessageWithNoRefreshToCurrentB = tryMessageB sendSomeMessageWithNoRefreshToCurrentB
-- | Variant of 'tryMessage' that discards the results.
tryMessageWithNoRefreshToCurrent :: (Message a, Message b) => a -> b -> X ()
tryMessageWithNoRefreshToCurrent m = void . tryMessageWithNoRefreshToCurrentB m
-- | Convenience shorthand for 'SomeMessage'.
sm :: Message a => a -> SomeMessage
sm = SomeMessage
--------------------------------------------------------------------------------
-- Backwards Compatibility:
--------------------------------------------------------------------------------
{-# DEPRECATED send "Use sendMessageB instead." #-}
{-# DEPRECATED sendSM "Use sendSomeMessageB instead." #-}
{-# DEPRECATED sendSM_ "Use sendSomeMessage instead." #-}
{-# DEPRECATED tryInOrder "Use tryInOrderWithNoRefreshToCurrentB instead." #-}
{-# DEPRECATED tryInOrder_ "Use tryInOrderWithNoRefreshToCurrent instead." #-}
{-# DEPRECATED tryMessage "Use tryMessageWithNoRefreshToCurrentB instead." #-}
{-# DEPRECATED tryMessage_ "Use tryMessageWithNoRefreshToCurrent instead." #-}
-- $backwardsCompatibility
-- The following functions exist solely for compatibility with pre-0.14
-- releases.
-- | See 'sendMessageWithNoRefreshToCurrentB'.
send :: Message a => a -> X Bool
send = sendMessageWithNoRefreshToCurrentB
-- | See 'sendSomeMessageWithNoRefreshToCurrentB'.
sendSM :: SomeMessage -> X Bool
sendSM m = do w <- workspace . current <$> gets windowset
ml' <- handleMessage (layout w) m `catchX` return Nothing
updateLayout (tag w) ml'
return $ isJust ml'
sendSM = sendSomeMessageWithNoRefreshToCurrentB
-- | See 'sendSomeMessageWithNoRefreshToCurrent'.
sendSM_ :: SomeMessage -> X ()
sendSM_ m = sendSM m >> return ()
sendSM_ = sendSomeMessageWithNoRefreshToCurrent
-- | See 'tryInOrderWithNoRefreshToCurrentB'.
tryInOrder :: [SomeMessage] -> X Bool
tryInOrder = tryInOrderWithNoRefreshToCurrentB
-- | See 'tryInOrderWithNoRefreshToCurrent'.
tryInOrder_ :: [SomeMessage] -> X ()
tryInOrder_ = tryInOrderWithNoRefreshToCurrent
-- | See 'tryMessageWithNoRefreshToCurrentB'.
tryMessage :: (Message a, Message b) => a -> b -> X Bool
tryMessage = tryMessageWithNoRefreshToCurrentB
-- | See 'tryMessageWithNoRefreshToCurrent'.
tryMessage_ :: (Message a, Message b) => a -> b -> X ()
tryMessage_ = tryMessageWithNoRefreshToCurrent

15
XMonad/Actions/Minimize.hs
View File

@ -29,6 +29,8 @@ module XMonad.Actions.Minimize
, maximizeWindowAndFocus
, withLastMinimized
, withLastMinimized'
, withFirstMinimized
, withFirstMinimized'
, withMinimized
) where
@ -41,7 +43,6 @@ import XMonad.Util.Minimize
import XMonad.Util.WindowProperties (getProp32)
import Foreign.C.Types (CLong)
import Control.Applicative((<$>))
import Control.Monad (join)
import Data.Maybe (fromMaybe, listToMaybe)
import qualified Data.List as L
@ -85,7 +86,7 @@ modified f = XS.modified $
in Minimized { rectMap = newRectMap
, minimizedStack = (newWindows L.\\ oldStack)
++
(newWindows `L.intersect` oldStack)
(oldStack `L.intersect` newWindows)
}
@ -115,6 +116,16 @@ maximizeWindow = maximizeWindowAndChangeWSet $ const id
maximizeWindowAndFocus :: Window -> X ()
maximizeWindowAndFocus = maximizeWindowAndChangeWSet W.focusWindow
-- | Perform an action with first minimized window on current workspace
-- or do nothing if there is no minimized windows on current workspace
withFirstMinimized :: (Window -> X ()) -> X ()
withFirstMinimized action = withFirstMinimized' (flip whenJust action)
-- | Like withFirstMinimized but the provided action is always invoked with a
-- 'Maybe Window', that will be nothing if there is no first minimized window.
withFirstMinimized' :: (Maybe Window -> X ()) -> X ()
withFirstMinimized' action = withMinimized (action . listToMaybe . reverse)
-- | Perform an action with last minimized window on current workspace
-- or do nothing if there is no minimized windows on current workspace
withLastMinimized :: (Window -> X ()) -> X ()

2
XMonad/Actions/MouseResize.hs
View File

@ -105,7 +105,7 @@ handleResize st ButtonEvent { ev_window = ew, ev_event_type = et }
handleResize _ _ = return ()
createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window)
createInputWindow ((w,r),mr) = do
createInputWindow ((w,r),mr) =
case mr of
Just tr -> withDisplay $ \d -> do
tw <- mkInputWindow d tr

128
XMonad/Actions/Navigation2D.hs
View File

@ -39,10 +39,12 @@ module XMonad.Actions.Navigation2D ( -- * Usage
, withNavigation2DConfig
, Navigation2DConfig(..)
, def
, defaultNavigation2DConfig
, Navigation2D
, lineNavigation
, centerNavigation
, sideNavigation
, sideNavigationWithBias
, hybridOf
, hybridNavigation
, fullScreenRect
, singleWindowRect
@ -59,6 +61,7 @@ import Control.Applicative
import qualified Data.List as L
import qualified Data.Map as M
import Data.Maybe
import Data.Ord (comparing)
import XMonad hiding (Screen)
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
@ -70,16 +73,17 @@ import XMonad.Util.Types
-- Navigation2D provides directional navigation (go left, right, up, down) for
-- windows and screens. It treats floating and tiled windows as two separate
-- layers and provides mechanisms to navigate within each layer and to switch
-- between layers. Navigation2D provides two different navigation strategies
-- (see <#Technical_Discussion> for details): /Line navigation/ feels rather
-- natural but may make it impossible to navigate to a given window from the
-- current window, particularly in the floating layer. /Center navigation/
-- feels less natural in certain situations but ensures that all windows can be
-- reached without the need to involve the mouse. A third option is to use
-- /Hybrid navigation/, which automatically chooses between the two whenever
-- navigation is attempted. Navigation2D allows different navigation strategies
-- to be used in the two layers and allows customization of the navigation strategy
-- for the tiled layer based on the layout currently in effect.
-- between layers. Navigation2D provides three different navigation strategies
-- (see <#Technical_Discussion> for details): /Line navigation/ and
-- /Side navigation/ feel rather natural but may make it impossible to navigate
-- to a given window from the current window, particularly in the floating
-- layer. /Center navigation/ feels less natural in certain situations but
-- ensures that all windows can be reached without the need to involve the
-- mouse. Another option is to use a /Hybrid/ of the three strategies,
-- automatically choosing whichever first provides a suitable target window.
-- Navigation2D allows different navigation strategies to be used in the two
-- layers and allows customization of the navigation strategy for the tiled
-- layer based on the layout currently in effect.
--
-- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@:
--
@ -318,12 +322,46 @@ lineNavigation = N 1 doLineNavigation
centerNavigation :: Navigation2D
centerNavigation = N 2 doCenterNavigation
-- | Hybrid navigation. This attempts Line navigation, then falls back on Center
-- navigation if it does not find any suitable target windows. This is useful since
-- Line navigation tends to fail on gaps, but provides more intuitive motions
-- when it succeeds—provided there are no floating windows.
-- | Side navigation. Consider navigating to the right this time. The strategy
-- is to take the line segment forming the right boundary of the current window,
-- and push it to the right until it intersects with at least one other window.
-- Of those windows, one with a point that is the closest to the centre of the
-- line (+1) is selected. This is probably the most intuitive strategy for the
-- tiled layer when using XMonad.Layout.Spacing.
sideNavigation :: Navigation2D
sideNavigation = N 1 (doSideNavigationWithBias 1)
-- | Side navigation with bias. Consider a case where the screen is divided
-- up into three vertical panes; the side panes occupied by one window each and
-- the central pane split across the middle by two windows. By the criteria
-- of side navigation, the two central windows are equally good choices when
-- navigating inwards from one of the side panes. Hence in order to be
-- equitable, symmetric and pleasant to use, different windows are chosen when
-- navigating from different sides. In particular, the lower is chosen when
-- going left and the higher when going right, causing L, L, R, R, L, L, etc to
-- cycle through the four windows clockwise. This is implemented by using a bias
-- of 1. /Bias/ is how many pixels off centre the vertical split can be before
-- this behaviour is lost and the same window chosen every time. A negative bias
-- swaps the preferred window for each direction. A bias of zero disables the
-- behaviour.
sideNavigationWithBias :: Int -> Navigation2D
sideNavigationWithBias b = N 1 (doSideNavigationWithBias b)
-- | Hybrid of two modes of navigation, preferring the motions of the first.
-- Use this if you want to fall back on a second strategy whenever the first
-- does not find a candidate window. E.g.
-- @hybridOf lineNavigation centerNavigation@ is a good strategy for the
-- floating layer, and @hybridOf sideNavigation centerNavigation@ will enable
-- you to take advantage of some of the latter strategy's more interesting
-- motions in the tiled layer.
hybridOf :: Navigation2D -> Navigation2D -> Navigation2D
hybridOf (N g1 s1) (N g2 s2) = N (max g1 g2) $ applyToBoth s1 s2
where
applyToBoth f g a b c = f a b c <|> g a b c
{-# DEPRECATED hybridNavigation "Use hybridOf with lineNavigation and centerNavigation as arguments." #-}
hybridNavigation :: Navigation2D
hybridNavigation = N 2 doHybridNavigation
hybridNavigation = hybridOf lineNavigation centerNavigation
-- | Stores the configuration of directional navigation. The 'Default' instance
-- uses line navigation for the tiled layer and for navigation between screens,
@ -412,10 +450,6 @@ withNavigation2DConfig conf2d xconf = xconf { startupHook = startupHook xconf
>> XS.put conf2d
}
{-# DEPRECATED defaultNavigation2DConfig "Use def (from Data.Default, and re-exported from XMonad.Actions.Navigation2D) instead." #-}
defaultNavigation2DConfig :: Navigation2DConfig
defaultNavigation2DConfig = def
instance Default Navigation2DConfig where
def = Navigation2DConfig { defaultTiledNavigation = lineNavigation
, floatNavigation = centerNavigation
@ -767,12 +801,54 @@ doCenterNavigation dir (cur, rect) winrects
-- or it has the same distance but comes later
-- in the window stack
-- | Implements Hybrid navigation. This attempts Line navigation first,
-- then falls back on Center navigation if it finds no suitable target window.
doHybridNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doHybridNavigation = applyToBoth (<|>) doLineNavigation doCenterNavigation
where
applyToBoth f g h a b c = f (g a b c) (h a b c)
-- x -y w h format is a pain. Let's use side coordinates. We assume x1 <= x2 and
-- y1 <= y2, and make the assumption valid by initialising SideRects with the
-- property and carefully preserving it over any individual transformation.
data SideRect = SideRect { x1 :: Int, x2 :: Int, y1 :: Int, y2 :: Int }
deriving Show
-- Conversion from Rectangle format to SideRect.
toSR :: Rectangle -> SideRect
toSR (Rectangle x y w h) = SideRect (fi x) (fi x + fi w) (-fi y - fi h) (-fi y)
-- Implements side navigation with bias.
doSideNavigationWithBias ::
Eq a => Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a
doSideNavigationWithBias bias dir (cur, rect)
= fmap fst . listToMaybe
. L.sortBy (comparing dist) . foldr acClosest []
. filter (`toRightOf` (cur, transform rect))
. map (fmap transform)
where
-- Getting the center of the current window so we can make it the new origin.
cOf r = ((x1 r + x2 r) `div` 2, (y1 r + y2 r) `div` 2)
(x0, y0) = cOf . toSR $ rect
-- Translate the given SideRect by (-x0, -y0).
translate r = SideRect (x1 r - x0) (x2 r - x0) (y1 r - y0) (y2 r - y0)
-- Rotate the given SideRect 90 degrees counter-clockwise about the origin.
rHalfPiCC r = SideRect (-y2 r) (-y1 r) (x1 r) (x2 r)
-- Apply the above function until d becomes synonymous with R (wolog).
rotateToR d = let (_, _:l) = break (d ==) [U, L, D, R]
in foldr (const $ (.) rHalfPiCC) id l
transform = rotateToR dir . translate . toSR
-- (_, r) `toRightOf` (_, c) iff r has points to the right of c that aren't
-- below or above c, i.e. iff:
-- [x1 r, x2 r] x [y1 r, y2 r] intersects (x2 c, infinity) x (y1 c, y2 c)
toRightOf (_, r) (_, c) = (x2 r > x2 c) && (y2 r > y1 c) && (y1 r < y2 c)
-- Greedily accumulate the windows tied for the leftmost left side.
acClosest (w, r) l@((_, r'):_) | x1 r == x1 r' = (w, r) : l
| x1 r > x1 r' = l
acClosest (w, r) _ = (w, r) : []
-- Given a (_, SideRect), calculate how far it is from the y=bias line.
dist (_, r) | (y1 r <= bias) && (bias <= y2 r) = 0
| otherwise = min (abs $ y1 r - bias) (abs $ y2 r - bias)
-- | Swaps the current window with the window given as argument
swap :: Window -> WindowSet -> WindowSet

2
XMonad/Actions/NoBorders.hs
View File

@ -27,7 +27,7 @@ toggleBorder :: Window -> X ()
toggleBorder w = do
bw <- asks (borderWidth . config)
withDisplay $ \d -> io $ do
cw <- wa_border_width `fmap` getWindowAttributes d w
cw <- wa_border_width <$> getWindowAttributes d w
if cw == 0
then setWindowBorderWidth d w bw
else setWindowBorderWidth d w 0

60
XMonad/Actions/PerWindowKeys.hs Normal file
View File

@ -0,0 +1,60 @@
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.PerWindowKeys
-- Copyright : (c) Wilson Sales, 2019
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Wilson Sales <spoonm@spoonm.org>
-- Stability : unstable
-- Portability : unportable
--
-- Define key-bindings on per-window basis.
--
-----------------------------------------------------------------------------
module XMonad.Actions.PerWindowKeys (
-- * Usage
-- $usage
bindAll,
bindFirst
) where
import XMonad
-- $usage
--
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.PerWindowKeys
--
-- > ,((0, xK_F2), bindFirst [(className =? "firefox", spawn "dmenu"), (isFloat, withFocused $ windows . W.sink)])
--
-- > ,((0, xK_F3), bindAll [(isDialog, kill), (pure True, doSomething)])
--
-- If you want an action that will always run, but also want to do something for
-- other queries, you can use @'bindAll' [(query1, action1), ..., (pure True,
-- alwaysDoThisAction)]@.
--
-- Similarly, if you want a default action to be run if all the others failed,
-- you can use @'bindFirst' [(query1, action1), ..., (pure True,
-- doThisIfTheOthersFail)]@.
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | Run an action if a Query holds true. Doesn't stop at the first one that
-- does, however, and could potentially run all actions.
bindAll :: [(Query Bool, X ())] -> X ()
bindAll = mapM_ choose where
choose (mh,action) = withFocused $ \w -> whenX (runQuery mh w) action
-- | Run the action paired with the first Query that holds true.
bindFirst :: [(Query Bool, X ())] -> X ()
bindFirst = withFocused . chooseOne
chooseOne :: [(Query Bool, X ())] -> Window -> X ()
chooseOne [] _ = return ()
chooseOne ((mh,a):bs) w = do
c <- runQuery mh w
if c then a
else chooseOne bs w

117
XMonad/Actions/PhysicalScreens.hs
View File

@ -21,6 +21,12 @@ module XMonad.Actions.PhysicalScreens (
, sendToScreen
, onNextNeighbour
, onPrevNeighbour
, horizontalScreenOrderer
, verticalScreenOrderer
, ScreenComparator(ScreenComparator)
, getScreenIdAndRectangle
, screenComparatorById
, screenComparatorByRectangle
) where
import XMonad
@ -36,17 +42,20 @@ physical location relative to each other (as reported by Xinerama),
rather than their @ScreenID@ s, which are arbitrarily determined by
your X server and graphics hardware.
Screens are ordered by the upper-left-most corner, from top-to-bottom
You can specify how to order the screen by giving a ScreenComparator.
To create a screen comparator you can use screenComparatorByRectangle or screenComparatorByScreenId.
The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom
and then left-to-right.
Example usage in your @~\/.xmonad\/xmonad.hs@ file:
> import XMonad.Actions.PhysicalScreens
> import Data.Default
> , ((modMask, xK_a), onPrevNeighbour W.view)
> , ((modMask, xK_o), onNextNeighbour W.view)
> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour W.shift)
> , ((modMask .|. shiftMask, xK_o), onNextNeighbour W.shift)
> , ((modMask, xK_a), onPrevNeighbour def W.view)
> , ((modMask, xK_o), onNextNeighbour def W.view)
> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour def W.shift)
> , ((modMask .|. shiftMask, xK_o), onNextNeighbour def W.shift)
> --
> -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3
@ -54,7 +63,7 @@ Example usage in your @~\/.xmonad\/xmonad.hs@ file:
> --
> [((modm .|. mask, key), f sc)
> | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
> , (f, mask) <- [(viewScreen, 0), (sendToScreen, shiftMask)]]
> , (f, mask) <- [(viewScreen def, 0), (sendToScreen def, shiftMask)]]
For detailed instructions on editing your key bindings, see
"XMonad.Doc.Extending#Editing_key_bindings".
@ -63,52 +72,78 @@ For detailed instructions on editing your key bindings, see
-- | The type of the index of a screen by location
newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)
getScreenIdAndRectangle :: (W.Screen i l a ScreenId ScreenDetail) -> (ScreenId, Rectangle)
getScreenIdAndRectangle screen = (W.screen screen, rect) where
rect = screenRect $ W.screenDetail screen
-- | Translate a physical screen index to a "ScreenId"
getScreen :: PhysicalScreen -> X (Maybe ScreenId)
getScreen (P i) = do w <- gets windowset
let screens = W.current w : W.visible w
if i<0 || i >= length screens
then return Nothing
else let ss = sortBy (cmpScreen `on` (screenRect . W.screenDetail)) screens
in return $ Just $ W.screen $ ss !! i
getScreen:: ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
getScreen (ScreenComparator cmpScreen) (P i) = do w <- gets windowset
let screens = W.current w : W.visible w
if i<0 || i >= length screens
then return Nothing
else let ss = sortBy (cmpScreen `on` getScreenIdAndRectangle) screens
in return $ Just $ W.screen $ ss !! i
-- | Switch to a given physical screen
viewScreen :: PhysicalScreen -> X ()
viewScreen p = do i <- getScreen p
whenJust i $ \s -> do
w <- screenWorkspace s
whenJust w $ windows . W.view
viewScreen :: ScreenComparator -> PhysicalScreen -> X ()
viewScreen sc p = do i <- getScreen sc p
whenJust i $ \s -> do
w <- screenWorkspace s
whenJust w $ windows . W.view
-- | Send the active window to a given physical screen
sendToScreen :: PhysicalScreen -> X ()
sendToScreen p = do i <- getScreen p
whenJust i $ \s -> do
w <- screenWorkspace s
whenJust w $ windows . W.shift
sendToScreen :: ScreenComparator -> PhysicalScreen -> X ()
sendToScreen sc p = do i <- getScreen sc p
whenJust i $ \s -> do
w <- screenWorkspace s
whenJust w $ windows . W.shift
-- | Compare two screens by their top-left corners, ordering
-- | top-to-bottom and then left-to-right.
cmpScreen :: Rectangle -> Rectangle -> Ordering
cmpScreen (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2)
-- | A ScreenComparator allow to compare two screen based on their coordonate and Xinerama Id
newtype ScreenComparator = ScreenComparator ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
-- | The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom
instance Default ScreenComparator where
def= verticalScreenOrderer
-- | Compare screen only by their coordonate
screenComparatorByRectangle :: (Rectangle -> Rectangle -> Ordering) -> ScreenComparator
screenComparatorByRectangle rectComparator = ScreenComparator comparator where
comparator (_, rec1) (_, rec2) = rectComparator rec1 rec2
-- | Compare screen only by their Xinerama id
screenComparatorById :: (ScreenId -> ScreenId -> Ordering) -> ScreenComparator
screenComparatorById idComparator = ScreenComparator comparator where
comparator (id1, _) (id2, _) = idComparator id1 id2
-- | orders screens by the upper-left-most corner, from top-to-bottom
verticalScreenOrderer :: ScreenComparator
verticalScreenOrderer = screenComparatorByRectangle comparator where
comparator (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1, x1) (y2, x2)
-- | orders screens by the upper-left-most corner, from left-to-right
horizontalScreenOrderer :: ScreenComparator
horizontalScreenOrderer = screenComparatorByRectangle comparator where
comparator (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (x1, y1) (x2, y2)
-- | Get ScreenId for neighbours of the current screen based on position offset.
getNeighbour :: Int -> X ScreenId
getNeighbour d = do w <- gets windowset
let ss = map W.screen $ sortBy (cmpScreen `on` (screenRect . W.screenDetail)) $ W.current w : W.visible w
curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss
pos = (curPos + d) `mod` length ss
return $ ss !! pos
getNeighbour :: ScreenComparator -> Int -> X ScreenId
getNeighbour (ScreenComparator cmpScreen) d =
do w <- gets windowset
let ss = map W.screen $ sortBy (cmpScreen `on` getScreenIdAndRectangle) $ W.current w : W.visible w
curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss
pos = (curPos + d) `mod` length ss
return $ ss !! pos
neighbourWindows :: Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
neighbourWindows d f = do s <- getNeighbour d
w <- screenWorkspace s
whenJust w $ windows . f
neighbourWindows :: ScreenComparator -> Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
neighbourWindows sc d f = do s <- getNeighbour sc d
w <- screenWorkspace s
whenJust w $ windows . f
-- | Apply operation on a WindowSet with the WorkspaceId of the next screen in the physical order as parameter.
onNextNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
onNextNeighbour = neighbourWindows 1
onNextNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
onNextNeighbour sc = neighbourWindows sc 1
-- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter.
onPrevNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
onPrevNeighbour = neighbourWindows (-1)
onPrevNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
onPrevNeighbour sc = neighbourWindows sc (-1)

210
XMonad/Actions/Prefix.hs Normal file
View File

@ -0,0 +1,210 @@
{-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.Prefix
-- Copyright : (c) Matus Goljer <matus.goljer@gmail.com>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Matus Goljer <matus.goljer@gmail.com>
-- Stability : unstable
-- Portability : unportable
--
-- A module that allows the user to use a prefix argument (raw or numeric).
--
-----------------------------------------------------------------------------
module XMonad.Actions.Prefix
(
-- * Usage
-- $usage
-- * Installation
-- $installation
PrefixArgument(..)
, usePrefixArgument
, useDefaultPrefixArgument
, withPrefixArgument
, isPrefixRaw
, isPrefixNumeric
, ppFormatPrefix
) where
import qualified Data.Map as M
import Data.Maybe
import Control.Monad (liftM2)
import XMonad
import XMonad.Util.ExtensibleState as XS
import XMonad.Util.Paste (sendKey)
import XMonad.Actions.Submap (submapDefaultWithKey)
{- $usage
This module implements Emacs-style prefix argument. The argument
comes in two flavours, "Raw" and "Numeric".
To initiate the "prefix mode" you hit the prefix keybinding (default
C-u). This sets the Raw argument value to 1. Repeatedly hitting this
key increments the raw value by 1. The Raw argument is usually used
as a toggle, changing the behaviour of the function called in some way.
An example might be calling "mpc add" to add new song to the playlist,
but with C-u we also clean up the playlist beforehand.
When in the "Raw mode", you can hit numeric keys 0..9 (with no
modifier) to enter a "Numeric argument". Numeric argument represents
a natural number. Hitting numeric keys in sequence produces the
decimal number that would result from typing them. That is, the
sequence C-u 4 2 sets the Numeric argument value to the number 42.
If you have a function which understands the prefix argument, for example:
> addMaybeClean :: PrefixArgument -> X ()
> addMaybeClean (Raw _) = spawn "mpc clear" >> spawn "mpc add <file>"
> addMaybeClean _ = spawn "mpc add <file>"
you can turn it into an X action with the function 'withPrefixArgument'.
Binding it in your config
> ((modm, xK_a), withPrefixArgument addMaybeClean)
Hitting MOD-a will add the <file> to the playlist while C-u MOD-a will
clear the playlist and then add the file.
You can of course use an anonymous action, like so:
> ((modm, xK_a), withPrefixArgument $ \prefix -> do
> case prefix of ...
> )
If the prefix key is followed by a binding which is unknown to XMonad,
the prefix along with that binding is sent to the active window.
There is one caveat: when you use an application which has a nested
C-u binding, for example C-c C-u in Emacs org-mode, you have to hit
C-g (or any other non-recognized key really) to get out of the "xmonad
grab" and let the C-c C-u be sent to the application.
-}
{- $installation
The simplest way to enable this is to use 'useDefaultPrefixArgument'
> xmonad $ useDefaultPrefixArgument $ defaultConfig { .. }
The default prefix argument is C-u. If you want to customize the
prefix argument, use the following:
> xmonad $ usePrefixArgument prefixKey $ defaultConfig { .. }
where 'prefixKey' is a function which takes 'XConfig' as an argument
in case you wish to extract the 'modMask'. An example
implementation is the following:
> prefixKey :: XConfig t -> (KeyMask, KeySym)
> prefixKey XConfig{modMask = modm} = (modm, xK_u)
-}
data PrefixArgument = Raw Int | Numeric Int | None
deriving (Typeable, Read, Show)
instance ExtensionClass PrefixArgument where
initialValue = None
extensionType = PersistentExtension
-- | Run 'job' in the 'X' monad and then execute 'cleanup'. In case
-- of exception, 'cleanup' is executed anyway.
--
-- Return the return value of 'job'.
finallyX :: X a -> X a -> X a
finallyX job cleanup = catchX (job >>= \r -> cleanup >> return r) cleanup
-- | Set Prefix up with custom configuration.
--
-- See usage section.
usePrefixArgument :: LayoutClass l Window
=> (XConfig Layout -> (KeyMask, KeySym))
-> XConfig l
-> XConfig l
usePrefixArgument prefix conf = conf {
keys = liftM2 M.union keys' (keys conf)
}
where keys' conf' =
let binding = prefix conf'
in M.singleton binding (handlePrefixArg [binding])
-- | Set Prefix up with default prefix key (C-u).
useDefaultPrefixArgument :: LayoutClass l Window
=> XConfig l
-> XConfig l
useDefaultPrefixArgument = usePrefixArgument (\_ -> (controlMask, xK_u))
handlePrefixArg :: [(KeyMask, KeySym)] -> X ()
handlePrefixArg events = do
ks <- asks keyActions
logger <- asks (logHook . config)
flip finallyX (XS.put None >> logger) $ do
prefix <- XS.get
case prefix of
Raw a -> XS.put $ Raw (a + 1)
None -> XS.put $ Raw 1
_ -> return ()
logger
submapDefaultWithKey defaultKey ks
where defaultKey key@(m, k) =
if k `elem` (xK_0 : [xK_1 .. xK_9]) && m == noModMask
then do
prefix <- XS.get
let x = fromJust (Prelude.lookup k keyToNum)
case prefix of
Raw _ -> XS.put $ Numeric x
Numeric a -> XS.put $ Numeric $ a * 10 + x
None -> return () -- should never happen
handlePrefixArg (key:events)
else do
prefix <- XS.get
mapM_ (uncurry sendKey) $ case prefix of
Raw a -> replicate a (head events) ++ [key]
_ -> reverse (key:events)
keyToNum = (xK_0, 0) : zip [xK_1 .. xK_9] [1..9]
-- | Turn a prefix-aware X action into an X-action.
--
-- First, fetch the current prefix, then pass it as argument to the
-- original function. You should use this to "run" your commands.
withPrefixArgument :: (PrefixArgument -> X ()) -> X ()
withPrefixArgument = (>>=) XS.get
-- | Test if 'PrefixArgument' is 'Raw' or not.
isPrefixRaw :: PrefixArgument -> Bool
isPrefixRaw (Raw _) = True
isPrefixRaw _ = False
-- | Test if 'PrefixArgument' is 'Numeric' or not.
isPrefixNumeric :: PrefixArgument -> Bool
isPrefixNumeric (Numeric _) = True
isPrefixNumeric _ = False
-- | Format the prefix using the Emacs convetion for use in a
-- statusbar, like xmobar.
--
-- To add this formatted prefix to printer output, you can set it up
-- like so
--
-- > myPrinter :: PP
-- > myPrinter = def { ppExtras = [ppFormatPrefix] }
--
-- And then in your 'logHook' configuration
--
-- > logHook = dynamicLogWithPP myPrinter
ppFormatPrefix :: X (Maybe String)
ppFormatPrefix = do
prefix <- XS.get
return $ case prefix of
Raw n -> Just $ foldr1 (\a b -> a ++ " " ++ b) $ replicate n "C-u"
Numeric n -> Just $ "C-u " ++ show n
None -> Nothing

3
XMonad/Actions/RandomBackground.hs
View File

@ -24,7 +24,6 @@ module XMonad.Actions.RandomBackground (
import XMonad(X, XConf(config), XConfig(terminal), io, spawn,
MonadIO, asks)
import System.Random
import Control.Monad(liftM)
import Numeric(showHex)
-- $usage
@ -55,7 +54,7 @@ randPermutation xs g = swap $ zip (randoms g) xs
-- | @randomBg'@ produces a random hex number in the form @'#xxyyzz'@
randomBg' :: (MonadIO m) => RandomColor -> m String
randomBg' (RGB l h) = io $ liftM (toHex . take 3 . randomRs (l,h)) newStdGen
randomBg' (RGB l h) = io $ fmap (toHex . take 3 . randomRs (l,h)) newStdGen
randomBg' (HSV s v) = io $ do
g <- newStdGen
let x = (^(2::Int)) $ fst $ randomR (0,sqrt $ pi / 3) g

163
XMonad/Actions/RotateSome.hs Normal file
View File

@ -0,0 +1,163 @@
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.RotateSome
-- Copyright : (c) 2020 Ivan Brennan <ivanbrennan@gmail.com>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Ivan Brennan <ivanbrennan@gmail.com>
-- Stability : stable
-- Portability : unportable
--
-- Functions for rotating some elements around the stack while keeping others
-- anchored in place. Useful in combination with layouts that dictate window
-- visibility based on stack position, such as "XMonad.Layout.LimitWindows".
--
-----------------------------------------------------------------------------
module XMonad.Actions.RotateSome (
-- * Usage
-- $usage
-- * Example
-- $example
surfaceNext,
surfacePrev,
rotateSome,
) where
import Control.Arrow ((***))
import Data.List (partition, sortOn, (\\))
import qualified Data.Map as M
import XMonad (Window, WindowSpace, Rectangle, X, runLayout, screenRect, windows, withWindowSet)
import XMonad.StackSet (Screen (Screen), Stack (Stack), current, floating, modify', stack)
{- $usage
You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
> import XMonad.Actions.RotateSome
and add keybindings such as the following:
> , ((modMask .|. controlMask, xK_n), surfaceNext)
> , ((modMask .|. controlMask, xK_p), surfacePrev)
-}
{- $example
#Example#
Consider a workspace whose stack contains five windows A B C D E but whose
layout limits how many will actually be shown, showing only the first plus
two additional windows, starting with the third:
> ┌─────┬─────┐
> │ │ C │
> │ A ├─────┤
> │ │ D │
> └─────┴─────┘
>
> A B C D E
> _ ____
If C has focus and we'd like to replace it with one of the unshown windows,
'surfaceNext' will move the next unshown window, E, into the focused position:
> ┌─────┬─────┐ ┌─────┬─────┐
> │ │ *C* │ │ │ *E* │
> │ A ├─────┤ surfaceNext -> │ A ├─────┤
> │ │ D │ │ │ D │
> └─────┴─────┘ └─────┴─────┘
>
> A B *C* D E A C *E* D B
> _ ____ _ ____
This repositioned windows B C E by treating them as a sequence that can be
rotated through the focused stack position. Windows A and D remain anchored
to their original (visible) positions.
A second call to 'surfaceNext' moves B into focus:
> ┌─────┬─────┐ ┌─────┬─────┐
> │ │ *E* │ │ │ *B* │
> │ A ├─────┤ surfaceNext -> │ A ├─────┤
> │ │ D │ │ │ D │
> └─────┴─────┘ └─────┴─────┘
>
> A C *E* D B A E *B* D C
> _ ____ _ ____
A third call would complete the cycle, bringing C back into focus.
-}
-- |
-- Treating the focused window and any unshown windows as a ring that can be
-- rotated through the focused position, surface the next element in the ring.
surfaceNext :: X ()
surfaceNext = do
ring <- surfaceRing
windows . modify' $ rotateSome (`elem` ring)
-- | Like 'surfaceNext' in reverse.
surfacePrev :: X ()
surfacePrev = do
ring <- surfaceRing
windows . modify' $ reverseStack . rotateSome (`elem` ring) . reverseStack
-- |
-- Return a list containing the current focus plus any unshown windows. Note
-- that windows are shown if 'runLayout' provides them with a rectangle or if
-- they are floating.
surfaceRing :: X [Window]
surfaceRing = withWindowSet $ \wset -> do
let Screen wsp _ sd = current wset
case stack wsp >>= filter' (`M.notMember` floating wset) of
Nothing -> pure []
Just st -> go st <$> layoutWindows wsp {stack = Just st} (screenRect sd)
where
go :: Stack Window -> [Window] -> [Window]
go (Stack t ls rs) shown = t : ((ls ++ rs) \\ shown)
layoutWindows :: WindowSpace -> Rectangle -> X [Window]
layoutWindows wsp rect = map fst . fst <$> runLayout wsp rect
-- | Like "XMonad.StackSet.filter" but won't move focus.
filter' :: (a -> Bool) -> Stack a -> Maybe (Stack a)
filter' p (Stack f ls rs)
| p f = Just $ Stack f (filter p ls) (filter p rs)
| otherwise = Nothing
-- |
-- @'rotateSome' p stack@ treats the elements of @stack@ that satisfy predicate
-- @p@ as a ring that can be rotated, while all other elements remain anchored
-- in place.
rotateSome :: (a -> Bool) -> Stack a -> Stack a
rotateSome p (Stack t ls rs) =
let
-- Flatten the stack, index each element relative to the focused position,
-- then partition into movable and anchored elements.
(movables, anchors) =
partition (p . snd) $
zip
[negate (length ls)..]
(reverse ls ++ t : rs)
-- Pair each movable element with the index of its next movable neighbor.
-- Append anchored elements, along with their unchanged indices, and sort
-- by index. Separate lefts (negative indices) from the rest, and grab the
-- new focus from the head of the remaining elements.
(ls', t':rs') =
(map snd *** map snd)
. span ((< 0) . fst)
. sortOn fst
. (++) anchors
. map (fst *** snd)
$ zip movables (rotate movables)
in
Stack t' (reverse ls') rs'
rotate :: [a] -> [a]
rotate = uncurry (flip (++)) . splitAt 1
reverseStack :: Stack a -> Stack a
reverseStack (Stack t ls rs) = Stack t rs ls

25
XMonad/Actions/Search.hs
View File

@ -18,6 +18,7 @@ module XMonad.Actions.Search ( -- * Usage
searchEngineF,
promptSearch,
promptSearchBrowser,
promptSearchBrowser',
selectSearch,
selectSearchBrowser,
isPrefixOf,
@ -35,6 +36,7 @@ module XMonad.Actions.Search ( -- * Usage
debbts,
debpts,
dictionary,
ebay,
google,
hackage,
hoogle,
@ -113,6 +115,8 @@ import XMonad.Util.XSelection (getSelection)
* 'dictionary' -- dictionary.reference.com search.
* 'ebay' -- Ebay keyword search.
* 'google' -- basic Google search.
* 'hackage' -- Hackage, the Haskell package database.
@ -191,7 +195,7 @@ Or in combination with XMonad.Util.EZConfig:
>
> searchList :: [(String, S.SearchEngine)]
> searchList = [ ("g", S.google)
> , ("h", S.hoohle)
> , ("h", S.hoogle)
> , ("w", S.wikipedia)
> ]
@ -281,7 +285,7 @@ searchEngineF :: Name -> Site -> SearchEngine
searchEngineF = SearchEngine
-- The engines.
amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle,
amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, google, hackage, hoogle,
images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, stackage, thesaurus, vocabulary, wayback, wikipedia, wiktionary,
youtube, duckduckgo :: SearchEngine
amazon = searchEngine "amazon" "http://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords="
@ -291,9 +295,10 @@ deb = searchEngine "deb" "http://packages.debian.org/"
debbts = searchEngine "debbts" "http://bugs.debian.org/"
debpts = searchEngine "debpts" "http://packages.qa.debian.org/"
dictionary = searchEngine "dict" "http://dictionary.reference.com/browse/"
ebay = searchEngine "ebay" "http://www.ebay.com/sch/i.html?_nkw="
google = searchEngine "google" "http://www.google.com/search?num=100&q="
hackage = searchEngine "hackage" "http://hackage.haskell.org/package/"
hoogle = searchEngine "hoogle" "http://www.haskell.org/hoogle/?q="
hoogle = searchEngine "hoogle" "http://hoogle.haskell.org/?hoogle="
images = searchEngine "images" "http://images.google.fr/images?q="
imdb = searchEngine "imdb" "http://www.imdb.com/find?s=all&q="
isohunt = searchEngine "isohunt" "http://isohunt.com/torrents/?ihq="
@ -312,7 +317,7 @@ vocabulary = searchEngine "vocabulary" "http://www.vocabulary.com/search?q
duckduckgo = searchEngine "duckduckgo" "https://duckduckgo.com/?t=lm&q="
multi :: SearchEngine
multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, (prefixAware google)]
multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, (prefixAware google)]
{- | This function wraps up a search engine and creates a new one, which works
like the argument, but goes directly to a URL if one is given rather than
@ -361,6 +366,18 @@ promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X ()
promptSearchBrowser config browser (SearchEngine name site) =
mkXPrompt (Search name) config (historyCompletionP ("Search [" `isPrefixOf`)) $ 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) =
mkXPrompt
(Search name)
config
(historyCompletionP (searchName `isPrefixOf`))
$ search browser site
where
searchName = showXPrompt (Search name)
{- | Like 'search', but in this case, the string is not specified but grabbed
from the user's response to a prompt. Example:

5
XMonad/Actions/ShowText.hs
View File

@ -17,7 +17,6 @@ module XMonad.Actions.ShowText
( -- * Usage
-- $usage
def
, defaultSTConfig
, handleTimerEvent
, flashText
, ShowTextConfig(..)
@ -80,10 +79,6 @@ instance Default ShowTextConfig where
, st_fg = "white"
}
{-# DEPRECATED defaultSTConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.ShowText) instead." #-}
defaultSTConfig :: ShowTextConfig
defaultSTConfig = def
-- | Handles timer events that notify when a window should be removed
handleTimerEvent :: Event -> X All
handleTimerEvent (ClientMessageEvent _ _ _ dis _ mtyp d) = do

57
XMonad/Actions/Sift.hs Normal file
View File

@ -0,0 +1,57 @@
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.Sift
-- Copyright : (c) 2020 Ivan Brennan <ivanbrennan@gmail.com>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Ivan Brennan <ivanbrennan@gmail.com>
-- Stability : stable
-- Portability : unportable
--
-- Functions for sifting windows up and down. Sifts behave identically to
-- swaps (i.e. 'swapUp' and 'swapDown' from "XMonad.StackSet"), except in
-- the wrapping case: rather than rotating the entire stack by one position
-- like a swap would, a sift causes the windows at either end of the stack
-- to trade positions.
--
-----------------------------------------------------------------------------
module XMonad.Actions.Sift (
-- * Usage
-- $usage
siftUp,
siftDown,
) where
import XMonad.StackSet (Stack (Stack), StackSet, modify')
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.Sift
--
-- and add keybindings such as the following:
--
-- > , ((modMask .|. shiftMask, xK_j ), windows siftDown)
-- > , ((modMask .|. shiftMask, xK_k ), windows siftUp )
--
-- |
-- siftUp, siftDown. Exchange the focused window with its neighbour in
-- the stack ordering, wrapping if we reach the end. Unlike 'swapUp' and
-- 'swapDown', wrapping is handled by trading positions with the window
-- at the other end of the stack.
--
siftUp, siftDown :: StackSet i l a s sd -> StackSet i l a s sd
siftUp = modify' siftUp'
siftDown = modify' (reverseStack . siftUp' . reverseStack)
siftUp' :: Stack a -> Stack a
siftUp' (Stack t (l:ls) rs) = Stack t ls (l:rs)
siftUp' (Stack t [] rs) =
case reverse rs of
(x:xs) -> Stack t (xs ++ [x]) []
[] -> Stack t [] []
reverseStack :: Stack a -> Stack a
reverseStack (Stack t ls rs) = Stack t rs ls

406
XMonad/Actions/SwapPromote.hs Normal file
View File

@ -0,0 +1,406 @@
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.SwapPromote
-- Copyright : (c) 2018 Yclept Nemo
-- License : BSD-style (see LICENSE)
--
-- Maintainer :
-- Stability : unstable
-- Portability : unportable
--
-- Module for tracking master window history per workspace, and associated
-- functions for manipulating the stack using such history.
--
-----------------------------------------------------------------------------
module XMonad.Actions.SwapPromote
( -- * Usage
-- $usage
MasterHistory (..)
-- * State Accessors
, getMasterHistoryMap
, getMasterHistoryFromTag
, getMasterHistoryCurrent
, getMasterHistoryFromWindow
, modifyMasterHistoryFromTag
, modifyMasterHistoryCurrent
-- * Log Hook
, masterHistoryHook
-- * Log Hook Building Blocks
, masterHistoryHook'
, updateMasterHistory
-- * Actions
, swapPromote
, swapPromote'
, swapIn
, swapIn'
, swapHybrid
, swapHybrid'
-- * Action Building Blocks
, swapApply
, swapPromoteStack
, swapInStack
, swapHybridStack
-- * List Utilities
, cycleN
, split
, split'
, merge
, merge'
-- * Stack Utilities
, stackSplit
, stackMerge
) where
import XMonad
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import qualified Data.Map as M
import qualified Data.Set as S
import Data.List
import Data.Maybe
import Control.Arrow
import Control.Monad
-- $usage
-- Given your configuration file, import this module:
--
-- > import XMonad.Actions.SwapPromote
--
-- First add 'masterHistoryHook' to your 'logHook' to track master windows per
-- workspace:
--
-- > myLogHook = otherHook >> masterHistoryHook
--
-- Then replace xmonad's default promote keybinding with 'swapPromote'':
--
-- > , ((mod1Mask, xK_Return), swapPromote' False)
--
-- Depending on your xmonad configuration or window actions the master history
-- may be empty. If this is the case you can still chain another promotion
-- function:
--
-- > import XMonad.Actions.DwmPromote
-- > , ((mod1Mask, xK_Return), whenX (swapPromote False) dwmpromote)
--
-- To be clear, this is only called when the lack of master history hindered
-- the swap and not other conditions, such as having a only a single window.
--
-- While 'swapPromote' preserves window focus, 'swapIn' preserves the focus
-- position - effectively "swapping" new windows into focus without moving the
-- zipper. A mix of both, 'swapHybrid' promotes focused non-master windows
-- while swapping windows into the focused master. This works well on layouts
-- with large masters. Both come with chainable variants, see 'swapIn'' and
-- 'swapHybrid''.
--
-- So far floating windows have been treated no differently than tiled windows
-- even though their positions are independent of the stack. Often, yanking
-- floating windows in and out of the workspace will obliterate the stack
-- history - particularly frustrating with 'XMonad.Util.Scratchpad' since it is
-- toggled so frequenty and always replaces the master window. That's why the
-- swap functions accept a boolean argument; when @True@ non-focused floating
-- windows will be ignored.
--
-- All together:
--
-- > , ((mod1Mask, xK_Return), whenX (swapHybrid True) dwmpromote)
-- | Mapping from workspace tag to master history list. The current master is
-- the head of the list, the previous master the second element, and so on.
-- Without history, the list is empty.
newtype MasterHistory = MasterHistory
{ getMasterHistory :: M.Map WorkspaceId [Window]
} deriving (Read,Show,Typeable)
instance ExtensionClass MasterHistory where
initialValue = MasterHistory M.empty
-- | Return the master history map from the state.
getMasterHistoryMap :: X (M.Map WorkspaceId [Window])
getMasterHistoryMap = XS.gets getMasterHistory
-- | Return the master history list of a given tag. The master history list may
-- be empty. An invalid tag will also result in an empty list.
getMasterHistoryFromTag :: WorkspaceId -> X [Window]
getMasterHistoryFromTag t = M.findWithDefault [] t <$> getMasterHistoryMap
-- | Return the master history list of the current workspace.
getMasterHistoryCurrent :: X [Window]
getMasterHistoryCurrent = gets (W.currentTag . windowset)
>>= getMasterHistoryFromTag
-- | Return the master history list of the workspace containing the given
-- window. Return an empty list if the window is not in the stackset.
getMasterHistoryFromWindow :: Window -> X [Window]
getMasterHistoryFromWindow w = gets (W.findTag w . windowset)
>>= maybe (return []) getMasterHistoryFromTag
-- | Modify the master history list of a given workspace, or the empty list of
-- no such workspace is mapped. The result is then re-inserted into the master
-- history map.
modifyMasterHistoryFromTag :: WorkspaceId -> ([Window] -> [Window]) -> X ()
modifyMasterHistoryFromTag t f = XS.modify $ \(MasterHistory m) ->
let l = M.findWithDefault [] t m
in MasterHistory $ M.insert t (f l) m
-- | Modify the master history list of the current workspace. While the current
-- workspace is guaranteed to exist; its master history may not. For more
-- information see 'modifyMasterHistoryFromTag'.
modifyMasterHistoryCurrent :: ([Window] -> [Window]) -> X ()
modifyMasterHistoryCurrent f = gets (W.currentTag . windowset)
>>= flip modifyMasterHistoryFromTag f
-- | A 'logHook' to update the master history mapping. Non-existent workspaces
-- are removed, and the master history list for the current workspaces is
-- updated. See 'masterHistoryHook''.
masterHistoryHook :: X ()
masterHistoryHook = masterHistoryHook' True updateMasterHistory
-- | Backend for 'masterHistoryHook'.
masterHistoryHook' :: Bool
-- ^ If @True@, remove non-existent workspaces.
-> ([Window] -> [Window] -> [Window])
-- ^ Function used to update the master history list of
-- the current workspace. First argument is the master
-- history, second is the integrated stack. See
-- 'updateMasterHistory' for more details.
-> X ()
masterHistoryHook' removeWorkspaces historyModifier = do
wset <- gets windowset
let W.Workspace wid _ mst = W.workspace . W.current $ wset
tags = map W.tag $ W.workspaces wset
st = W.integrate' mst
XS.modify $ \(MasterHistory mm) ->
let mm' = if removeWorkspaces
then restrictKeys mm $ S.fromList tags
else mm
ms = M.findWithDefault [] wid mm'
ms' = historyModifier ms st
in MasterHistory $ M.insert wid ms' mm'
-- | Less efficient version of 'M.restrictKeys'. Given broader eventual
-- adoption, replace this with 'M.restrictKeys'.
restrictKeys :: Ord k => M.Map k a -> S.Set k -> M.Map k a
restrictKeys m s = M.filterWithKey (\k _ -> k `S.member` s) m
-- | Given the current master history list and an integrated stack, return the
-- new master history list. The current master is either moved (if it exists
-- within the history) or added to the head of the list, and all missing (i.e.
-- closed) windows are removed.
updateMasterHistory :: [Window] -- ^ The master history list.
-> [Window] -- ^ The integrated stack.
-> [Window]
updateMasterHistory _ [] = []
updateMasterHistory ms ws@(w:_) = (w : delete w ms) `intersect` ws
-- | Wrap 'swapPromoteStack'; see also 'swapApply'.
swapPromote :: Bool -> X Bool
swapPromote = flip swapApply swapPromoteStack
-- | Like 'swapPromote'' but discard the result.
swapPromote' :: Bool -> X ()
swapPromote' = void . swapPromote
-- | Wrap 'swapInStack'; see also 'swapApply'.
swapIn :: Bool -> X Bool
swapIn = flip swapApply swapInStack
-- | Like 'swapIn'' but discard the result.
swapIn' :: Bool -> X ()
swapIn' = void . swapIn
-- | Wrap 'swapHybridStack'; see also 'swapApply'.
swapHybrid :: Bool -> X Bool
swapHybrid = flip swapApply swapHybridStack
-- | Like 'swapHybrid'' but discard the result.
swapHybrid' :: Bool -> X ()
swapHybrid' = void . swapHybrid
-- | Apply the given master history stack modifier to the current stack. If
-- given @True@, all non-focused floating windows will be ignored. Return
-- @True@ if insufficient history; if so use 'whenX' to sequence a backup
-- promotion function.
swapApply :: Bool
-> (Maybe Window -> W.Stack Window -> (Bool,W.Stack Window))
-> X Bool
swapApply ignoreFloats swapFunction = do
fl <- gets $ W.floating . windowset
st <- gets $ W.stack . W.workspace . W.current . windowset
ch <- getMasterHistoryCurrent
let swapApply' s1 =
let fl' = if ignoreFloats then M.keysSet fl else S.empty
ff = (||) <$> (`S.notMember` fl') <*> (== W.focus s1)
fh = filter ff ch
pm = listToMaybe . drop 1 $ fh
(r,s2) = stackSplit s1 fl' :: ([(Int,Window)],W.Stack Window)
(b,s3) = swapFunction pm s2
s4 = stackMerge s3 r
mh = let w = head . W.integrate $ s3
in const $ w : delete w ch
in (b,Just s4,mh)
(x,y,z) = maybe (False,Nothing,id) swapApply' st
-- Any floating master windows will be added to the history when 'windows'
-- calls the log hook.
modifyMasterHistoryCurrent z
windows $ W.modify Nothing . const $ y
return x
-- | If the focused window is the master window and there is no previous
-- master, do nothing. Otherwise swap the master with the previous master. If
-- the focused window is not the master window, swap it with the master window.
-- In either case focus follows the original window, i.e. the focused window
-- does not change, only its position.
--
-- The first argument is the previous master (which may not exist), the second
-- a window stack. Return @True@ if the master history hindered the swap; the
-- history is either empty or out-of-sync. Though the latter shouldn't happen
-- this function never changes the stack under such circumstances.
swapPromoteStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
swapPromoteStack _ st@(W.Stack _x [] []) = (False,st)
swapPromoteStack Nothing st@(W.Stack _x [] _r) = (True,st)
swapPromoteStack (Just pm) (W.Stack x [] r) =
let (r',l') = (reverse *** cycleN 1) $ span (/= pm) $ reverse r
st' = W.Stack x l' r'
b = null l'
in (b,st')
swapPromoteStack _ (W.Stack x l r) =
let r' = (++ r) . cycleN 1 . reverse $ l
st' = W.Stack x [] r'
in (False,st')
-- | Perform the same swap as 'swapPromoteStack'. However the new window
-- receives the focus; it appears to "swap into" the position of the original
-- window. Under this model focus follows stack position and the zipper does
-- not move.
--
-- See 'swapPromoteStack' for more details regarding the parameters.
swapInStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
swapInStack _ st@(W.Stack _x [] []) = (False,st)
swapInStack Nothing st@(W.Stack _x [] _r) = (True,st)
swapInStack (Just pm) (W.Stack x [] r) =
let (x',r') = case span (/= pm) r of
(__,[]) -> (x,r)
(sl,sr) -> (pm,sl ++ x : drop 1 sr)
st' = W.Stack x' [] r'
b = x' == x
in (b,st')
swapInStack _ (W.Stack x l r) =
let l' = init l ++ [x]
x' = last l
st' = W.Stack x' l' r
in (False,st')
-- | If the focused window is the master window, use 'swapInStack'. Otherwise use
-- 'swapPromoteStack'.
--
-- See 'swapPromoteStack' for more details regarding the parameters.
swapHybridStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
swapHybridStack m st@(W.Stack _ [] _) = swapInStack m st
swapHybridStack m st = swapPromoteStack m st
-- | Cycle a list by the given count. If positive, cycle to the left. If
-- negative, cycle to the right:
--
-- >>> cycleN 2 [1,2,3,4,5]
-- [3,4,5,1,2]
-- >>> cycleN (-2) [1,2,3,4,5]
-- [4,5,1,2,3]
cycleN :: Int -> [a] -> [a]
cycleN n ls =
let l = length ls
in take l $ drop (n `mod` l) $ cycle ls
-- | Wrap 'split'' with an initial index of @0@, discarding the list's length.
split :: (Num a, Enum a) => (b -> Bool) -> [b] -> ([(a,b)],[b])
split p l =
let (_,ys,ns) = split' p 0 l
in (ys,ns)
-- | Given a predicate, an initial index and a list, return a tuple containing:
--
-- * List length.
-- * Indexed list of elements which satisfy the predicate. An indexed element
-- is a tuple containing the element index (offset by the initial index) and
-- the element.
-- * List of elements which do not satisfy the predicate.
--
-- The initial index and length of the list simplify chaining calls to this
-- function, such as for zippers of lists.
split' :: (Num a, Enum a) => (b -> Bool) -> a -> [b] -> (a,[(a,b)],[b])
split' p i l =
let accumulate e (c,ys,ns) = if p (snd e)
then (c+1,e:ys,ns)
else (c+1,ys,e:ns)
(c',ys',ns') = foldr accumulate (0,[],[]) $ zip [i..] l
in (c',ys',snd . unzip $ ns')
-- | Wrap 'merge'' with an initial virtual index of @0@. Return only the
-- unindexed list with elements from the leftover indexed list appended.
merge :: (Ord a, Num a) => [(a,b)] -> [b] -> [b]
merge il ul =
let (_,il',ul') = merge' 0 il ul
in ul' ++ map snd il'
-- | Inverse of 'split'. Merge an indexed list with an unindexed list (see
-- 'split''). Given a virtual index, an indexed list and an unindexed list,
-- return a tuple containing:
--
-- * Virtual index /after/ the unindexed list
-- * Remainder of the indexed list
-- * Merged unindexed list
--
-- If the indexed list is empty, this functions consumes the entire unindexed
-- list. If the unindexed list is empty, this function consumes only adjacent
-- indexed elements. For example, @[(10,"ten"),(12,"twelve")]@ implies missing
-- unindexed elements and so once @(10,"ten")@ is consumed this function
-- concludes.
--
-- The indexed list is assumed to have been created by 'split'' and not checked
-- for correctness. Indices are assumed to be ascending, i.e.
-- > [(1,"one"),(2,"two"),(4,"four")]
--
-- The initial and final virtual indices simplify chaining calls to the this
-- function, as as for zippers of lists. Positive values shift the unindexed
-- list towards the tail, as if preceded by that many elements.
merge' :: (Ord a, Num a) => a -> [(a,b)] -> [b] -> (a,[(a,b)],[b])
merge' i il@((j,a):ps) ul@(b:bs) = if j <= i
then let (x,y,z) = merge' (i+1) ps ul
in (x,y,a:z)
else let (x,y,z) = merge' (i+1) il bs
in (x,y,b:z)
merge' i [] (b:bs) =
let (x,y,z) = merge' (i+1) [] bs
in (x,y,b:z)
merge' i il@((j,a):ps) [] = if j <= i
then let (x,y,z) = merge' (i+1) ps []
in (x,y,a:z)
else (i,il,[])
merge' i [] [] =
(i,[],[])
-- | Remove all elements of the set from the stack. Skip the currently focused
-- member. Return an indexed list of excluded elements and the modified stack.
-- Use 'stackMerge' to re-insert the elements using this list.
stackSplit :: (Num a, Enum a, Ord b) => W.Stack b -> S.Set b -> ([(a,b)],W.Stack b)
stackSplit (W.Stack x l r) s =
let (c,fl,tl) = split' (`S.member` s) 0 (reverse l)
(_,fr,tr) = split' (`S.member` s) (c+1) r
in (fl++fr,W.Stack x (reverse tl) tr)
-- | Inverse of 'stackSplit'. Given a list of elements and their original
-- indices, re-insert the elements into these same positions within the stack.
-- Skip the currently focused member. Works best if the stack's length hasn't
-- changed, though if shorter any leftover elements will be tacked on.
stackMerge :: (Ord a, Num a) => W.Stack b -> [(a,b)] -> W.Stack b
stackMerge (W.Stack x l r) il =
let (i,il1,l') = merge' 0 il (reverse l)
(_,il2,r') = merge' (i+1) il1 r
in W.Stack x (reverse l') (r' ++ map snd il2)

6
XMonad/Actions/TagWindows.hs
View File

@ -89,7 +89,7 @@ getTags w = withDisplay $ \d ->
-- | check a window for the given tag
hasTag :: String -> Window -> X Bool
hasTag s w = (s `elem`) `fmap` getTags w
hasTag s w = (s `elem`) <$> getTags w
-- | add a tag to the existing ones
addTag :: String -> Window -> X ()
@ -180,7 +180,7 @@ instance XPrompt TagPrompt where
tagPrompt :: XPConfig -> (String -> X ()) -> X ()
tagPrompt c f = do
sc <- tagComplList
mkXPrompt TagPrompt c (mkComplFunFromList' sc) f
mkXPrompt TagPrompt c (mkComplFunFromList' c sc) f
tagComplList :: X [String]
tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>=
@ -192,7 +192,7 @@ tagDelPrompt :: XPConfig -> X ()
tagDelPrompt c = do
sc <- tagDelComplList
if (sc /= [])
then mkXPrompt TagPrompt c (mkComplFunFromList' sc) (\s -> withFocused (delTag s))
then mkXPrompt TagPrompt c (mkComplFunFromList' c sc) (\s -> withFocused (delTag s))
else return ()
tagDelComplList :: X [String]

101
XMonad/Actions/TiledWindowDragging.hs Normal file
View File

@ -0,0 +1,101 @@
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.TiledWindowDragging
-- Copyright : (c) 2020 Leon Kowarschick
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Leon Kowarschick. <thereal.elkowar@gmail.com>
-- Stability : unstable
-- Portability : unportable
--
-- Provides an action that allows you to change the position of windows by dragging them around.
--
-----------------------------------------------------------------------------
module XMonad.Actions.TiledWindowDragging
(
-- * Usage
-- $usage
dragWindow
)
where
import XMonad
import qualified XMonad.StackSet as W
import XMonad.Layout.DraggingVisualizer
import Control.Monad
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.TiledWindowDragging
-- > import XMonad.Layout.DraggingVisualizer
--
-- then edit your 'layoutHook' by adding the draggingVisualizer to your layout:
--
-- > myLayout = draggingVisualizer $ layoutHook def
--
-- Then add a mouse binding for 'dragWindow':
--
-- > , ((modMask .|. shiftMask, button1), dragWindow)
--
-- For detailed instructions on editing your mouse bindings, see
-- "XMonad.Doc.Extending#Editing_mouse_bindings".
-- | Create a mouse binding for this to be able to drag your windows around.
-- You need "XMonad.Layout.DraggingVisualizer" for this to look good.
dragWindow :: Window -> X ()
dragWindow window = whenX (isClient window) $ do
focus window
(offsetX, offsetY) <- getPointerOffset window
(winX, winY, winWidth, winHeight) <- getWindowPlacement window
mouseDrag
(\posX posY ->
let rect = Rectangle (fInt (fInt winX + (posX - fInt offsetX)))
(fInt (fInt winY + (posY - fInt offsetY)))
(fInt winWidth)
(fInt winHeight)
in sendMessage $ DraggingWindow window rect
)
(sendMessage DraggingStopped >> performWindowSwitching window)
-- | get the pointer offset relative to the given windows root coordinates
getPointerOffset :: Window -> X (Int, Int)
getPointerOffset win = do
(_, _, _, oX, oY, _, _, _) <- withDisplay (\d -> io $ queryPointer d win)
return (fInt oX, fInt oY)
-- | return a tuple of windowX, windowY, windowWidth, windowHeight
getWindowPlacement :: Window -> X (Int, Int, Int, Int)
getWindowPlacement window = do
wa <- withDisplay (\d -> io $ getWindowAttributes d window)
return (fInt $ wa_x wa, fInt $ wa_y wa, fInt $ wa_width wa, fInt $ wa_height wa)
performWindowSwitching :: Window -> X ()
performWindowSwitching win = do
root <- asks theRoot
(_, _, selWin, _, _, _, _, _) <- withDisplay (\d -> io $ queryPointer d root)
ws <- gets windowset
let allWindows = W.index ws
when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do
let allWindowsSwitched = map (switchEntries win selWin) allWindows
let (ls, t : rs) = break (== win) allWindowsSwitched
let newStack = W.Stack t (reverse ls) rs
windows $ W.modify' $ const newStack
where
switchEntries a b x | x == a = b
| x == b = a
| otherwise = x
-- | shorthand for fromIntegral
fInt :: Integral a => Integral b => a -> b
fInt = fromIntegral

337
XMonad/Actions/TopicSpace.hs
View File

@ -1,4 +1,3 @@
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.TopicSpace
@ -19,21 +18,40 @@ module XMonad.Actions.TopicSpace
-- * Usage
-- $usage
Topic
-- * Types for Building Topics
Topic
, Dir
, TopicConfig(..)
-- * Default Topic Config
, def
, defaultTopicConfig
, getLastFocusedTopics
, setLastFocusedTopic
, reverseLastFocusedTopics
, pprWindowSet
-- * Switching and Shifting Topics
, switchTopic
, switchTopicWith
, switchNthLastFocused
, switchNthLastFocusedByScreen
, switchNthLastFocusedExclude
, shiftNthLastFocused
-- * Topic Actions
, topicActionWithPrompt
, topicAction
, currentTopicAction
, switchTopic
, switchNthLastFocused
, shiftNthLastFocused
-- * Getting the Topic History
, getLastFocusedTopics
, getLastFocusedTopicsByScreen
-- * Modifying the Topic History
, setLastFocusedTopic
, reverseLastFocusedTopics
-- * Pretty Printing
, pprWindowSet
-- * Utility
, currentTopicDir
, checkTopicConfig
, (>*>)
@ -42,24 +60,28 @@ where
import XMonad
import Data.List
import Data.Maybe (fromMaybe, isNothing, listToMaybe, fromJust)
import Data.Ord
import qualified Data.Map as M
import Control.Monad (liftM2,when,unless,replicateM_)
import System.IO
import qualified XMonad.StackSet as W
import XMonad.Prompt
import XMonad.Prompt.Workspace
import XMonad.Hooks.UrgencyHook
import XMonad.Hooks.DynamicLog (PP(..))
import qualified Data.Map as M
import qualified XMonad.Hooks.DynamicLog as DL
import qualified XMonad.StackSet as W
import Control.Applicative (liftA2)
import Control.Monad (replicateM_, unless, when)
import Data.List ((\\), elemIndex, nub, sort, sortOn)
import Data.Maybe (fromJust, fromMaybe, isNothing, listToMaybe)
import System.IO (hClose, hPutStr)
import XMonad.Prompt (XPConfig)
import XMonad.Prompt.Workspace (workspacePrompt)
import XMonad.Hooks.DynamicLog (PP(ppHidden, ppVisible))
import XMonad.Hooks.UrgencyHook (readUrgents)
import XMonad.Hooks.WorkspaceHistory
( workspaceHistory
, workspaceHistoryByScreen
, workspaceHistoryModify
)
import XMonad.Util.Run (spawnPipe)
import qualified XMonad.Util.ExtensibleState as XS
-- $overview
-- This module allows to organize your workspaces on a precise topic basis. So
@ -75,7 +97,23 @@ import qualified XMonad.Util.ExtensibleState as XS
-- of last focused topics.
-- $usage
-- Here is an example of configuration using TopicSpace:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import qualified Data.Map as M
-- > import qualified XMonad.StackSet as W
-- >
-- > import XMonad.Actions.TopicSpace
--
-- You will then have to
--
-- * Define new a new 'TopicConfig'
--
-- * Add the appropriate keybindings
--
-- * Replace the @workspaces@ field in your 'XConfig' with a list of your
-- topics names
--
-- Let us go through a full example together. Given the following topic names
--
-- > -- The list of all topics/workspaces of your xmonad configuration.
-- > -- The order is important, new topics must be inserted
@ -88,7 +126,9 @@ import qualified XMonad.Util.ExtensibleState as XS
-- > , "mail", "movie", "music", "talk", "text", "tools", "web", "xmonad"
-- > , "yi", "documents", "twitter", "pdf"
-- > ]
-- >
--
-- we can define a 'TopicConfig' like this
--
-- > myTopicConfig :: TopicConfig
-- > myTopicConfig = def
-- > { topicDirs = M.fromList $
@ -131,25 +171,22 @@ import qualified XMonad.Util.ExtensibleState as XS
-- > , ("pdf", spawn pdfViewerCmd)
-- > ]
-- > }
-- >
-- > -- extend your keybindings
-- > myKeys conf@XConfig{modMask=modm} =
-- > [ ((modm , xK_n ), spawnShell) -- %! Launch terminal
-- > , ((modm , xK_a ), currentTopicAction myTopicConfig)
-- > , ((modm , xK_g ), promptedGoto)
-- > , ((modm .|. shiftMask, xK_g ), promptedShift)
-- > {- more keys ... -}
-- > ]
-- > ++
-- > [ ((modm, k), switchNthLastFocused myTopicConfig i)
-- > | (i, k) <- zip [1..] workspaceKeys]
-- >
--
-- Above we have used the `spawnShell` and `spawnShellIn` helper functions; here
-- they are:
--
-- > spawnShell :: X ()
-- > spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
-- >
-- > spawnShellIn :: Dir -> X ()
-- > spawnShellIn dir = spawn $ "urxvt '(cd ''" ++ dir ++ "'' && " ++ myShell ++ " )'"
-- >
-- > -- Some terminals support a working-directory option directly:
-- > -- spawnShellIn dir = spawn $ "alacritty --working-directory " ++ dir
--
-- Next, we define some other other useful helper functions. Note that some of
-- these function make use of the 'workspacePrompt' function. You will also
-- have to have an already defined 'XPConfig' (here called @myXPConfig@).
--
-- > goto :: Topic -> X ()
-- > goto = switchTopic myTopicConfig
-- >
@ -159,22 +196,51 @@ import qualified XMonad.Util.ExtensibleState as XS
-- > promptedShift :: X ()
-- > promptedShift = workspacePrompt myXPConfig $ windows . W.shift
-- >
-- > -- Toggle between the two most recently used topics while filtering
-- > -- out the scratchpad topic.
-- > toggleTopic :: X ()
-- > toggleTopic = switchNthLastFocusedExclude ["NSP"] myTopicConfig 1
--
-- Hopefully you've gotten a general feeling of how to define these kind of
-- small helper functions using what's provided in this module.
--
-- Adding the appropriate keybindings works as it normally would:
--
-- > -- extend your keybindings
-- > myKeys conf@XConfig{modMask=modm} =
-- > [ ((modm , xK_n ), spawnShell) -- %! Launch terminal
-- > , ((modm , xK_a ), currentTopicAction myTopicConfig)
-- > , ((modm , xK_g ), promptedGoto)
-- > , ((modm .|. shiftMask, xK_g ), promptedShift)
-- > , ((modm .|. shiftMask, xK_space ), toggleTopic)
-- > {- more keys ... -}
-- > ]
-- > ++
-- > -- Switching to recently used topics
-- > [ ((modm, k), switchNthLastFocused myTopicConfig i)
-- > | (i, k) <- zip [1..] workspaceKeys]
--
-- If you want a more "default" experience with regards to @M-1@ through @M-9@
-- (i.e. switch to the first nine topics in `myTopics` instead of switching to
-- the last used ones), you can replace the last list above with the following
-- (using "EZConfig" syntax):
--
-- > -- The following does two things:
-- > -- 1. Switch topics (no modifier)
-- > -- 2. Move focused window to topic N (shift modifier)
-- > [ ("M-" ++ m ++ k, f i)
-- > | (i, k) <- zip myTopics (map show [1 .. 9 :: Int])
-- > , (f, m) <- [(goto, ""), (windows . W.shift, "S-")]
-- > ]
--
-- We can now put the whole configuration together with the following (while
-- also checking that we haven't made any mistakes):
--
-- > myConfig = do
-- > checkTopicConfig myTopics myTopicConfig
-- > myLogHook <- makeMyLogHook
-- > return $ def
-- > { borderWidth = 1 -- Width of the window border in pixels.
-- > , workspaces = myTopics
-- > , layoutHook = myModifiers myLayout
-- > , manageHook = myManageHook
-- > , logHook = myLogHook
-- > , handleEventHook = myHandleEventHook
-- > , terminal = myTerminal -- The preferred terminal program.
-- > , normalBorderColor = "#3f3c6d"
-- > , focusedBorderColor = "#4f66ff"
-- > , XMonad.modMask = mod1Mask
-- > , keys = myKeys
-- > , mouseBindings = myMouseBindings
-- > { workspaces = myTopics
-- > , keys = myKeys
-- > }
-- >
-- > main :: IO ()
@ -188,85 +254,80 @@ infix >*>
-- | 'Topic' is just an alias for 'WorkspaceId'
type Topic = WorkspaceId
-- | 'Dir' is just an alias for 'FilePath' but should points to a directory.
-- | 'Dir' is just an alias for 'FilePath', but should point to a directory.
type Dir = FilePath
-- | Here is the topic space configuration area.
data TopicConfig = TopicConfig { topicDirs :: M.Map Topic Dir
-- ^ This mapping associate a directory to each topic.
-- ^ This mapping associates a directory to each topic.
, topicActions :: M.Map Topic (X ())
-- ^ This mapping associate an action to trigger when
-- ^ This mapping associates an action to trigger when
-- switching to a given topic which workspace is empty.
, defaultTopicAction :: Topic -> X ()
-- ^ This is the default topic action.
, defaultTopic :: Topic
-- ^ This is the default topic.
-- ^ This is the default (= fallback) topic.
, maxTopicHistory :: Int
-- ^ This setups the maximum depth of topic history, usually
-- 10 is a good default since we can bind all of them using
-- numeric keypad.
-- ^ This specifies the maximum depth of the topic history;
-- usually 10 is a good default since we can bind all of
-- them using numeric keypad.
}
instance Default TopicConfig where
def = TopicConfig { topicDirs = M.empty
, topicActions = M.empty
, defaultTopicAction = const (ask >>= spawn . terminal . config)
, defaultTopic = "1"
, maxTopicHistory = 10
}
def = TopicConfig { topicDirs = M.empty
, topicActions = M.empty
, defaultTopicAction = const (ask >>= spawn . terminal . config)
, defaultTopic = "1"
, maxTopicHistory = 10
}
{-# DEPRECATED defaultTopicConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.TopicSpace) instead." #-}
defaultTopicConfig :: TopicConfig
defaultTopicConfig = def
-- | Return the (possibly empty) list of last focused topics.
getLastFocusedTopics :: X [Topic]
getLastFocusedTopics = workspaceHistory
newtype PrevTopics = PrevTopics { getPrevTopics :: [String] } deriving (Read,Show,Typeable)
instance ExtensionClass PrevTopics where
initialValue = PrevTopics []
extensionType = PersistentExtension
-- | Like 'getLastFocusedTopics', but group the topics by their screen-id's.
getLastFocusedTopicsByScreen :: X [(ScreenId, [Topic])]
getLastFocusedTopicsByScreen = workspaceHistoryByScreen
-- | Returns the list of last focused workspaces the empty list otherwise.
getLastFocusedTopics :: X [String]
getLastFocusedTopics = XS.gets getPrevTopics
-- | Given a 'TopicConfig', the last focused topic, and a predicate that will
-- select topics that one want to keep, this function will set the property
-- of last focused topics.
setLastFocusedTopic :: Topic -> (Topic -> Bool) -> X ()
setLastFocusedTopic w predicate =
XS.modify $ PrevTopics
. seqList . nub . (w:) . filter predicate
. getPrevTopics
where seqList xs = length xs `seq` xs
-- | Given a 'TopicConfig', a topic, and a predicate to select topics that one
-- wants to keep, this function will cons the topic in front of the list of
-- last focused topics and filter it according to the predicate. Note that we
-- prune the list in case that its length exceeds 'maxTopicHistory'.
setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X ()
setLastFocusedTopic tc w predicate = do
sid <- gets $ W.screen . W.current . windowset
workspaceHistoryModify $
take (maxTopicHistory tc) . nub . filter (predicate . snd) . ((sid, w) :)
-- | Reverse the list of "last focused topics"
reverseLastFocusedTopics :: X ()
reverseLastFocusedTopics =
XS.modify $ PrevTopics . reverse . getPrevTopics
reverseLastFocusedTopics = workspaceHistoryModify reverse
-- | This function is a variant of 'DL.pprWindowSet' which takes a topic configuration
-- and a pretty-printing record 'PP'. It will show the list of topics sorted historically
-- and highlighting topics with urgent windows.
-- and highlight topics with urgent windows.
pprWindowSet :: TopicConfig -> PP -> X String
pprWindowSet tg pp = do
winset <- gets windowset
urgents <- readUrgents
let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset
maxDepth = maxTopicHistory tg
setLastFocusedTopic (W.tag . W.workspace . W.current $ winset)
(`notElem` empty_workspaces)
lastWs <- getLastFocusedTopics
let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic])
add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic
pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }
sortWindows = take maxDepth . sortBy (comparing $ depth . W.tag)
return $ DL.pprWindowSet sortWindows urgents pp' winset
winset <- gets windowset
urgents <- readUrgents
let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset
maxDepth = maxTopicHistory tg
setLastFocusedTopic tg
(W.tag . W.workspace . W.current $ winset)
(`notElem` empty_workspaces)
lastWs <- getLastFocusedTopics
let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic])
add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic
pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }
sortWindows = take maxDepth . sortOn (depth . W.tag)
return $ DL.pprWindowSet sortWindows urgents pp' winset
-- | Given a prompt configuration and a topic configuration, triggers the action associated with
-- | Given a prompt configuration and a topic configuration, trigger the action associated with
-- the topic given in prompt.
topicActionWithPrompt :: XPConfig -> TopicConfig -> X ()
topicActionWithPrompt xp tg = workspacePrompt xp (liftM2 (>>) (switchTopic tg) (topicAction tg))
topicActionWithPrompt xp tg = workspacePrompt xp (liftA2 (>>) (switchTopic tg) (topicAction tg))
-- | Given a configuration and a topic, triggers the action associated with the given topic.
-- | Given a configuration and a topic, trigger the action associated with the given topic.
topicAction :: TopicConfig -> Topic -> X ()
topicAction tg topic = fromMaybe (defaultTopicAction tg topic) $ M.lookup topic $ topicActions tg
@ -276,42 +337,74 @@ currentTopicAction tg = topicAction tg =<< gets (W.tag . W.workspace . W.current
-- | Switch to the given topic.
switchTopic :: TopicConfig -> Topic -> X ()
switchTopic tg topic = do
switchTopic = switchTopicWith (const True)
-- | Like 'switchTopic', but give a custom filtering function to
-- 'setLastFocusedTopic'.
switchTopicWith :: (Topic -> Bool) -> TopicConfig -> Topic -> X ()
switchTopicWith predicate tg topic = do
-- Switch to topic and add it to the last seen topics
windows $ W.greedyView topic
setLastFocusedTopic tg topic predicate
-- If applicable, execute the topic action
wins <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset)
when (null wins) $ topicAction tg topic
-- | Switch to the Nth last focused topic or failback to the 'defaultTopic'.
-- | Switch to the Nth last focused topic or fall back to the 'defaultTopic'.
switchNthLastFocused :: TopicConfig -> Int -> X ()
switchNthLastFocused tg depth = do
lastWs <- getLastFocusedTopics
switchTopic tg $ (lastWs ++ repeat (defaultTopic tg)) !! depth
switchNthLastFocused = switchNthLastFocusedExclude []
-- | Shift the focused window to the Nth last focused topic, or fallback to doing nothing.
-- | Like 'switchNthLastFocused', but also filter out certain topics.
switchNthLastFocusedExclude :: [Topic] -> TopicConfig -> Int -> X ()
switchNthLastFocusedExclude excludes tc depth = do
lastWs <- filter (`notElem` excludes) <$> getLastFocusedTopics
switchTopic tc $ (lastWs ++ repeat (defaultTopic tc)) !! depth
-- | Like 'switchNthLastFocused', but only consider topics that used to
-- be on the current screen.
--
-- For example, the following function allows one to toggle between the
-- currently focused and the last used topic, while treating different
-- screens completely independently from one another.
--
-- > toggleTopicScreen = switchNthLastFocusedByScreen myTopicConfig 1
switchNthLastFocusedByScreen :: TopicConfig -> Int -> X ()
switchNthLastFocusedByScreen tc depth = do
sid <- gets $ W.screen . W.current . windowset
sws <- fromMaybe []
. listToMaybe
. map snd
. filter ((== sid) . fst)
<$> getLastFocusedTopicsByScreen
switchTopic tc $ (sws ++ repeat (defaultTopic tc)) !! depth
-- | Shift the focused window to the Nth last focused topic, or fall back to doing nothing.
shiftNthLastFocused :: Int -> X ()
shiftNthLastFocused n = do
ws <- fmap (listToMaybe . drop n) getLastFocusedTopics
whenJust ws $ windows . W.shift
-- | Returns the directory associated with current topic returns the empty string otherwise.
currentTopicDir :: TopicConfig -> X String
-- | Return the directory associated with the current topic, or return the empty
-- string if the topic could not be found.
currentTopicDir :: TopicConfig -> X FilePath
currentTopicDir tg = do
topic <- gets (W.tag . W.workspace . W.current . windowset)
return . fromMaybe "" . M.lookup topic $ topicDirs tg
-- | Check the given topic configuration for duplicates topics or undefined topics.
-- | Check the given topic configuration for duplicate or undefined topics.
checkTopicConfig :: [Topic] -> TopicConfig -> IO ()
checkTopicConfig tags tg = do
-- tags <- gets $ map W.tag . workspaces . windowset
-- tags <- gets $ map W.tag . workspaces . windowset
let
seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)
dups = tags \\ nub tags
diffTopic = seenTopics \\ sort tags
check lst msg = unless (null lst) $ xmessage $ msg ++ " (tags): " ++ show lst
let
seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)
dups = tags \\ nub tags
diffTopic = seenTopics \\ sort tags
check lst msg = unless (null lst) $ xmessage $ msg ++ " (tags): " ++ show lst
check diffTopic "Seen but missing topics/workspaces"
check dups "Duplicate topics/workspaces"
check diffTopic "Seen but missing topics/workspaces"
check dups "Duplicate topics/workspaces"
-- | Display the given message using the @xmessage@ program.
xmessage :: String -> IO ()

2
XMonad/Actions/TreeSelect.hs
View File

@ -599,7 +599,7 @@ drawNode ix iy TSNode{..} col = do
colormap <- gets tss_colormap
visual <- gets tss_visual
liftIO $ drawWinBox window display visual colormap gc font col tsn_name ts_extra tsn_extra
(ix * ts_indent) (iy * ts_node_height)
(ix * ts_indent + ts_originX) (iy * ts_node_height + ts_originY)
ts_node_width ts_node_height
-- TODO: draw extra text (transparent background? or ts_background)

17
XMonad/Actions/WindowBringer.hs
View File

@ -21,17 +21,16 @@ module XMonad.Actions.WindowBringer (
WindowBringerConfig(..),
gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs',
bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs',
windowMap, windowMap', bringWindow, actionMenu
windowMap, windowAppMap, windowMap', bringWindow, actionMenu
) where
import Control.Applicative((<$>))
import qualified Data.Map as M
import qualified XMonad.StackSet as W
import XMonad
import qualified XMonad as X
import XMonad.Util.Dmenu (menuMapArgs)
import XMonad.Util.NamedWindows (getName)
import XMonad.Util.NamedWindows (getName, getNameWMClass)
-- $usage
--
@ -137,6 +136,10 @@ actionMenu WindowBringerConfig{ menuCommand = cmd
windowMap :: X (M.Map String Window)
windowMap = windowMap' decorateName
-- | A map from application executable names to Windows.
windowAppMap :: X (M.Map String Window)
windowAppMap = windowMap' decorateAppName
-- | A map from window names to Windows, given a windowTitler function.
windowMap' :: (X.WindowSpace -> Window -> X String) -> X (M.Map String Window)
windowMap' titler = do
@ -152,3 +155,11 @@ decorateName :: X.WindowSpace -> Window -> X String
decorateName ws w = do
name <- show <$> getName w
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 it's workspace
-- ID.
decorateAppName :: X.WindowSpace -> Window -> X String
decorateAppName ws w = do
name <- show <$> getNameWMClass w
return $ name ++ " [" ++ W.tag ws ++ "]"

5
XMonad/Actions/WindowNavigation.hs
View File

@ -43,7 +43,6 @@ import XMonad
import XMonad.Util.Types (Direction2D(..))
import qualified XMonad.StackSet as W
import Control.Applicative ((<$>))
import Control.Arrow (second)
import Data.IORef
import Data.List (sortBy)
@ -137,11 +136,11 @@ withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do
setPosition posRef pos targetRect
trackMovement :: IORef WNState -> X ()
trackMovement posRef = fromCurrentPoint posRef $ \win pos -> do
trackMovement posRef = fromCurrentPoint posRef $ \win pos ->
windowRect win >>= flip whenJust (setPosition posRef pos . snd)
fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()
fromCurrentPoint posRef f = withFocused $ \win -> do
fromCurrentPoint posRef f = withFocused $ \win ->
currentPosition posRef >>= f win
-- Gets the current position from the IORef passed in, or if nothing (say, from

12
XMonad/Actions/WorkspaceCursors.hs
View File

@ -48,8 +48,8 @@ import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
LayoutModifier(handleMess, redoLayout))
import XMonad(Typeable, Message, WorkspaceId, X, XState(windowset),
fromMessage, sendMessage, windows, gets)
import Control.Monad((<=<), guard, liftM, liftM2, when)
import Control.Applicative((<$>))
import Control.Applicative (liftA2)
import Control.Monad((<=<), guard, when)
import Data.Foldable(Foldable(foldMap), toList)
import Data.Maybe(fromJust, listToMaybe)
import Data.Monoid(Monoid(mappend, mconcat))
@ -161,12 +161,12 @@ focusDepth (Cons x) = 1 + focusDepth (W.focus x)
focusDepth (End _) = 0
descend :: Monad m =>(W.Stack (Cursors a) -> m (W.Stack (Cursors a)))-> Int-> Cursors a-> m (Cursors a)
descend f 1 (Cons x) = Cons `liftM` f x
descend f n (Cons x) | n > 1 = liftM Cons $ descend f (pred n) `onFocus` x
descend f 1 (Cons x) = Cons <$> f x
descend f n (Cons x) | n > 1 = fmap Cons $ descend f (pred n) `onFocus` x
descend _ _ x = return x
onFocus :: (Monad m) => (a1 -> m a1) -> W.Stack a1 -> m (W.Stack a1)
onFocus f st = (\x -> st { W.focus = x}) `liftM` f (W.focus st)
onFocus f st = (\x -> st { W.focus = x}) <$> f (W.focus st)
-- | @modifyLayer@ is used to change the focus at a given depth
modifyLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors String)) -> Int -> X ()
@ -192,7 +192,7 @@ modifyLayer' :: (W.Stack (Cursors String) -> X (W.Stack (Cursors String))) -> In
modifyLayer' f depth = modifyCursors (descend f depth)
modifyCursors :: (Cursors String -> X (Cursors String)) -> X ()
modifyCursors = sendMessage . ChangeCursors . (liftM2 (>>) updateXMD return <=<)
modifyCursors = sendMessage . ChangeCursors . (liftA2 (>>) updateXMD return <=<)
data WorkspaceCursors a = WorkspaceCursors (Cursors String)
deriving (Typeable,Read,Show)

27
XMonad/Actions/WorkspaceNames.hs
View File

@ -37,7 +37,10 @@ module XMonad.Actions.WorkspaceNames (
swapWithCurrent,
-- * Workspace prompt
workspaceNamePrompt
workspaceNamePrompt,
-- * EwmhDesktops integration
workspaceNamesListTransform
) where
import XMonad
@ -101,17 +104,16 @@ getWorkspaceNames' = do
-- workspaces with a name, and to @\"t\"@ otherwise.
getWorkspaceNames :: X (WorkspaceId -> String)
getWorkspaceNames = do
lookup <- getWorkspaceNames'
return $ \wks -> wks ++ maybe "" (':' :) (lookup wks)
lookup' <- getWorkspaceNames'
return $ \wks -> wks ++ maybe "" (':' :) (lookup' wks)
-- | Gets the name of a workspace, if set, otherwise returns nothing.
getWorkspaceName :: WorkspaceId -> X (Maybe String)
getWorkspaceName w = ($ w) `fmap` getWorkspaceNames'
getWorkspaceName w = ($ w) <$> getWorkspaceNames'
-- | Gets the name of the current workspace. See 'getWorkspaceName'
getCurrentWorkspaceName :: X (Maybe String)
getCurrentWorkspaceName = do
getWorkspaceName =<< gets (W.currentTag . windowset)
getCurrentWorkspaceName = getWorkspaceName =<< gets (W.currentTag . windowset)
-- | Sets the name of a workspace. Empty string makes the workspace unnamed
-- again.
@ -129,7 +131,7 @@ setCurrentWorkspaceName name = do
-- | Prompt for a new name for the current workspace and set it.
renameWorkspace :: XPConfig -> X ()
renameWorkspace conf = do
renameWorkspace conf =
mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName
where pr = Wor "Workspace name: "
@ -185,3 +187,14 @@ workspaceNamePrompt conf job = do
Just i -> i
contains completions input =
return $ filter (Data.List.isInfixOf input) completions
-- | Workspace list transformation for
-- 'XMonad.Hooks.EwmhDesktops.ewmhDesktopsLogHookCustom' that exposes
-- workspace names to pagers and other EWMH-aware clients.
--
-- Usage:
-- > logHook = (workspaceNamesListTransform >>= ewmhDesktopsLogHookCustom) <+> …
workspaceNamesListTransform :: X ([WindowSpace] -> [WindowSpace])
workspaceNamesListTransform = do
names <- getWorkspaceNames
return $ map $ \ws -> ws{ W.tag = names $ W.tag ws }

12
XMonad/Config/Azerty.hs
View File

@ -17,7 +17,7 @@
module XMonad.Config.Azerty (
-- * Usage
-- $usage
azertyConfig, azertyKeys
azertyConfig, azertyKeys, belgianConfig, belgianKeys
) where
import XMonad
@ -40,11 +40,17 @@ import qualified Data.Map as M
azertyConfig = def { keys = azertyKeys <+> keys def }
azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $
belgianConfig = def { keys = belgianKeys <+> keys def }
azertyKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0]
belgianKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0xa7,0xe8,0x21,0xe7,0xe0]
azertyKeysTop topRow conf@(XConfig {modMask = modm}) = M.fromList $
[((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
++
[((m .|. modm, k), windows $ f i)
| (i, k) <- zip (workspaces conf) [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0],
| (i, k) <- zip (workspaces conf) topRow,
(f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
++
-- mod-{z,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3

7
XMonad/Config/Desktop.hs
View File

@ -58,6 +58,7 @@ import XMonad
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.EwmhDesktops
import XMonad.Util.Cursor
import qualified XMonad.StackSet as W
import qualified Data.Map as M
@ -167,6 +168,7 @@ import qualified Data.Map as M
desktopConfig = docks $ ewmh def
{ startupHook = setDefaultCursor xC_left_ptr <+> startupHook def
, layoutHook = desktopLayoutModifiers $ layoutHook def
, logHook = desktopLogHook <+> logHook def
, keys = desktopKeys <+> keys def }
desktopKeys (XConfig {modMask = modm}) = M.fromList $
@ -174,3 +176,8 @@ desktopKeys (XConfig {modMask = modm}) = M.fromList $
desktopLayoutModifiers layout = avoidStruts layout
-- | 'logHook' preserving old 'ewmh' behavior to switch workspace and focus to
-- activated window.
desktopLogHook :: X ()
desktopLogHook = activateLogHook (reader W.focusWindow >>= doF)

3
XMonad/Config/Example.hs
View File

@ -30,7 +30,8 @@ main = do
{ modMask = mod4Mask -- Use the "Win" key for the mod key
, manageHook = myManageHook <+> manageHook desktopConfig
, layoutHook = desktopLayoutModifiers $ myLayouts
, logHook = dynamicLogString def >>= xmonadPropLog
, logHook = (dynamicLogString def >>= xmonadPropLog)
<+> logHook desktopConfig
}
`additionalKeysP` -- Add some extra key bindings:

4
XMonad/Config/Gnome.hs
View File

@ -47,7 +47,7 @@ gnomeConfig = desktopConfig
gnomeKeys (XConfig {modMask = modm}) = M.fromList $
[ ((modm, xK_p), gnomeRun)
, ((modm .|. shiftMask, xK_q), spawn "gnome-session-save --kill") ]
, ((modm .|. shiftMask, xK_q), spawn "gnome-session-quit --logout") ]
-- | Launch the "Run Application" dialog. gnome-panel must be running for this
-- to work.
@ -72,7 +72,7 @@ gnomeRun = withDisplay $ \dpy -> do
-- > gconftool-2 -s /desktop/gnome/session/required_components/windowmanager xmonad --type string
gnomeRegister :: MonadIO m => m ()
gnomeRegister = io $ do
x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment
x <- lookup "DESKTOP_AUTOSTART_ID" <$> getEnvironment
whenJust x $ \sessionId -> safeSpawn "dbus-send"
["--session"
,"--print-reply=literal"

2
XMonad/Config/Mate.hs
View File

@ -77,7 +77,7 @@ mateRun = withDisplay $ \dpy -> do
-- (the extra quotes are required by dconf)
mateRegister :: MonadIO m => m ()
mateRegister = io $ do
x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment
x <- lookup "DESKTOP_AUTOSTART_ID" <$> getEnvironment
whenJust x $ \sessionId -> safeSpawn "dbus-send"
["--session"
,"--print-reply=literal"

79
XMonad/Config/Saegesser.hs Executable file
View File

@ -0,0 +1,79 @@
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
{-# LANGUAGE OverloadedStrings #-}
---------------------------------------------------------------------
-- |
-- A mostly striped down configuration that demonstrates spawnOnOnce
--
---------------------------------------------------------------------
import System.IO
import XMonad
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
import XMonad.Hooks.UrgencyHook
import XMonad.Hooks.FadeInactive
import XMonad.Layout.NoBorders
import XMonad.Layout.ResizableTile
import XMonad.Layout.Mosaic
import XMonad.Util.Run
import XMonad.Util.Cursor
import XMonad.Util.NamedScratchpad
import XMonad.Util.Scratchpad
import XMonad.Util.SpawnOnce
import XMonad.Actions.CopyWindow
import XMonad.Actions.SpawnOn
import qualified XMonad.StackSet as W
main = do
myStatusBarPipe <- spawnPipe "xmobar"
xmonad $ docks $ withUrgencyHook NoUrgencyHook $ def
{ terminal = "xterm"
, workspaces = myWorkspaces
, layoutHook = myLayoutHook
, manageHook = myManageHook <+> manageSpawn
, startupHook = myStartupHook
, logHook = myLogHook myStatusBarPipe
, focusFollowsMouse = False
}
myManageHook = composeOne
[ isDialog -?> doFloat
, className =? "trayer" -?> doIgnore
, className =? "Skype" -?> doShift "chat"
, appName =? "libreoffice" -?> doShift "office"
, return True -?> doF W.swapDown
]
myWorkspaces = [ "web", "emacs", "chat", "vm", "office", "media", "xterms", "8", "9", "0"]
myStartupHook = do
setDefaultCursor xC_left_ptr
spawnOnOnce "emacs" "emacs"
spawnNOnOnce 4 "xterms" "xterm"
myLayoutHook = smartBorders $ avoidStruts $ standardLayouts
where standardLayouts = tiled ||| mosaic 2 [3,2] ||| Mirror tiled ||| Full
tiled = ResizableTall nmaster delta ratio []
nmaster = 1
delta = 0.03
ratio = 0.6
myLogHook p = do
copies <- wsContainingCopies
let check ws | ws == "NSP" = "" -- Hide the scratchpad workspace
| ws `elem` copies = xmobarColor "red" "black" $ ws -- Workspaces with copied windows are red on black
| otherwise = ws
dynamicLogWithPP $ xmobarPP { ppHidden = check
, ppOutput = hPutStrLn p
, ppUrgent = xmobarColor "white" "red"
, ppTitle = xmobarColor "green" "" . shorten 180
}
fadeInactiveLogHook 0.6

26
XMonad/Doc/Extending.hs
View File

@ -467,7 +467,7 @@ Here is a list of the modules found in @XMonad.Hooks@:
* "XMonad.Hooks.DebugStack":
Dump the state of the StackSet. A logHook and handleEventHook are also provided.
* "Xmonad.Hooks.DynamicBars":
* "XMonad.Hooks.DynamicBars":
Manage per-screen status bars.
* "XMonad.Hooks.DynamicHooks":
@ -572,6 +572,11 @@ Here is a list of the modules found in @XMonad.Hooks@:
* "XMonad.Hooks.WorkspaceHistory":
Keeps track of workspace viewing order.
* "XMonad.Hooks.WindowSwallowing"
A handleEventHook that implements window swallowing:
Hide parent windows like terminals when opening other programs (like image viewers) from within them,
restoring them once the child application closes.
* "XMonad.Hooks.XPropManage":
A ManageHook matching on XProperties.
@ -899,6 +904,10 @@ For more information on using those modules for customizing your
More useful tiled layout that allows you to change a width\/height of window.
See also "XMonad.Layout.MouseResizableTile".
* "XMonad.Layout.ResizableThreeColumns":
The same layout as ThreeColumns but, similar to ResizableTile, allows you
to change the width\/height of the slave windows.
* "XMonad.Layout.ResizeScreen":
A layout transformer to have a layout respect a given screen
geometry. Mostly used with "Decoration" (the Horizontal and the
@ -1043,6 +1052,9 @@ These are the available prompts:
intended mostly as an example of using "XMonad.Prompt.Input" to
build an action requiring user input.
* "XMonad.Prompt.FuzzyMatch":
A module for fuzzy completion matching in prompts akin to emacs ido mode
* "XMonad.Prompt.Input":
A generic framework for prompting the user for input and passing it
along to some other action.
@ -1076,6 +1088,9 @@ These are the available prompts:
* "XMonad.Prompt.Theme":
A prompt for changing the theme of the current workspace
* "XMonad.Prompt.Unicode":
A prompt for inputting Unicode characters
* "XMonad.Prompt.Window":
xprompt operations to bring windows to you, and bring you to windows.
@ -1102,6 +1117,15 @@ external utilities.
A non complete list with a brief description:
* "XMonad.Util.ActionCycle":
Provides a way to implement cycling actions. This can be used to implement
things like alternating, toggle-style keybindings.
* "XMonad.Util.ClickableWorkspaces":
Provides clickablePP, which when applied to the PP pretty-printer used by
'XMonad.Hooks.DynamicLog.dynamicLogWithPP', will make the workspace tags
clickable in XMobar (for switching focus).
* "XMonad.Util.Cursor": configure the default cursor/pointer glyph.
* "XMonad.Util.CustomKeys": configure key bindings (see

105
XMonad/Hooks/DebugEvents.hs
View File

@ -34,6 +34,7 @@ import Control.Exception.Extensible as E
import Control.Monad.State
import Control.Monad.Reader
import Data.Char (isDigit)
import Data.Maybe (fromJust)
import Data.List (genericIndex
,genericLength
,unfoldr
@ -189,7 +190,7 @@ debugEventsHook' (ClientMessageEvent {ev_window = w
ta <- getAtom ta'
return (ta,b,l)
let wl = bytes b
vs <- io $ take (l * wl) `fmap` splitCInt vs'
vs <- io $ take (l * wl) <$> splitCInt vs'
s <- dumpProperty' w a n ta b vs 0 (10 + length n)
say " message" $ n ++ s
@ -198,7 +199,7 @@ debugEventsHook' _ = return ()
-- | Emit information about an atom.
atomName :: Atom -> X String
atomName a = withDisplay $ \d ->
io $ fromMaybe ("(unknown atom " ++ show a ++ ")") `fmap` getAtomName d a
io $ fromMaybe ("(unknown atom " ++ show a ++ ")") <$> getAtomName d a
-- | Emit an atom with respect to the current event.
atomEvent :: String -> Atom -> X ()
@ -312,9 +313,9 @@ dumpProperty a n w i = do
vsp
case rc of
0 -> do
fmt <- fromIntegral `fmap` peek fmtp
fmt <- fromIntegral <$> peek fmtp
vs' <- peek vsp
sz <- fromIntegral `fmap` peek szp
sz <- fromIntegral <$> peek szp
case () of
() | fmt == none -> xFree vs' >> return (Left "(property deleted)" )
| sz < 0 -> xFree vs' >> return (Left $ "(illegal bit size " ++
@ -324,9 +325,9 @@ dumpProperty a n w i = do
show sz ++
")" )
| otherwise -> do
len <- fromIntegral `fmap` peek lenp
len <- fromIntegral <$> peek lenp
-- that's as in "ack! it's fugged!"
ack <- fromIntegral `fmap` peek ackp
ack <- fromIntegral <$> peek ackp
vs <- peekArray (len * bytes sz) vs'
_ <- xFree vs'
return $ Right (fmt,sz,ack,vs)
@ -526,7 +527,7 @@ dumpProp a _ | a == wM_NAME = dumpString
| a == sECONDARY = dumpSelection
-- this is gross
| a == wM_TRANSIENT_FOR = do
root <- fromIntegral `fmap` inX (asks theRoot)
root <- fromIntegral <$> inX (asks theRoot)
w <- asks window
WMHints {wmh_window_group = group} <-
inX $ asks display >>= io . flip getWMHints w
@ -696,30 +697,31 @@ dumpList'' m ((l,p,t):ps) sep = do
dumpString :: Decoder Bool
dumpString = do
fmt <- asks pType
[cOMPOUND_TEXT,uTF8_STRING] <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]
case () of
() | fmt == cOMPOUND_TEXT -> guardSize 16 (...)
| fmt == sTRING -> guardSize 8 $ do
vs <- gets value
modify (\r -> r {value = []})
let ss = flip unfoldr (map twiddle vs) $
\s -> if null s
then Nothing
else let (w,s'') = break (== '\NUL') s
s' = if null s''
then s''
else tail s''
in Just (w,s')
case ss of
[s] -> append $ show s
ss' -> let go (s:ss'') c = append c >>
append (show s) >>
go ss'' ","
go [] _ = append "]"
in append "[" >> go ss' ""
| fmt == uTF8_STRING -> dumpUTF -- duplicate type test instead of code :)
| otherwise -> (inX $ atomName fmt) >>=
failure . ("unrecognized string type " ++)
x <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]
case x of
[cOMPOUND_TEXT,uTF8_STRING] -> case () of
() | fmt == cOMPOUND_TEXT -> guardSize 16 (...)
| fmt == sTRING -> guardSize 8 $ do
vs <- gets value
modify (\r -> r {value = []})
let ss = flip unfoldr (map twiddle vs) $
\s -> if null s
then Nothing
else let (w,s'') = break (== '\NUL') s
s' = if null s''
then s''
else tail s''
in Just (w,s')
case ss of
[s] -> append $ show s
ss' -> let go (s:ss'') c = append c >>
append (show s) >>
go ss'' ","
go [] _ = append "]"
in append "[" >> go ss' ""
| fmt == uTF8_STRING -> dumpUTF -- duplicate type test instead of code :)
| otherwise -> (inX $ atomName fmt) >>=
failure . ("unrecognized string type " ++)
-- show who owns a selection
dumpSelection :: Decoder Bool
@ -738,7 +740,7 @@ dumpSelection = do
-- for now, not querying Xkb
dumpXKlInds :: Decoder Bool
dumpXKlInds = guardType iNTEGER $ do
n <- fmap fromIntegral `fmap` getInt' 32
n <- fmap fromIntegral <$> getInt' 32
case n of
Nothing -> propShortErr
Just is -> append $ "indicators " ++ unwords (dumpInds is 1 1 [])
@ -847,7 +849,7 @@ dumpPixmap = guardType pIXMAP $ do
Just p -> do
append $ "pixmap " ++ showHex p ""
g' <- inX $ withDisplay $ \d -> io $
Just `fmap` getGeometry d (fromIntegral p)
(Just <$> getGeometry d (fromIntegral p))
`E.catch`
\e -> case fromException e of
Just x -> throw e `const` (x `asTypeOf` ExitSuccess)
@ -917,7 +919,7 @@ dumpExcept xs item = do
let w = (length (value sp) - length vs) * 8
-- now we get to reparse again so we get our copy of it
put sp
Just v <- getInt' w
v <- fmap fromJust (getInt' w)
-- and after all that, we can process the exception list
dumpExcept' xs that v
@ -943,7 +945,7 @@ dumpPid = guardType cARDINAL $ do
case o of
Nothing -> append $ "pid " ++ pid
Just p' -> do
prc <- io $ lines `fmap` hGetContents p'
prc <- io $ lines <$> hGetContents p'
-- deliberately forcing it
append $ if length prc < 2
then "pid " ++ pid
@ -1005,7 +1007,7 @@ dumpMDBlocks _ = propSimple "(drop site info)" -- @@@ maybe later if needed
dumpMotifEndian :: Decoder Bool
dumpMotifEndian = guardType cARDINAL $ guardSize 8 $ do
c <- map twiddle `fmap` eat 1
c <- map twiddle <$> eat 1
case c of
['l'] -> append "little"
['B'] -> append "big"
@ -1164,7 +1166,7 @@ getInt' 64 = guardR width 32 (\a e -> propSizeErr a e >> return Nothing) $
return $ Just $ lo + hi * (fromIntegral (maxBound :: Word32) + 1)
getInt' w = guardR width w (\a e -> propSizeErr a e >> return Nothing) $
guardSize' (bytes w) (propShortErr >> return Nothing) $
Just `fmap` inhale w
Just <$> inhale w
-- parse an integral value and feed it to a show-er of some kind
getInt :: Int -> (Integer -> String) -> Decoder Bool
@ -1176,25 +1178,28 @@ getInt w f = getInt' w >>= maybe (return False) (append . f)
-- @@@@@@@@@ evil beyond evil. there *has* to be a better way
inhale :: Int -> Decoder Integer
inhale 8 = do
[b] <- eat 1
return $ fromIntegral b
x <- eat 1
case x of
[b] -> return $ fromIntegral b
inhale 16 = do
[b0,b1] <- eat 2
io $ allocaArray 2 $ \p -> do
pokeArray p [b0,b1]
[v] <- peekArray 1 (castPtr p :: Ptr Word16)
return $ fromIntegral v
x <- eat 2
case x of
[b0,b1] -> io $ allocaArray 2 $ \p -> do
pokeArray p [b0,b1]
[v] <- peekArray 1 (castPtr p :: Ptr Word16)
return $ fromIntegral v
inhale 32 = do
[b0,b1,b2,b3] <- eat 4
io $ allocaArray 4 $ \p -> do
pokeArray p [b0,b1,b2,b3]
[v] <- peekArray 1 (castPtr p :: Ptr Word32)
return $ fromIntegral v
x <- eat 4
case x of
[b0,b1,b2,b3] -> io $ allocaArray 4 $ \p -> do
pokeArray p [b0,b1,b2,b3]
[v] <- peekArray 1 (castPtr p :: Ptr Word32)
return $ fromIntegral v
inhale b = error $ "inhale " ++ show b
eat :: Int -> Decoder Raw
eat n = do
(bs,rest) <- splitAt n `fmap` gets value
(bs,rest) <- splitAt n <$> gets value
modify (\r -> r {value = rest})
return bs

121
XMonad/Hooks/DynamicLog.hs
View File

@ -24,8 +24,10 @@ module XMonad.Hooks.DynamicLog (
-- * Drop-in loggers
dzen,
dzenWithFlags,
xmobar,
statusBar,
statusBar',
dynamicLog,
dynamicLogXinerama,
@ -35,15 +37,15 @@ module XMonad.Hooks.DynamicLog (
-- * Build your own formatter
dynamicLogWithPP,
dynamicLogString,
PP(..), defaultPP, def,
PP(..), def,
-- * Example formatters
dzenPP, xmobarPP, sjanssenPP, byorgeyPP,
-- * Formatting utilities
wrap, pad, trim, shorten,
xmobarColor, xmobarStrip,
xmobarStripTags,
wrap, pad, trim, shorten, shortenLeft,
xmobarColor, xmobarAction, xmobarBorder,
xmobarRaw, xmobarStrip, xmobarStripTags,
dzenColor, dzenEscape, dzenStrip,
-- * Internal formatting functions
@ -58,10 +60,11 @@ module XMonad.Hooks.DynamicLog (
-- Useful imports
import Codec.Binary.UTF8.String (encodeString)
import Control.Monad (liftM2, msum)
import Control.Applicative (liftA2)
import Control.Monad (msum)
import Data.Char ( isSpace, ord )
import Data.List (intersperse, stripPrefix, isPrefixOf, sortBy)
import Data.Maybe ( isJust, catMaybes, mapMaybe )
import Data.Maybe ( isJust, catMaybes, mapMaybe, fromMaybe )
import Data.Ord ( comparing )
import qualified Data.Map as M
import qualified XMonad.StackSet as S
@ -150,6 +153,32 @@ import XMonad.Hooks.ManageDocks
------------------------------------------------------------------------
-- | Run xmonad with a dzen status bar with specified dzen
-- command line arguments.
--
-- > main = xmonad =<< dzenWithFlags flags myConfig
-- >
-- > myConfig = def { ... }
-- >
-- > flags = "-e onstart lower -w 800 -h 24 -ta l -fg #a8a3f7 -bg #3f3c6d"
--
-- This function can be used to customize the arguments passed to dzen2.
-- e.g changing the default width and height of dzen2.
--
-- If you wish to customize the status bar format at all, you'll have to
-- use the 'statusBar' function instead.
--
-- The binding uses the XMonad.Hooks.ManageDocks module to automatically
-- handle screen placement for dzen, and enables 'mod-b' for toggling
-- the menu bar.
--
-- You should use this function only when the default 'dzen' function does not
-- serve your purpose.
--
dzenWithFlags :: LayoutClass l Window
=> String -> XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
dzenWithFlags flags conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf
-- | Run xmonad with a dzen status bar set to some nice defaults.
--
-- > main = xmonad =<< dzen myConfig
@ -159,16 +188,14 @@ import XMonad.Hooks.ManageDocks
-- The intent is that the above config file should provide a nice
-- status bar with minimal effort.
--
-- If you wish to customize the status bar format at all, you'll have to
-- use the 'statusBar' function instead.
--
-- The binding uses the XMonad.Hooks.ManageDocks module to automatically
-- handle screen placement for dzen, and enables 'mod-b' for toggling
-- the menu bar.
-- the menu bar. Please refer to 'dzenWithFlags' function for further
-- documentation.
--
dzen :: LayoutClass l Window
=> XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
dzen conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf
dzen conf = dzenWithFlags flags conf
where
fg = "'#a8a3f7'" -- n.b quoting
bg = "'#3f3c6d'"
@ -197,14 +224,27 @@ statusBar :: LayoutClass l Window
-- ^ the desired key binding to toggle bar visibility
-> XConfig l -- ^ the base config
-> IO (XConfig (ModifiedLayout AvoidStruts l))
statusBar cmd pp k conf = do
statusBar cmd pp = statusBar' cmd (return pp)
-- | Like 'statusBar' with the pretty printing options embedded in the
-- X monad. The X PP value is re-executed every time the 'logHook' runs.
-- Useful if printing options need to be modified dynamically.
statusBar' :: LayoutClass l Window
=> String -- ^ the command line to launch the status bar
-> X PP -- ^ the pretty printing options
-> (XConfig Layout -> (KeyMask, KeySym))
-- ^ the desired key binding to toggle bar visibility
-> XConfig l -- ^ the base config
-> IO (XConfig (ModifiedLayout AvoidStruts l))
statusBar' cmd xpp k conf = do
h <- spawnPipe cmd
return $ docks $ conf
{ layoutHook = avoidStruts (layoutHook conf)
, logHook = do
logHook conf
pp <- xpp
dynamicLogWithPP pp { ppOutput = hPutStrLn h }
, keys = liftM2 M.union keys' (keys conf)
, keys = liftA2 M.union keys' (keys conf)
}
where
keys' = (`M.singleton` sendMessage ToggleStruts) . k
@ -295,7 +335,8 @@ pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $
fmt w = printer pp (S.tag w)
where printer | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents = ppUrgent
| S.tag w == this = ppCurrent
| S.tag w `elem` visibles = ppVisible
| S.tag w `elem` visibles && isJust (S.stack w) = ppVisible
| S.tag w `elem` visibles = liftA2 fromMaybe ppVisible ppVisibleNoWindows
| isJust (S.stack w) = ppHidden
| otherwise = ppHiddenNoWindows
@ -350,6 +391,14 @@ shorten n xs | length xs < n = xs
where
end = "..."
-- | Like 'shorten', but truncate from the left instead of right.
shortenLeft :: Int -> String -> String
shortenLeft n xs | l < n = xs
| otherwise = end ++ (drop (l - n + length end) xs)
where
end = "..."
l = length xs
-- | Output a list of strings, ignoring empty ones and separating the
-- rest with the given separator.
sepBy :: String -- ^ separator
@ -392,6 +441,43 @@ xmobarColor :: String -- ^ foreground color: a color name, or #rrggbb format
xmobarColor fg bg = wrap t "</fc>"
where t = concat ["<fc=", fg, if null bg then "" else "," ++ bg, ">"]
-- | Encapsulate text with an action. The text will be displayed, and the
-- action executed when the displayed text is clicked. Illegal input is not
-- filtered, allowing xmobar to display any parse errors. Uses xmobar's new
-- syntax wherein the command is surrounded by backticks.
xmobarAction :: String
-- ^ Command. Use of backticks (`) will cause a parse error.
-> String
-- ^ Buttons 1-5, such as "145". Other characters will cause a
-- parse error.
-> String
-- ^ Displayed/wrapped text.
-> String
xmobarAction command button = wrap l r
where
l = "<action=`" ++ command ++ "` button=" ++ button ++ ">"
r = "</action>"
-- | Use xmobar box to add a border to an arbitrary string.
xmobarBorder :: String -- ^ Border type. Possible values: VBoth, HBoth, Full,
-- Top, Bottom, Left or Right
-> String -- ^ color: a color name, or #rrggbb format
-> Int -- ^ width in pixels
-> String -- ^ output string
-> String
xmobarBorder border color width = wrap prefix "</box>"
where
prefix = "<box type=" ++ border ++ " width=" ++ show width ++ " color="
++ color ++ ">"
-- | Encapsulate arbitrary text for display only, i.e. untrusted content if
-- wrapped (perhaps from window titles) will be displayed only, with all tags
-- ignored. Introduced in xmobar 0.21; see their documentation. Be careful not
-- to shorten the result.
xmobarRaw :: String -> String
xmobarRaw "" = ""
xmobarRaw s = concat ["<raw=", show $ length s, ":", s, "/>"]
-- ??? add an xmobarEscape function?
-- | Strip xmobar markup, specifically the <fc>, <icon> and <action> tags and
@ -435,6 +521,8 @@ data PP = PP { ppCurrent :: WorkspaceId -> String
-- contain windows
, ppHiddenNoWindows :: WorkspaceId -> String
-- ^ how to print tags of empty hidden workspaces
, ppVisibleNoWindows :: Maybe (WorkspaceId -> String)
-- ^ how to print tags of empty visible workspaces
, ppUrgent :: WorkspaceId -> String
-- ^ format to be applied to tags of urgent workspaces.
, ppSep :: String
@ -478,15 +566,12 @@ data PP = PP { ppCurrent :: WorkspaceId -> String
}
-- | The default pretty printing options, as seen in 'dynamicLog'.
{-# DEPRECATED defaultPP "Use def (from Data.Default, and re-exported by XMonad.Hooks.DynamicLog) instead." #-}
defaultPP :: PP
defaultPP = def
instance Default PP where
def = PP { ppCurrent = wrap "[" "]"
, ppVisible = wrap "<" ">"
, ppHidden = id
, ppHiddenNoWindows = const ""
, ppVisibleNoWindows= Nothing
, ppUrgent = id
, ppSep = " : "
, ppWsSep = " "

265
XMonad/Hooks/EwmhDesktops.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.EwmhDesktops
@ -19,24 +21,34 @@ module XMonad.Hooks.EwmhDesktops (
ewmhDesktopsStartup,
ewmhDesktopsLogHook,
ewmhDesktopsLogHookCustom,
NetActivated (..),
activated,
activateLogHook,
ewmhDesktopsEventHook,
ewmhDesktopsEventHookCustom,
fullscreenEventHook
ewmhFullscreen,
fullscreenEventHook,
fullscreenStartup
) where
import Codec.Binary.UTF8.String (encode)
import Data.Bits
import Data.List
import Data.Maybe
import Data.Monoid
import qualified Data.Map.Strict as M
import System.IO.Unsafe
import XMonad
import Control.Monad
import qualified XMonad.StackSet as W
import XMonad.Hooks.SetWMName
import qualified XMonad.Util.ExtensibleState as E
import XMonad.Util.XUtils (fi)
import XMonad.Util.WorkspaceCompare
import XMonad.Util.WindowProperties (getProp32)
import qualified XMonad.Util.ExtensibleState as XS
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@ -44,19 +56,47 @@ import XMonad.Util.WindowProperties (getProp32)
-- > import XMonad
-- > import XMonad.Hooks.EwmhDesktops
-- >
-- > main = xmonad $ ewmh def{ handleEventHook =
-- > handleEventHook def <+> fullscreenEventHook }
-- > main = xmonad $ ewmhFullscreen $ ewmh def
--
-- or, if fullscreen handling is not desired, just
--
-- > main = xmonad $ ewmh def
--
-- You may also be interested in 'docks' from "XMonad.Hooks.ManageDocks".
--
-- __/NOTE:/__ 'ewmh' function will call 'logHook' for handling activated
-- window.
--
-- And now by default window activation will do nothing: neither switch
-- workspace, nor focus. You can use regular 'ManageHook' combinators for
-- changing window activation behavior and then add resulting 'ManageHook'
-- using 'activateLogHook' to your 'logHook'. Also, you may be interested in
-- "XMonad.Hooks.Focus", which provides additional predicates for using in
-- 'ManageHook'.
--
-- To get back old 'ewmh' window activation behavior (switch workspace and
-- focus to activated window) you may use:
--
-- > import XMonad
-- >
-- > import XMonad.Hooks.EwmhDesktops
-- > import qualified XMonad.StackSet as W
-- >
-- > main :: IO ()
-- > main = do
-- > let acMh :: ManageHook
-- > acMh = reader W.focusWindow >>= doF
-- > xcf = ewmh $ def
-- > { modMask = mod4Mask
-- > , logHook = activateLogHook acMh <+> logHook def
-- > }
-- > xmonad xcf
-- | Add EWMH functionality to the given config. See above for an example.
ewmh :: XConfig a -> XConfig a
ewmh c = c { startupHook = startupHook c +++ ewmhDesktopsStartup
, handleEventHook = handleEventHook c +++ ewmhDesktopsEventHook
, logHook = logHook c +++ ewmhDesktopsLogHook }
-- @@@ will fix this correctly later with the rewrite
where x +++ y = mappend y x
ewmh c = c { startupHook = ewmhDesktopsStartup <+> startupHook c
, handleEventHook = ewmhDesktopsEventHook <+> handleEventHook c
, logHook = ewmhDesktopsLogHook <+> logHook c }
-- |
-- Initializes EwmhDesktops and advertises EWMH support to the X
@ -69,6 +109,58 @@ ewmhDesktopsStartup = setSupported
-- of the current state of workspaces and windows.
ewmhDesktopsLogHook :: X ()
ewmhDesktopsLogHook = ewmhDesktopsLogHookCustom id
-- |
-- Cached desktop names (e.g. @_NET_NUMBER_OF_DESKTOPS@ and
-- @_NET_DESKTOP_NAMES@).
newtype DesktopNames = DesktopNames [String]
deriving (Eq)
instance ExtensionClass DesktopNames where
initialValue = DesktopNames []
-- |
-- Cached client list (e.g. @_NET_CLIENT_LIST@).
newtype ClientList = ClientList [Window]
deriving (Eq)
instance ExtensionClass ClientList where
initialValue = ClientList [none]
-- |
-- Cached current desktop (e.g. @_NET_CURRENT_DESKTOP@).
newtype CurrentDesktop = CurrentDesktop Int
deriving (Eq)
instance ExtensionClass CurrentDesktop where
initialValue = CurrentDesktop (-1)
-- |
-- Cached window-desktop assignments (e.g. @_NET_CLIENT_LIST_STACKING@).
newtype WindowDesktops = WindowDesktops (M.Map Window Int)
deriving (Eq)
instance ExtensionClass WindowDesktops where
initialValue = WindowDesktops (M.singleton none (-1))
-- |
-- The value of @_NET_ACTIVE_WINDOW@, cached to avoid unnecessary property
-- updates.
newtype ActiveWindow = ActiveWindow Window
deriving (Eq)
instance ExtensionClass ActiveWindow where
initialValue = ActiveWindow (complement none)
-- | Compare the given value against the value in the extensible state. Run the
-- action if it has changed.
whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X ()
whenChanged v action = do
v0 <- E.get
unless (v == v0) $ do
action
E.put v
-- |
-- Generalized version of ewmhDesktopsLogHook that allows an arbitrary
-- user-specified function to transform the workspace list (post-sorting)
@ -77,38 +169,32 @@ ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
sort' <- getSortByIndex
let ws = f $ sort' $ W.workspaces s
-- Number of Workspaces
setNumberOfDesktops (length ws)
-- Set number of workspaces and names thereof
let desktopNames = map W.tag ws
whenChanged (DesktopNames desktopNames) $ do
setNumberOfDesktops (length desktopNames)
setDesktopNames desktopNames
-- Names thereof
setDesktopNames (map W.tag ws)
-- Set client list; all windows, with focused windows last
let clientList = nub . concatMap (maybe [] (\(W.Stack x l r) -> reverse l ++ r ++ [x]) . W.stack) $ ws
whenChanged (ClientList clientList) $ setClientList clientList
-- all windows, with focused windows last
let wins = nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws
setClientList wins
-- Remap the current workspace to handle any renames that f might be doing.
let maybeCurrent' = W.tag <$> listToMaybe (f [W.workspace $ W.current s])
current = join (flip elemIndex (map W.tag ws) <$> maybeCurrent')
whenChanged (CurrentDesktop $ fromMaybe 0 current) $
mapM_ setCurrentDesktop current
-- Current desktop
case (elemIndex (W.currentTag s) $ map W.tag ws) of
Nothing -> return ()
Just curr -> do
setCurrentDesktop curr
-- Set window-desktop mapping
let windowDesktops =
let f wsId workspace = M.fromList [ (winId, wsId) | winId <- W.integrate' $ W.stack workspace ]
in M.unions $ zipWith f [0..] ws
whenChanged (WindowDesktops windowDesktops) $
mapM_ (uncurry setWindowDesktop) (M.toList windowDesktops)
-- Per window Desktop
-- To make gnome-panel accept our xinerama stuff, we display
-- all visible windows on the current desktop.
forM_ (W.current s : W.visible s) $ \x ->
forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do
setWindowDesktop win curr
forM_ (W.hidden s) $ \w ->
case elemIndex (W.tag w) (map W.tag ws) of
Nothing -> return ()
Just wn -> forM_ (W.integrate' (W.stack w)) $ \win -> do
setWindowDesktop win wn
setActiveWindow
return ()
-- Set active window
let activeWindow' = fromMaybe none (W.peek s)
whenChanged (ActiveWindow activeWindow') $ setActiveWindow activeWindow'
-- |
-- Intercepts messages from pagers and similar applications and reacts on them.
@ -128,6 +214,40 @@ ewmhDesktopsEventHook = ewmhDesktopsEventHookCustom id
ewmhDesktopsEventHookCustom :: ([WindowSpace] -> [WindowSpace]) -> Event -> X All
ewmhDesktopsEventHookCustom f e = handle f e >> return (All True)
-- | Whether new window _NET_ACTIVE_WINDOW activated or not. I should keep
-- this value in global state, because i use 'logHook' for handling activated
-- windows and i need a way to tell 'logHook' what window is activated.
newtype NetActivated = NetActivated {netActivated :: Maybe Window}
deriving (Show, Typeable)
instance ExtensionClass NetActivated where
initialValue = NetActivated Nothing
-- | Was new window @_NET_ACTIVE_WINDOW@ activated?
activated :: Query Bool
activated = fmap (isJust . netActivated) (liftX XS.get)
-- | Run supplied 'ManageHook' for activated windows /only/. If you want to
-- run this 'ManageHook' for new windows too, add it to 'manageHook'.
--
-- __/NOTE:/__ 'activateLogHook' will work only _once_. I.e. if several
-- 'activateLogHook'-s was used, only first one will actually run (because it
-- resets 'NetActivated' at the end and others won't know, that window is
-- activated).
activateLogHook :: ManageHook -> X ()
activateLogHook mh = XS.get >>= maybe (return ()) go . netActivated
where
go :: Window -> X ()
go w = do
f <- runQuery mh w
-- I should reset 'NetActivated' here, because:
-- * 'windows' calls 'logHook' and i shouldn't go here the second
-- time for one window.
-- * if i reset 'NetActivated' before running 'logHook' once,
-- then 'activated' predicate won't match.
-- Thus, here is the /only/ correct place.
XS.put NetActivated{netActivated = Nothing}
windows (appEndo f)
handle :: ([WindowSpace] -> [WindowSpace]) -> Event -> X ()
handle f (ClientMessageEvent {
ev_window = w,
@ -153,17 +273,36 @@ handle f (ClientMessageEvent {
windows $ W.shiftWin (W.tag (ws !! fi n)) w
else trace $ "Bad _NET_DESKTOP with data[0]="++show n
else if mt == a_aw then do
windows $ W.focusWindow w
else if mt == a_cw then do
lh <- asks (logHook . config)
XS.put (NetActivated (Just w))
lh
else if mt == a_cw then
killWindow w
else if mt `elem` a_ignore then do
else if mt `elem` a_ignore then
return ()
else do
else
-- The Message is unknown to us, but that is ok, not all are meant
-- to be handled by the window manager
return ()
handle _ _ = return ()
-- | Add EWMH fullscreen functionality to the given config.
--
-- This must be applied after 'ewmh', like so:
--
-- > main = xmonad $ ewmhFullscreen $ ewmh def
--
-- NOT:
--
-- > main = xmonad $ ewmh $ ewmhFullscreen def
ewmhFullscreen :: XConfig a -> XConfig a
ewmhFullscreen c = c { startupHook = startupHook c <+> fullscreenStartup
, handleEventHook = handleEventHook c <+> fullscreenEventHook }
-- | Advertises EWMH fullscreen support to the X server.
fullscreenStartup :: X ()
fullscreenStartup = setFullscreenSupported
-- |
-- An event hook to handle applications that wish to fullscreen using the
-- _NET_WM_STATE protocol. This includes users of the gtk_window_fullscreen()
@ -174,7 +313,7 @@ fullscreenEventHook :: Event -> X All
fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
wmstate <- getAtom "_NET_WM_STATE"
fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
wstate <- fromMaybe [] `fmap` getProp32 wmstate win
wstate <- fromMaybe [] <$> getProp32 wmstate win
let isFull = fromIntegral fullsc `elem` wstate
@ -182,8 +321,7 @@ fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
remove = 0
add = 1
toggle = 2
ptype = 4 -- The atom property type for changeProperty
chWstate f = io $ changeProperty32 dpy win wmstate ptype propModeReplace (f wstate)
chWstate f = io $ changeProperty32 dpy win wmstate aTOM propModeReplace (f wstate)
when (typ == wmstate && fi fullsc `elem` dats) $ do
when (action == add || (action == toggle && not isFull)) $ do
@ -200,16 +338,14 @@ fullscreenEventHook _ = return $ All True
setNumberOfDesktops :: (Integral a) => a -> X ()
setNumberOfDesktops n = withDisplay $ \dpy -> do
a <- getAtom "_NET_NUMBER_OF_DESKTOPS"
c <- getAtom "CARDINAL"
r <- asks theRoot
io $ changeProperty32 dpy r a c propModeReplace [fromIntegral n]
io $ changeProperty32 dpy r a cARDINAL propModeReplace [fromIntegral n]
setCurrentDesktop :: (Integral a) => a -> X ()
setCurrentDesktop i = withDisplay $ \dpy -> do
a <- getAtom "_NET_CURRENT_DESKTOP"
c <- getAtom "CARDINAL"
r <- asks theRoot
io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i]
io $ changeProperty32 dpy r a cARDINAL propModeReplace [fromIntegral i]
setDesktopNames :: [String] -> X ()
setDesktopNames names = withDisplay $ \dpy -> do
@ -224,23 +360,20 @@ setClientList :: [Window] -> X ()
setClientList wins = withDisplay $ \dpy -> do
-- (What order do we really need? Something about age and stacking)
r <- asks theRoot
c <- getAtom "WINDOW"
a <- getAtom "_NET_CLIENT_LIST"
io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral wins)
io $ changeProperty32 dpy r a wINDOW propModeReplace (fmap fromIntegral wins)
a' <- getAtom "_NET_CLIENT_LIST_STACKING"
io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral wins)
io $ changeProperty32 dpy r a' wINDOW propModeReplace (fmap fromIntegral wins)
setWindowDesktop :: (Integral a) => Window -> a -> X ()
setWindowDesktop win i = withDisplay $ \dpy -> do
a <- getAtom "_NET_WM_DESKTOP"
c <- getAtom "CARDINAL"
io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i]
io $ changeProperty32 dpy win a cARDINAL propModeReplace [fromIntegral i]
setSupported :: X ()
setSupported = withDisplay $ \dpy -> do
r <- asks theRoot
a <- getAtom "_NET_SUPPORTED"
c <- getAtom "ATOM"
supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"
,"_NET_NUMBER_OF_DESKTOPS"
,"_NET_CLIENT_LIST"
@ -251,14 +384,26 @@ setSupported = withDisplay $ \dpy -> do
,"_NET_WM_DESKTOP"
,"_NET_WM_STRUT"
]
io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp)
io $ changeProperty32 dpy r a aTOM propModeReplace (fmap fromIntegral supp)
setWMName "xmonad"
setActiveWindow :: X ()
setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do
let w = fromMaybe none (W.peek s)
-- TODO: use in SetWMName, UrgencyHook
addSupported :: [String] -> X ()
addSupported props = withDisplay $ \dpy -> do
r <- asks theRoot
a <- getAtom "_NET_SUPPORTED"
fs <- getAtom "_NET_WM_STATE_FULLSCREEN"
newSupportedList <- mapM (fmap fromIntegral . getAtom) props
io $ do
supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy a r
changeProperty32 dpy r a aTOM propModeReplace (nub $ newSupportedList ++ supportedList)
setFullscreenSupported :: X ()
setFullscreenSupported = addSupported ["_NET_WM_STATE", "_NET_WM_STATE_FULLSCREEN"]
setActiveWindow :: Window -> X ()
setActiveWindow w = withDisplay $ \dpy -> do
r <- asks theRoot
a <- getAtom "_NET_ACTIVE_WINDOW"
c <- getAtom "WINDOW"
io $ changeProperty32 dpy r a c propModeReplace [fromIntegral w]
io $ changeProperty32 dpy r a wINDOW propModeReplace [fromIntegral w]

6
XMonad/Hooks/FadeInactive.hs
View File

@ -28,6 +28,7 @@ module XMonad.Hooks.FadeInactive (
import XMonad
import qualified XMonad.StackSet as W
import Control.Applicative (liftA2)
import Control.Monad
-- $usage
@ -64,8 +65,7 @@ rationalToOpacity perc
setOpacity :: Window -> Rational -> X ()
setOpacity w t = withDisplay $ \dpy -> do
a <- getAtom "_NET_WM_WINDOW_OPACITY"
c <- getAtom "CARDINAL"
io $ changeProperty32 dpy w a c propModeReplace [rationalToOpacity t]
io $ changeProperty32 dpy w a cARDINAL propModeReplace [rationalToOpacity t]
-- | Fades a window out by setting the opacity
fadeOut :: Rational -> Window -> X ()
@ -112,4 +112,4 @@ fadeOutLogHook :: Query Rational -> X ()
fadeOutLogHook qry = withWindowSet $ \s -> do
let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++
concatMap (W.integrate' . W.stack . W.workspace) (W.visible s)
forM_ visibleWins $ liftM2 (=<<) setOpacity (runQuery qry)
forM_ visibleWins $ liftA2 (=<<) setOpacity (runQuery qry)

6
XMonad/Hooks/FadeWindows.hs
View File

@ -61,7 +61,8 @@ import Control.Monad.Reader (ask
,asks)
import Control.Monad.State (gets)
import qualified Data.Map as M
import Data.Monoid
import Data.Monoid hiding ((<>))
import Data.Semigroup
import Graphics.X11.Xlib.Extras (Event(..))
@ -134,6 +135,9 @@ instance Monoid Opacity where
r `mappend` OEmpty = r
_ `mappend` r = r
instance Semigroup Opacity where
(<>) = mappend
-- | A FadeHook is similar to a ManageHook, but records window opacity.
type FadeHook = Query Opacity

581
XMonad/Hooks/Focus.hs Normal file
View File

@ -0,0 +1,581 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK show-extensions #-}
-- |
-- Module: XMonad.Hooks.Focus
-- Copyright: sgf-dma, 2016
-- Maintainer: sgf.dma@gmail.com
--
module XMonad.Hooks.Focus
(
-- $main
-- * FocusQuery.
--
-- $focusquery
Focus (..)
, FocusLock (..)
, toggleLock
, focusLockOn
, focusLockOff
, FocusQuery
, runFocusQuery
, FocusHook
-- * Lifting into FocusQuery.
--
-- $lift
, liftQuery
, new
, focused
, focused'
, focusedOn
, focusedOn'
, focusedCur
, focusedCur'
, newOn
, newOnCur
, unlessFocusLock
-- * Commonly used actions for modifying focus.
--
-- $common
, keepFocus
, switchFocus
, keepWorkspace
, switchWorkspace
-- * Running FocusQuery.
--
-- $running
, manageFocus
-- * Example configurations.
--
-- $examples
, activateSwitchWs
, activateOnCurrentWs
, activateOnCurrentKeepFocus
)
where
import Data.Maybe
import Data.Monoid
import qualified Data.Semigroup as S
import Control.Applicative
import Control.Monad
import Control.Monad.Reader
import Control.Arrow hiding ((<+>))
import XMonad
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Hooks.ManageHelpers (currentWs)
import XMonad.Hooks.EwmhDesktops (activated, NetActivated(..))
-- $main
--
-- This module provides monad on top of Query monad providing additional
-- information about new window:
--
-- - workspace, where new window will appear;
-- - focused window on workspace, where new window will appear;
-- - current workspace;
--
-- And a property in extensible state:
--
-- - is focus lock enabled? Focus lock instructs all library's 'FocusHook'
-- functions to not move focus or switch workspace.
--
-- Lifting operations for standard 'ManageHook' EDSL combinators into
-- 'FocusQuery' monad allowing to run these combinators on focused window and
-- common actions for keeping focus and\/or workspace, switching focus and\/or
-- workspace are also provided.
--
-- == Quick start.
--
-- I may use one of predefined configurations.
--
-- 1. Default window activation behavior is to switch to workspace with
-- activated window and switch focus to it:
--
-- > import XMonad
-- >
-- > import XMonad.Hooks.EwmhDesktops
-- > import XMonad.Hooks.Focus
-- >
-- > main :: IO ()
-- > main = do
-- > let mh :: ManageHook
-- > mh = activateSwitchWs
-- > xcf = ewmh $ def
-- > { modMask = mod4Mask
-- > , logHook = activateLogHook mh <+> logHook def
-- > }
-- > xmonad xcf
--
-- 2. Or i may move activated window to current workspace and switch focus to
-- it:
--
-- > let mh :: ManageHook
-- > mh = activateOnCurrentWs
--
-- 3. Or move activated window to current workspace, but keep focus unchanged:
--
-- > let mh :: ManageHook
-- > mh = activateOnCurrentKeepFocus
--
-- 4. I may use regular 'ManageHook' combinators for filtering, which windows
-- may activate. E.g. activate all windows, except firefox:
--
-- > let mh :: ManageHook
-- > mh = not <$> (className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel")
-- > --> activateSwitchWs
--
-- 5. Or even use 'FocusHook' combinators. E.g. activate all windows, unless
-- xterm is focused on /current/ workspace:
--
-- > let mh :: ManageHook
-- > mh = manageFocus (not <$> focusedCur (className =? "XTerm")
-- > --> liftQuery activateSwitchWs)
--
-- or activate all windows, unless focused window on the workspace,
-- /where activated window is/, is not a xterm:
--
-- > let mh :: ManageHook
-- > mh = manageFocus (not <$> focused (className =? "XTerm")
-- > --> liftQuery activateSwitchWs)
--
-- == Defining FocusHook.
--
-- I may define my own 'FocusHook' like:
--
-- > activateFocusHook :: FocusHook
-- > activateFocusHook = composeAll
-- > -- If 'gmrun' is focused on workspace, on which
-- > -- /activated window/ is, keep focus unchanged. But i
-- > -- may still switch workspace (thus, i use 'composeAll').
-- > -- See 'keepFocus' properties in the docs below.
-- > [ focused (className =? "Gmrun")
-- > --> keepFocus
-- > -- Default behavior for activated windows: switch
-- > -- workspace and focus.
-- > , return True --> switchWorkspace <+> switchFocus
-- > ]
-- >
-- > newFocusHook :: FocusHook
-- > newFocusHook = composeOne
-- > -- Always switch focus to 'gmrun'.
-- > [ new (className =? "Gmrun") -?> switchFocus
-- > -- And always keep focus on 'gmrun'. Note, that
-- > -- another 'gmrun' will steal focus from already
-- > -- running one.
-- > , focused (className =? "Gmrun") -?> keepFocus
-- > -- If firefox dialog prompt (e.g. master password
-- > -- prompt) is focused on current workspace and new
-- > -- window appears here too, keep focus unchanged
-- > -- (note, used predicates: @newOnCur <&&> focused@ is
-- > -- the same as @newOnCur <&&> focusedCur@, but is
-- > -- /not/ the same as just 'focusedCur' )
-- > , newOnCur <&&> focused
-- > ((className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel") <&&> isDialog)
-- > -?> keepFocus
-- > -- Default behavior for new windows: switch focus.
-- > , return True -?> switchFocus
-- > ]
--
-- And then use it:
--
-- > import XMonad
-- > import XMonad.Util.EZConfig
-- >
-- > import XMonad.Hooks.EwmhDesktops
-- > import XMonad.Hooks.ManageHelpers
-- > import XMonad.Hooks.Focus
-- >
-- >
-- > main :: IO ()
-- > main = do
-- > let newFh :: ManageHook
-- > newFh = manageFocus newFocusHook
-- > acFh :: X ()
-- > acFh = activateLogHook (manageFocus activateFocusHook)
-- > xcf = ewmh $ def
-- > { manageHook = newFh <+> manageHook def
-- > , logHook = acFh <+> logHook def
-- > , modMask = mod4Mask
-- > }
-- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)]
-- > xmonad xcf
--
-- Note:
--
-- - /mod4Mask+v/ key toggles focus lock (when enabled, neither focus nor
-- workspace won't be switched).
-- - I need 'XMonad.Hooks.EwmhDesktops' module for enabling window
-- activation.
-- - 'FocusHook' in 'manageHook' will be called /only/ for new windows.
-- - 'FocusHook' in 'logHook' will be called /only/ for activated windows.
--
-- Alternatively, i may construct a single 'FocusHook' for both new and
-- activated windows and then just add it to both 'manageHook' and 'logHook':
--
-- > let fh :: ManageHook
-- > fh = manageFocus $ (composeOne
-- > [ liftQuery activated -?> activateFocusHook
-- > , Just <$> newFocusHook
-- > ])
-- > xcf = ewmh $ def
-- > { manageHook = fh <+> manageHook def
-- > , logHook = activateLogHook fh <+> logHook def
-- > , modMask = mod4Mask
-- > }
-- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)]
--
-- Note:
-- - Predicate 'activated' will be 'True' for activated window.
-- - The order, when constructing final 'FocusHook': 'FocusHook' without
-- 'activated' predicate will match to activated windows too, thus i should
-- place it after one with 'activated' (so the latter will have a chance to
-- handle activated window first).
--
-- And more technical notes:
--
-- - 'FocusHook' will run /many/ times, so it usually should not keep state
-- or save results. Precisely, it may do anything, but it must be idempotent
-- to operate properly.
-- - 'FocusHook' will see new window at workspace, where functions on the
-- /right/ from it in 'ManageHook' monoid place it. In other words, in
-- @(Endo WindowSet)@ monoid i may see changes only from functions applied
-- /before/ (more to the right in function composition). Thus, it's better to
-- add 'FocusHook' the last.
-- - 'FocusHook' functions won't see window shift to another workspace made
-- by function from 'FocusHook' itself: new window workspace is determined
-- /before/ running 'FocusHook' and even if later one of 'FocusHook'
-- functions moves window to another workspace, predicates ('focused',
-- 'newOn', etc) will still think new window is at workspace it was before.
-- This can be worked around by splitting 'FocusHook' into several different
-- values and evaluating each one separately, like:
--
-- > (FH2 -- manageFocus --> MH2) <+> (FH1 -- manageFocus --> MH1) <+> ..
--
-- E.g.
--
-- > manageFocus FH2 <+> manageFocus FH1 <+> ..
--
-- now @FH2@ will see window shift made by @FH1@.
--
-- Also, note, that if several 'activateLogHook'-s are sequenced, only
-- /first/ one (leftmost) will run. Thus, to make above working,
-- 'mappend' all 'ManageHook'-s first, and then run by /single/
-- 'activateLogHook' (see next example).
--
-- Another interesting example is moving all activated windows to current
-- workspace by default, and applying 'FocusHook' after:
--
-- > import XMonad
-- > import XMonad.Util.EZConfig
-- >
-- > import XMonad.Hooks.EwmhDesktops
-- > import XMonad.Hooks.ManageHelpers
-- > import XMonad.Hooks.Focus
-- >
-- > main :: IO ()
-- > main = do
-- > let fh :: ManageHook
-- > fh = manageFocus $ (composeOne
-- > [ liftQuery activated -?> (newOnCur --> keepFocus)
-- > , Just <$> newFocusHook
-- > ])
-- > xcf = ewmh $ def
-- > { manageHook = fh <+> manageHook def
-- > , logHook = activateLogHook (fh <+> activateOnCurrentWs) <+> logHook def
-- > , modMask = mod4Mask
-- > }
-- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)]
-- > xmonad xcf
-- >
-- > newFocusHook :: FocusHook
-- > newFocusHook = composeOne
-- > -- Always switch focus to 'gmrun'.
-- > [ new (className =? "Gmrun") -?> switchFocus
-- > -- And always keep focus on 'gmrun'. Note, that
-- > -- another 'gmrun' will steal focus from already
-- > -- running one.
-- > , focused (className =? "Gmrun") -?> keepFocus
-- > -- If firefox dialog prompt (e.g. master password
-- > -- prompt) is focused on current workspace and new
-- > -- window appears here too, keep focus unchanged
-- > -- (note, used predicates: @newOnCur <&&> focused@ is
-- > -- the same as @newOnCur <&&> focusedCur@, but is
-- > -- /not/ the same as just 'focusedCur' )
-- > , newOnCur <&&> focused
-- > ((className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel") <&&> isDialog)
-- > -?> keepFocus
-- > -- Default behavior for new windows: switch focus.
-- > , return True -?> switchFocus
-- > ]
--
-- Note here:
--
-- - i keep focus, when activated window appears on current workspace, in
-- this example.
-- - when @liftQuery activated -?> (newOnCur --> keepFocus)@ runs, activated
-- window will be /already/ on current workspace, thus, if i do not want to
-- move some activated windows, i should filter them out before applying
-- @activateOnCurrentWs@ 'FocusHook'.
-- - i 'mappend' all 'ManageHook'-s and run 'activateLogHook' only once.
-- FocusQuery.
-- $focusquery
-- | Information about current workspace and focus.
data Focus = Focus
{ -- | Workspace, where new window appears.
newWorkspace :: WorkspaceId
-- | Focused window on workspace, where new window
-- appears.
, focusedWindow :: Maybe Window
-- | Current workspace.
, currentWorkspace :: WorkspaceId
}
deriving (Show)
instance Default Focus where
def = Focus
{ focusedWindow = Nothing
, newWorkspace = ""
, currentWorkspace = ""
}
newtype FocusLock = FocusLock {getFocusLock :: Bool}
deriving (Show, Typeable)
instance ExtensionClass FocusLock where
initialValue = FocusLock False
-- | Toggle stored focus lock state.
toggleLock :: X ()
toggleLock = XS.modify (\(FocusLock b) -> FocusLock (not b))
-- | Lock focus.
focusLockOn :: X ()
focusLockOn = XS.modify (const (FocusLock True))
-- | Unlock focus.
focusLockOff :: X ()
focusLockOff = XS.modify (const (FocusLock False))
-- | Monad on top of 'Query' providing additional information about new
-- window.
newtype FocusQuery a = FocusQuery (ReaderT Focus Query a)
instance Functor FocusQuery where
fmap f (FocusQuery x) = FocusQuery (fmap f x)
instance Applicative FocusQuery where
pure x = FocusQuery (pure x)
(FocusQuery f) <*> (FocusQuery mx) = FocusQuery (f <*> mx)
instance Monad FocusQuery where
return x = FocusQuery (return x)
(FocusQuery mx) >>= f = FocusQuery $ mx >>= \x ->
let FocusQuery y = f x in y
instance MonadReader Focus FocusQuery where
ask = FocusQuery ask
local f (FocusQuery mx) = FocusQuery (local f mx)
instance MonadIO FocusQuery where
liftIO mx = FocusQuery (liftIO mx)
instance S.Semigroup a => S.Semigroup (FocusQuery a) where
(<>) = liftM2 (S.<>)
instance Monoid a => Monoid (FocusQuery a) where
mempty = return mempty
mappend = (<>)
runFocusQuery :: FocusQuery a -> Focus -> Query a
runFocusQuery (FocusQuery m) = runReaderT m
type FocusHook = FocusQuery (Endo WindowSet)
-- Lifting into 'FocusQuery'.
-- $lift
-- | Lift 'Query' into 'FocusQuery' monad. The same as 'new'.
liftQuery :: Query a -> FocusQuery a
liftQuery = FocusQuery . lift
-- | Run 'Query' on new window.
new :: Query a -> FocusQuery a
new = liftQuery
-- | Run 'Query' on focused window on workspace, where new window appears. If
-- there is no focused window, return 'False'.
focused :: Query Bool -> FocusQuery Bool
focused m = getAny <$> focused' (Any <$> m)
-- | More general version of 'focused'.
focused' :: Monoid a => Query a -> FocusQuery a
focused' m = do
mw <- asks focusedWindow
liftQuery (maybe mempty (flip local m . const) mw)
-- | Run 'Query' on window focused at particular workspace. If there is no
-- focused window, return 'False'.
focusedOn :: WorkspaceId -> Query Bool -> FocusQuery Bool
focusedOn i m = getAny <$> focusedOn' i (Any <$> m)
-- | More general version of 'focusedOn'.
focusedOn' :: Monoid a => WorkspaceId -> Query a -> FocusQuery a
focusedOn' i m = liftQuery $ do
mw <- liftX $ withWindowSet (return . W.peek . W.view i)
maybe mempty (flip local m . const) mw
-- | Run 'Query' on focused window on current workspace. If there is no
-- focused window, return 'False'. Note,
--
-- > focused <&&> newOnCur != focusedCur
--
-- The first will affect only new or activated window appearing on current
-- workspace, while the last will affect any window: focus even for windows
-- appearing on other workpsaces will depend on focus on /current/ workspace.
focusedCur :: Query Bool -> FocusQuery Bool
focusedCur m = getAny <$> focusedCur' (Any <$> m)
-- | More general version of 'focusedCur'.
focusedCur' :: Monoid a => Query a -> FocusQuery a
focusedCur' m = asks currentWorkspace >>= \i -> focusedOn' i m
-- | Does new window appear at particular workspace?
newOn :: WorkspaceId -> FocusQuery Bool
newOn i = (i ==) <$> asks newWorkspace
-- | Does new window appear at current workspace?
newOnCur :: FocusQuery Bool
newOnCur = asks currentWorkspace >>= newOn
-- | Execute 'Query', unless focus is locked.
unlessFocusLock :: Monoid a => Query a -> Query a
unlessFocusLock m = do
FocusLock b <- liftX XS.get
when' (not b) m
-- Commonly used actions for modifying focus.
--
-- $common
-- Operations in each pair 'keepFocus' and 'switchFocus', 'keepWorkspace' and
-- 'switchWorkspace' overwrite each other (the letftmost will determine what
-- happened):
--
-- prop> keepFocus <+> switchFocus = keepFocus
-- prop> switchFocus <+> keepFocus = switchFocus
-- prop> keepWorkspace <+> switchWorkspace = keepWorkspace
-- prop> switchWorkspace <+> keepWorkspace = switchWorkspace
--
-- and operations from different pairs are commutative:
--
-- prop> keepFocus <+> switchWorkspace = switchWorkspace <+> keepFocus
-- prop> switchFocus <+> switchWorkspace = switchWorkspace <+> switchFocus
--
-- etc.
-- | Keep focus on workspace (may not be current), where new window appears.
-- Workspace will not be switched. This operation is idempotent and
-- effectively returns focus to window focused on that workspace before
-- applying @(Endo WindowSet)@ function.
keepFocus :: FocusHook
keepFocus = focused' $ ask >>= \w -> doF $ \ws ->
W.view (W.currentTag ws) . W.focusWindow w $ ws
-- | Switch focus to new window on workspace (may not be current), where new
-- window appears. Workspace will not be switched. This operation is
-- idempotent.
switchFocus :: FocusHook
switchFocus = do
FocusLock b <- liftQuery . liftX $ XS.get
if b
-- When focus lock is enabled, call 'keepFocus' explicitly (still no
-- 'keepWorkspace') to overwrite default behavior.
then keepFocus
else new $ ask >>= \w -> doF $ \ws ->
W.view (W.currentTag ws) . W.focusWindow w $ ws
-- | Keep current workspace. Focus will not be changed at either current or
-- new window's workspace. This operation is idempotent and effectively
-- switches to workspace, which was current before applying @(Endo WindowSet)@
-- function.
keepWorkspace :: FocusHook
keepWorkspace = do
ws <- asks currentWorkspace
liftQuery . doF $ W.view ws
-- | Switch workspace to one, where new window appears. Focus will not be
-- changed at either current or new window's workspace. This operation is
-- idempotent.
switchWorkspace :: FocusHook
switchWorkspace = do
FocusLock b <- liftQuery . liftX $ XS.get
if b
-- When focus lock is enabled, call 'keepWorkspace' explicitly (still no
-- 'keepFocus') to overwrite default behavior.
then keepWorkspace
else do
ws <- asks newWorkspace
liftQuery . doF $ W.view ws
-- Running FocusQuery.
-- $running
-- | I don't know at which workspace new window will appear until @(Endo
-- WindowSet)@ function from 'windows' in "XMonad.Operations" actually run,
-- but in @(Endo WindowSet)@ function i can't already execute monadic actions,
-- because it's pure. So, i compute result for every workspace here and just
-- use it later in @(Endo WindowSet)@ function. Note, though, that this will
-- execute monadic actions many times, and therefore assume, that result of
-- 'FocusHook' does not depend on the number of times it was executed.
manageFocus :: FocusHook -> ManageHook
manageFocus m = do
fws <- liftX . withWindowSet $ return
. map (W.tag &&& fmap W.focus . W.stack) . W.workspaces
ct <- currentWs
let r = def {currentWorkspace = ct}
hs <- forM fws $ \(i, mw) -> do
f <- runFocusQuery m (r {focusedWindow = mw, newWorkspace = i})
return (i, f)
reader (selectHook hs) >>= doF
where
-- | Select and apply @(Endo WindowSet)@ function depending on which
-- workspace new window appeared now.
selectHook :: [(WorkspaceId, Endo WindowSet)] -> Window -> WindowSet -> WindowSet
selectHook cfs nw ws = fromMaybe ws $ do
i <- W.findTag nw ws
f <- lookup i cfs
return (appEndo f ws)
when' :: (Monad m, Monoid a) => Bool -> m a -> m a
when' b mx
| b = mx
| otherwise = return mempty
-- Exmaple configurations.
-- $examples
-- | Default EWMH window activation behavior: switch to workspace with
-- activated window and switch focus to it.
activateSwitchWs :: ManageHook
activateSwitchWs = manageFocus (liftQuery activated -->
switchWorkspace <+> switchFocus)
-- | Move activated window to current workspace.
activateOnCurrent' :: ManageHook
activateOnCurrent' = activated --> currentWs >>= unlessFocusLock . doShift
-- | Move activated window to current workspace and switch focus to it. Note,
-- that i need to explicitly call 'switchFocus' here, because otherwise, when
-- activated window is /already/ on current workspace, focus won't be
-- switched.
activateOnCurrentWs :: ManageHook
activateOnCurrentWs = manageFocus (liftQuery activated <&&> newOnCur --> switchFocus)
<+> activateOnCurrent'
-- | Move activated window to current workspace, but keep focus unchanged.
activateOnCurrentKeepFocus :: ManageHook
activateOnCurrentKeepFocus = manageFocus (liftQuery activated <&&> newOnCur --> keepFocus)
<+> activateOnCurrent'

1
XMonad/Hooks/InsertPosition.hs
View File

@ -22,7 +22,6 @@ module XMonad.Hooks.InsertPosition (
import XMonad(ManageHook, MonadReader(ask))
import qualified XMonad.StackSet as W
import Control.Applicative((<$>))
import Data.Maybe(fromMaybe)
import Data.List(find)
import Data.Monoid(Endo(Endo))

12
XMonad/Hooks/ManageDocks.hs
View File

@ -15,7 +15,7 @@
module XMonad.Hooks.ManageDocks (
-- * Usage
-- $usage
docks, manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,
docks, manageDocks, checkDock, AvoidStruts(..), avoidStruts, avoidStrutsOn,
docksEventHook, docksStartupHook,
ToggleStruts(..),
SetStruts(..),
@ -104,11 +104,11 @@ instance ExtensionClass StrutCache where
initialValue = StrutCache M.empty
updateStrutCache :: Window -> [Strut] -> X Bool
updateStrutCache w strut = do
updateStrutCache w strut =
XS.modified $ StrutCache . M.insert w strut . fromStrutCache
deleteFromStructCache :: Window -> X Bool
deleteFromStructCache w = do
deleteFromStructCache w =
XS.modified $ StrutCache . M.delete w . fromStrutCache
-- | Detects if the given window is of type DOCK and if so, reveals
@ -116,7 +116,7 @@ deleteFromStructCache w = do
manageDocks :: ManageHook
manageDocks = checkDock --> (doIgnore <+> setDocksMask)
where setDocksMask = do
ask >>= \win -> liftX $ withDisplay $ \dpy -> do
ask >>= \win -> liftX $ withDisplay $ \dpy ->
io $ selectInput dpy win (propertyChangeMask .|. structureNotifyMask)
mempty
@ -167,7 +167,7 @@ getStrut w = do
msp <- getProp32s "_NET_WM_STRUT_PARTIAL" w
case msp of
Just sp -> return $ parseStrutPartial sp
Nothing -> fmap (maybe [] parseStrut) $ getProp32s "_NET_WM_STRUT" w
Nothing -> maybe [] parseStrut <$> getProp32s "_NET_WM_STRUT" w
where
parseStrut xs@[_, _, _, _] = parseStrutPartial . take 12 $ xs ++ cycle [minBound, maxBound]
parseStrut _ = []
@ -182,7 +182,7 @@ getStrut w = do
calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle)
calcGap ss = withDisplay $ \dpy -> do
rootw <- asks theRoot
struts <- (filter careAbout . concat) `fmap` XS.gets (M.elems . fromStrutCache)
struts <- (filter careAbout . concat) <$> XS.gets (M.elems . fromStrutCache)
-- we grab the window attributes of the root window rather than checking
-- the width of the screen because xlib caches this info and it tends to

25
XMonad/Hooks/ManageHelpers.hs
View File

@ -46,6 +46,7 @@ module XMonad.Hooks.ManageHelpers (
doFloatAt,
doFloatDep,
doHideIgnore,
doSink,
Match,
) where
@ -73,8 +74,8 @@ data Match a = Match Bool a
-- | An alternative 'ManageHook' composer. Unlike 'composeAll' it stops as soon as
-- a candidate returns a 'Just' value, effectively running only the first match
-- (whereas 'composeAll' continues and executes all matching rules).
composeOne :: [MaybeManageHook] -> ManageHook
composeOne = foldr try idHook
composeOne :: (Monoid a, Monad m) => [m (Maybe a)] -> m a
composeOne = foldr try (return mempty)
where
try q z = do
x <- q
@ -85,17 +86,17 @@ composeOne = foldr try idHook
infixr 0 -?>, -->>, -?>>
-- | q \/=? x. if the result of q equals x, return False
(/=?) :: Eq a => Query a -> a -> Query Bool
(/=?) :: (Eq a, Functor m) => m a -> a -> m Bool
q /=? x = fmap (/= x) q
-- | q <==? x. if the result of q equals x, return True grouped with q
(<==?) :: Eq a => Query a -> a -> Query (Match a)
(<==?) :: (Eq a, Functor m) => m a -> a -> m (Match a)
q <==? x = fmap (`eq` x) q
where
eq q' x' = Match (q' == x') q'
-- | q <\/=? x. if the result of q notequals x, return True grouped with q
(</=?) :: Eq a => Query a -> a -> Query (Match a)
(</=?) :: (Eq a, Functor m) => m a -> a -> m (Match a)
q </=? x = fmap (`neq` x) q
where
neq q' x' = Match (q' /= x') q'
@ -103,19 +104,19 @@ q </=? x = fmap (`neq` x) q
-- | A helper operator for use in 'composeOne'. It takes a condition and an action;
-- if the condition fails, it returns 'Nothing' from the 'Query' so 'composeOne' will
-- go on and try the next rule.
(-?>) :: Query Bool -> ManageHook -> MaybeManageHook
(-?>) :: (Functor m, Monad m) => m Bool -> m a -> m (Maybe a)
p -?> f = do
x <- p
if x then fmap Just f else return Nothing
-- | A helper operator for use in 'composeAll'. It takes a condition and a function taking a grouped datum to action. If 'p' is true, it executes the resulting action.
(-->>) :: Query (Match a) -> (a -> ManageHook) -> ManageHook
(-->>) :: (Monoid b, Monad m) => m (Match a) -> (a -> m b) -> m b
p -->> f = do
Match b m <- p
if b then (f m) else mempty
if b then (f m) else return mempty
-- | A helper operator for use in 'composeOne'. It takes a condition and a function taking a groupdatum to action. If 'p' is true, it executes the resulting action. If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule.
(-?>>) :: Query (Match a) -> (a -> ManageHook) -> MaybeManageHook
(-?>>) :: (Functor m, Monad m) => m (Match a) -> (a -> m b) -> m (Maybe b)
p -?>> f = do
Match b m <- p
if b then fmap Just (f m) else return Nothing
@ -179,7 +180,7 @@ transience' :: ManageHook
transience' = maybeToDefinite transience
-- | converts 'MaybeManageHook's to 'ManageHook's
maybeToDefinite :: MaybeManageHook -> ManageHook
maybeToDefinite :: (Monoid a, Functor m) => m (Maybe a) -> m a
maybeToDefinite = fmap (fromMaybe mempty)
@ -226,3 +227,7 @@ doCenterFloat = doSideFloat C
-- | Hides window and ignores it.
doHideIgnore :: ManageHook
doHideIgnore = ask >>= \w -> liftX (hide w) >> doF (W.delete w)
-- | Sinks a window
doSink :: ManageHook
doSink = reader (Endo . W.sink)

3
XMonad/Hooks/PositionStoreHooks.hs
View File

@ -40,7 +40,6 @@ import XMonad.Hooks.ManageDocks
import XMonad.Layout.Decoration
import System.Random(randomRIO)
import Control.Applicative((<$>))
import Control.Monad(when)
import Data.Maybe
import Data.Monoid
@ -100,7 +99,7 @@ positionStoreInit mDecoTheme w = withDisplay $ \d -> do
positionStoreEventHook :: Event -> X All
positionStoreEventHook (DestroyWindowEvent {ev_window = w, ev_event_type = et}) = do
when (et == destroyNotify) $ do
when (et == destroyNotify) $
modifyPosStore (\ps -> posStoreRemove ps w)
return (All True)
positionStoreEventHook _ = return (All True)

295
XMonad/Hooks/RefocusLast.hs Normal file
View File

@ -0,0 +1,295 @@
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, MultiWayIf #-}
--------------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.RefocusLast
-- Description : Hooks and actions to refocus the previous window.
-- Copyright : (c) 2018 L. S. Leary
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : L. S. Leary
-- Stability : unstable
-- Portability : unportable
--
-- Provides hooks and actions that keep track of recently focused windows on a
-- per workspace basis and automatically refocus the last window on loss of the
-- current (if appropriate as determined by user specified criteria).
--------------------------------------------------------------------------------
-- --< Imports & Exports >-- {{{
module XMonad.Hooks.RefocusLast (
-- * Usage
-- $Usage
-- * Hooks
refocusLastLogHook,
refocusLastLayoutHook,
refocusLastWhen,
-- ** Predicates
-- $Predicates
refocusingIsActive,
isFloat,
-- * Actions
toggleRefocusing,
toggleFocus,
swapWithLast,
refocusWhen,
shiftRLWhen,
updateRecentsOn,
-- * Types
-- $Types
RecentWins(..),
RecentsMap(..),
RefocusLastLayoutHook(..),
RefocusLastToggle(..)
) where
import XMonad
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.Stack (findS, mapZ_)
import XMonad.Layout.LayoutModifier
import Data.Maybe (fromMaybe)
import Data.Monoid (All(..))
import Data.Foldable (asum)
import qualified Data.Map.Strict as M
import Control.Monad (when)
-- }}}
-- --< Usage >-- {{{
-- $Usage
-- To use this module, you must either include 'refocusLastLogHook' in your log
-- hook __or__ 'refocusLastLayoutHook' in your layout hook; don't use both.
-- This suffices to make use of both 'toggleFocus' and 'shiftRLWhen' but will
-- not refocus automatically upon loss of the current window; for that you must
-- include in your event hook @'refocusLastWhen' pred@ for some valid @pred@.
--
-- The event hooks that trigger refocusing only fire when a window is lost
-- completely, not when it's simply e.g. moved to another workspace. Hence you
-- will need to use @'shiftRLWhen' pred@ or @'refocusWhen' pred@ as appropriate
-- if you want the same behaviour in such cases.
--
-- Example configuration:
--
-- > import XMonad
-- > import XMonad.Hooks.RefocusLast
-- > import qualified Data.Map.Strict as M
-- >
-- > main :: IO ()
-- > main = xmonad def
-- > { handleEventHook = refocusLastWhen myPred <+> handleEventHook def
-- > , logHook = refocusLastLogHook <+> logHook def
-- > -- , layoutHook = refocusLastLayoutHook $ layoutHook def
-- > , keys = refocusLastKeys <+> keys def
-- > } where
-- > myPred = refocusingIsActive <||> isFloat
-- > refocusLastKeys cnf
-- > = M.fromList
-- > $ ((modMask cnf , xK_a), toggleFocus)
-- > : ((modMask cnf .|. shiftMask, xK_a), swapWithLast)
-- > : ((modMask cnf , xK_b), toggleRefocusing)
-- > : [ ( (modMask cnf .|. shiftMask, n)
-- > , windows =<< shiftRLWhen myPred wksp
-- > )
-- > | (n, wksp) <- zip [xK_1..xK_9] (workspaces cnf)
-- > ]
--
-- }}}
-- --< Types >-- {{{
-- $Types
-- The types and constructors used in this module are exported principally to
-- aid extensibility; typical users will have nothing to gain from this section.
-- | Data type holding onto the previous and current @Window@.
data RecentWins = Recent { previous :: !Window, current :: !Window }
deriving (Show, Read, Eq)
-- | Newtype wrapper for a @Map@ holding the @RecentWins@ for each workspace.
-- Is an instance of @ExtensionClass@ with persistence of state.
newtype RecentsMap = RecentsMap (M.Map WorkspaceId RecentWins)
deriving (Show, Read, Eq, Typeable)
instance ExtensionClass RecentsMap where
initialValue = RecentsMap M.empty
extensionType = PersistentExtension
-- | A 'LayoutModifier' that updates the 'RecentWins' for a workspace upon
-- relayout.
data RefocusLastLayoutHook a = RefocusLastLayoutHook
deriving (Show, Read)
instance LayoutModifier RefocusLastLayoutHook a where
modifyLayout _ w@(W.Workspace tg _ _) r = updateRecentsOn tg >> runLayout w r
-- | A newtype on @Bool@ to act as a universal toggle for refocusing.
newtype RefocusLastToggle = RefocusLastToggle { refocusing :: Bool }
deriving (Show, Read, Eq, Typeable)
instance ExtensionClass RefocusLastToggle where
initialValue = RefocusLastToggle { refocusing = True }
extensionType = PersistentExtension
-- }}}
-- --< Public Hooks >-- {{{
-- | A log hook recording the current workspace's most recently focused windows
-- into extensible state.
refocusLastLogHook :: X ()
refocusLastLogHook = withWindowSet (updateRecentsOn . W.currentTag)
-- | Records a workspace's recently focused windows into extensible state upon
-- relayout. Potentially a less wasteful alternative to @refocusLastLogHook@,
-- as it does not run on @WM_NAME@ @propertyNotify@ events.
refocusLastLayoutHook :: l a -> ModifiedLayout RefocusLastLayoutHook l a
refocusLastLayoutHook = ModifiedLayout RefocusLastLayoutHook
-- | Given a predicate on the event window determining whether or not to act,
-- construct an event hook that runs iff the core xmonad event handler will
-- unmanage the window, and which shifts focus to the last focused window on
-- the appropriate workspace if desired.
refocusLastWhen :: Query Bool -> Event -> X All
refocusLastWhen p event = All True <$ case event of
UnmapEvent { ev_send_event = synth, ev_window = w } -> do
e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
when (synth || e == 0) (refocusLast w)
DestroyWindowEvent { ev_window = w } -> refocusLast w
_ -> return ()
where
refocusLast w = whenX (runQuery p w) . withWindowSet $ \ws ->
whenJust (W.findTag w ws) $ \tag ->
withRecentsIn tag () $ \lw cw ->
when (w == cw) . modify $ \xs ->
xs { windowset = tryFocusIn tag [lw] ws }
-- }}}
-- --< Predicates >-- {{{
-- $Predicates
-- Impure @Query Bool@ predicates on event windows for use as arguments to
-- 'refocusLastWhen', 'shiftRLWhen' and 'refocusWhen'. Can be combined with
-- '<||>' or '<&&>'. Use like e.g.
--
-- > , handleEventHook = refocusLastWhen refocusingIsActive
--
-- or in a keybinding:
--
-- > windows =<< shiftRLWhen (refocusingIsActive <&&> isFloat) "3"
--
-- It's also valid to use a property lookup like @className =? "someProgram"@ as
-- a predicate, and it should function as expected with e.g. @shiftRLWhen@.
-- In the event hook on the other hand, the window in question has already been
-- unmapped or destroyed, so external lookups to X properties don't work:
-- only the information fossilised in xmonad's state is available.
-- | Holds iff refocusing is toggled active.
refocusingIsActive :: Query Bool
refocusingIsActive = (liftX . XS.gets) refocusing
-- | Holds iff the event window is a float.
isFloat :: Query Bool
isFloat = ask >>= \w -> (liftX . gets) (M.member w . W.floating . windowset)
-- }}}
-- --< Public Actions >-- {{{
-- | Toggle automatic refocusing at runtime. Has no effect unless the
-- @refocusingIsActive@ predicate has been used.
toggleRefocusing :: X ()
toggleRefocusing = XS.modify (RefocusLastToggle . not . refocusing)
-- | Refocuses the previously focused window; acts as a toggle.
-- Is not affected by @toggleRefocusing@.
toggleFocus :: X ()
toggleFocus = withRecents $ \lw cw ->
when (cw /= lw) . windows $ tryFocus [lw]
-- | Swaps the current and previous windows of the current workspace.
-- Is not affected by @toggleRefocusing@.
swapWithLast :: X ()
swapWithLast = withRecents $ \lw cw ->
when (cw /= lw) . windows . modify''. mapZ_ $ \w ->
if | (w == lw) -> cw
| (w == cw) -> lw
| otherwise -> w
where modify'' f = W.modify (f Nothing) (f . Just)
-- | Given a target workspace and a predicate on its current window, produce a
-- 'windows' suitable function that will refocus that workspace appropriately.
-- Allows you to hook refocusing into any action you can run through
-- @windows@. See the implementation of @shiftRLWhen@ for a straight-forward
-- usage example.
refocusWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet)
refocusWhen p tag = withRecentsIn tag id $ \lw cw -> do
b <- runQuery p cw
return (if b then tryFocusIn tag [cw, lw] else id)
-- | Sends the focused window to the specified workspace, refocusing the last
-- focused window if the predicate holds on the current window. Note that the
-- native version of this, @windows . W.shift@, has a nice property that this
-- does not: shifting a window to another workspace then shifting it back
-- preserves its place in the stack. Can be used in a keybinding like e.g.
--
-- > windows =<< shiftRLWhen refocusingIsActive "3"
--
-- or
--
-- > (windows <=< shiftRLWhen refocusingIsActive) "3"
--
-- where '<=<' is imported from "Control.Monad".
shiftRLWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet)
shiftRLWhen p to = withWindowSet $ \ws -> do
refocus <- refocusWhen p (W.currentTag ws)
let shift = maybe id (W.shiftWin to) (W.peek ws)
return (refocus . shift)
-- | Perform an update to the 'RecentWins' for the specified workspace.
-- The RefocusLast log and layout hooks are both implemented trivially in
-- terms of this function. Only exported to aid extensibility.
updateRecentsOn :: WorkspaceId -> X ()
updateRecentsOn tag = withWindowSet $ \ws ->
whenJust (W.peek $ W.view tag ws) $ \fw -> do
m <- getRecentsMap
let insertRecent l c = XS.put . RecentsMap $ M.insert tag (Recent l c) m
case M.lookup tag m of
Just (Recent _ cw) -> when (cw /= fw) (insertRecent cw fw)
Nothing -> insertRecent fw fw
-- }}}
-- --< Private Utilities >-- {{{
-- | Focuses the first window in the list it can find on the current workspace.
tryFocus :: [Window] -> WindowSet -> WindowSet
tryFocus wins = W.modify' $ \s ->
fromMaybe s . asum $ (\w -> findS (== w) s) <$> wins
-- | Operate the above on a specified workspace.
tryFocusIn :: WorkspaceId -> [Window] -> WindowSet -> WindowSet
tryFocusIn tag wins ws =
W.view (W.currentTag ws) . tryFocus wins . W.view tag $ ws
-- | Get the RecentsMap out of extensible state and remove its newtype wrapper.
getRecentsMap :: X (M.Map WorkspaceId RecentWins)
getRecentsMap = XS.get >>= \(RecentsMap m) -> return m
-- | Perform an X action dependent on successful lookup of the RecentWins for
-- the specified workspace, or return a default value.
withRecentsIn :: WorkspaceId -> a -> (Window -> Window -> X a) -> X a
withRecentsIn tag dflt f = M.lookup tag <$> getRecentsMap
>>= maybe (return dflt) (\(Recent lw cw) -> f lw cw)
-- | The above specialised to the current workspace and unit.
withRecents :: (Window -> Window -> X ()) -> X ()
withRecents f = withWindowSet $ \ws -> withRecentsIn (W.currentTag ws) () f
-- }}}

4
XMonad/Hooks/ScreenCorners.hs
View File

@ -65,7 +65,7 @@ addScreenCorner corner xF = do
(win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of
Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions
Nothing -> flip (,) xF `fmap` createWindowAt corner
Nothing -> flip (,) xF <$> createWindowAt corner
XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m'
@ -179,7 +179,7 @@ screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout
--
-- > myStartupHook = do
-- > ...
-- > addScreenCorner SCUpperRight (goToSelected defaultGSConfig { gs_cellwidth = 200})
-- > addScreenCorner SCUpperRight (goToSelected def { gs_cellwidth = 200})
-- > addScreenCorners [ (SCLowerRight, nextWS)
-- > , (SCLowerLeft, prevWS)
-- > ]

36
XMonad/Hooks/SetWMName.hs
View File

@ -36,7 +36,10 @@
-----------------------------------------------------------------------------
module XMonad.Hooks.SetWMName (
setWMName) where
setWMName
, getWMName
)
where
import Control.Monad (join)
import Data.Char (ord)
@ -61,26 +64,26 @@ setWMName name = do
dpy <- asks display
io $ do
-- _NET_SUPPORTING_WM_CHECK atom of root and support windows refers to the support window
mapM_ (\w -> changeProperty32 dpy w atom_NET_SUPPORTING_WM_CHECK wINDOW 0 [fromIntegral supportWindow]) [root, supportWindow]
mapM_ (\w -> changeProperty32 dpy w atom_NET_SUPPORTING_WM_CHECK wINDOW propModeReplace [fromIntegral supportWindow]) [root, supportWindow]
-- set WM_NAME in supportWindow (now only accepts latin1 names to eliminate dependency on utf8 encoder)
changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING 0 (latin1StringToCCharList name)
changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING propModeReplace (latin1StringToCCharList name)
-- declare which _NET protocols are supported (append to the list if it exists)
supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root
changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM 0 (nub $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList)
supportedList <- join . maybeToList <$> getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root
changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM propModeReplace (nub $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList)
where
netSupportingWMCheckAtom :: X Atom
netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK"
latin1StringToCCharList :: String -> [CChar]
latin1StringToCCharList str = map (fromIntegral . ord) str
getSupportWindow :: X Window
getSupportWindow = withDisplay $ \dpy -> do
atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom
root <- asks theRoot
supportWindow <- fmap (join . fmap listToMaybe) $ io $ getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root
validateWindow (fmap fromIntegral supportWindow)
netSupportingWMCheckAtom :: X Atom
netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK"
getSupportWindow :: X Window
getSupportWindow = withDisplay $ \dpy -> do
atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom
root <- asks theRoot
supportWindow <- (listToMaybe =<<) <$> io (getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root)
validateWindow (fmap fromIntegral supportWindow)
where
validateWindow :: Maybe Window -> X Window
validateWindow w = do
valid <- maybe (return False) isValidWindow w
@ -110,3 +113,8 @@ setWMName name = do
io $ mapWindow dpy window -- not sure if this is needed
io $ lowerWindow dpy window -- not sure if this is needed
return window
-- | Get WM name.
getWMName :: X String
getWMName = getSupportWindow >>= runQuery title

1
XMonad/Hooks/ToggleHook.hs
View File

@ -42,7 +42,6 @@ import XMonad
import qualified XMonad.Util.ExtensibleState as XS
import Control.Monad (join,guard)
import Control.Applicative ((<$>))
import Control.Arrow (first, second)
import Data.Map

10
XMonad/Hooks/UrgencyHook.hs
View File

@ -81,7 +81,6 @@ import XMonad.Util.NamedWindows (getName)
import XMonad.Util.Timer (TimerId, startTimer, handleTimer)
import XMonad.Util.WindowProperties (getProp32)
import Control.Applicative ((<$>))
import Control.Monad (when)
import Data.Bits (testBit)
import Data.List (delete, (\\))
@ -321,9 +320,8 @@ data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig
changeNetWMState :: Display -> Window -> ([CLong] -> [CLong]) -> X ()
changeNetWMState dpy w f = do
wmstate <- getAtom "_NET_WM_STATE"
wstate <- fromMaybe [] `fmap` getProp32 wmstate w
let ptype = 4 -- atom property type for changeProperty
io $ changeProperty32 dpy w wmstate ptype propModeReplace (f wstate)
wstate <- fromMaybe [] <$> getProp32 wmstate w
io $ changeProperty32 dpy w wmstate aTOM propModeReplace (f wstate)
return ()
-- | Add an atom to the _NET_WM_STATE property.
@ -338,7 +336,7 @@ removeNetWMState dpy w atom = changeNetWMState dpy w $ delete (fromIntegral atom
getNetWMState :: Window -> X [CLong]
getNetWMState w = do
a_wmstate <- getAtom "_NET_WM_STATE"
fromMaybe [] `fmap` getProp32 a_wmstate w
fromMaybe [] <$> getProp32 a_wmstate w
-- The Non-ICCCM Manifesto:
@ -357,7 +355,7 @@ handleEvent :: UrgencyHook h => WithUrgencyHook h -> Event -> X ()
handleEvent wuh event =
case event of
-- WM_HINTS urgency flag
PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do
PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } ->
when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do
WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
if (testBit flags urgencyHintBit) then markUrgent w else markNotUrgent w

10
XMonad/Hooks/WallpaperSetter.hs
View File

@ -41,7 +41,8 @@ import Data.Ord (comparing)
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.Monoid
import Data.Monoid hiding ((<>))
import Data.Semigroup
-- $usage
-- This module requires imagemagick and feh to be installed, as these are utilized
@ -86,6 +87,9 @@ instance Monoid WallpaperList where
mappend (WallpaperList w1) (WallpaperList w2) =
WallpaperList $ M.toList $ (M.fromList w2) `M.union` (M.fromList w1)
instance Semigroup WallpaperList where
(<>) = mappend
-- | Complete wallpaper configuration passed to the hook
data WallpaperConf = WallpaperConf {
wallpaperBaseDir :: FilePath -- ^ Where the wallpapers reside (if empty, will look in \~\/.wallpapers/)
@ -217,7 +221,7 @@ layerCommand (rect, path) = do
res <- getPicRes path
return $ case needsRotation rect <$> res of
Nothing -> ""
Just rotate ->
Just rotate -> let size = show (rect_width rect) ++ "x" ++ show (rect_height rect) in
" \\( '"++path++"' "++(if rotate then "-rotate 90 " else "")
++ " -scale "++(show$rect_width rect)++"x"++(show$rect_height rect)++"! \\)"
++ " -scale "++size++"^ -gravity center -extent "++size++" +gravity \\)"
++ " -geometry +"++(show$rect_x rect)++"+"++(show$rect_y rect)++" -composite "

245
XMonad/Hooks/WindowSwallowing.hs Normal file
View File

@ -0,0 +1,245 @@
{-# LANGUAGE NamedFieldPuns #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.WindowSwallowing
-- Copyright : (c) 2020 Leon Kowarschick
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Leon Kowarschick. <thereal.elkowar@gmail.com>
-- Stability : unstable
-- Portability : unportable
--
-- Provides a handleEventHook that implements window swallowing.
--
-- If you open a GUI-window (i.e. feh) from the terminal,
-- the terminal will normally still be shown on screen, unnecessarily
-- taking up space on the screen.
-- With window swallowing, can detect that you opened a window from within another
-- window, and allows you "swallow" that parent window for the time the new
-- window is running.
--
-- __NOTE__: This module depends on @pstree@ to analyze the process hierarchy, so make
-- sure that is on your @$PATH@.
--
-- __NOTE__ that this does not always work perfectly:
--
-- - Because window swallowing needs to check the process hierarchy, it requires
-- both the child and the parent to be distinct processes. This means that
-- applications which implement instance sharing cannot be supported by window swallowing.
-- Most notably, this excludes some terminal emulators as well as tmux
-- from functioning as the parent process. It also excludes a good amount of
-- child programs, because many graphical applications do implement instance sharing.
-- For example, window swallowing will probably not work with your browser.
--
-- - To check the process hierarchy, we need to be able to get the process ID
-- by looking at the window. This requires the @_NET_WM_PID@ X-property to be set.
-- If any application you want to use this with does not provide the @_NET_WM_PID@,
-- there is not much you can do except for reaching out to the author of that
-- application and asking them to set that property.
-----------------------------------------------------------------------------
module XMonad.Hooks.WindowSwallowing
( -- * Usage
-- $usage
swallowEventHook
)
where
import XMonad
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.WindowProperties
import XMonad.Util.Run ( runProcessWithInput )
import Data.Semigroup ( All(..) )
import qualified Data.Map.Strict as M
import Data.List ( isInfixOf )
import Control.Monad ( when )
-- $usage
-- You can use this module by including the following in your @~\/.xmonad/xmonad.hs@:
--
-- > import XMonad.Hooks.WindowSwallowing
--
-- and using 'swallowEventHook' somewhere in your 'handleEventHook', for example:
--
-- > myHandleEventHook = swallowEventHook (className =? "Alacritty" <||> className =? "Termite") (return True)
--
-- For more information on editing your handleEventHook and key bindings,
-- see "XMonad.Doc.Extending".
-- | handleEventHook that will swallow child windows when they are
-- opened from another window.
swallowEventHook
:: Query Bool -- ^ query the parent window has to match for window swallowing to occur.
-- Set this to @return True@ to run swallowing for every parent.
-> Query Bool -- ^ query the child window has to match for window swallowing to occur.
-- Set this to @return True@ to run swallowing for every child
-> Event -- ^ The event to handle.
-> X All
swallowEventHook parentQueries childQueries event = do
case event of
-- This is called right before a window gets opened. We intercept that
-- call to possibly open the window ourselves, swapping out
-- it's parent processes window for the new window in the stack.
MapRequestEvent { ev_window = childWindow } ->
-- For a window to be opened from within another window, that other window
-- must be focused. Thus the parent window that would be swallowed has to be
-- the currently focused window.
withFocused $ \parentWindow -> do
-- First verify that both windows match the given queries
parentMatches <- runQuery parentQueries parentWindow
childMatches <- runQuery childQueries childWindow
when (parentMatches && childMatches) $ do
-- read the windows _NET_WM_PID properties
childWindowPid <- getProp32s "_NET_WM_PID" childWindow
parentWindowPid <- getProp32s "_NET_WM_PID" parentWindow
case (parentWindowPid, childWindowPid) of
(Just (parentPid : _), Just (childPid : _)) -> do
-- check if the new window is a child process of the last focused window
-- using the process ids.
isChild <- liftIO $ fi childPid `isChildOf` fi parentPid
when isChild $ do
-- We set the newly opened window as the focused window, replacing the parent window.
-- If the parent window was floating, we transfer that data to the child,
-- such that it shows up at the same position, with the same dimensions.
windows
( W.modify' (\x -> x { W.focus = childWindow })
. moveFloatingState parentWindow childWindow
)
XS.modify (addSwallowedParent parentWindow childWindow)
_ -> return ()
return ()
-- This is called in many circumstances, most notably for us:
-- right before a window gets closed. We store the current
-- state of the window stack here, such that we know where the
-- child window was on the screen when restoring the swallowed parent process.
ConfigureEvent{} -> withWindowSet $ \ws -> do
XS.modify . setStackBeforeWindowClosing . currentStack $ ws
XS.modify . setFloatingBeforeWindowClosing . W.floating $ ws
-- This is called right after any window closes.
DestroyWindowEvent { ev_event = eventId, ev_window = childWindow } ->
-- Because DestroyWindowEvent is emitted a lot more often then you think,
-- this check verifies that the event is /actually/ about closing a window.
when (eventId == childWindow) $ do
-- we get some data from the extensible state, most notably we ask for
-- the \"parent\" window of the now closed window.
maybeSwallowedParent <- XS.gets (getSwallowedParent childWindow)
maybeOldStack <- XS.gets stackBeforeWindowClosing
oldFloating <- XS.gets floatingBeforeClosing
case (maybeSwallowedParent, maybeOldStack) of
(Just parent, Just oldStack) -> do
-- If there actually is a corresponding swallowed parent window for this window,
-- we will try to restore it.
-- because there are some cases where the stack-state is not stored correctly in the ConfigureEvent hook,
-- we have to first check if the stack-state is valid.
-- if it is, we can restore the parent exactly where the child window was before being closed
-- if the stored stack-state is invalid however, we still restore the window
-- by just inserting it as the focused window in the stack.
stackStoredCorrectly <- do
curStack <- withWindowSet (return . currentStack)
let oldLen = length (W.integrate oldStack)
let curLen = length (W.integrate' curStack)
return (oldLen - 1 == curLen && childWindow == W.focus oldStack)
if stackStoredCorrectly
then windows
(\ws ->
updateCurrentStack
(const $ Just $ oldStack { W.focus = parent })
$ moveFloatingState childWindow parent
$ ws { W.floating = oldFloating }
)
else windows (insertIntoStack parent)
-- after restoring, we remove the information about the swallowing from the state.
XS.modify $ removeSwallowed childWindow
XS.modify $ setStackBeforeWindowClosing Nothing
_ -> return ()
return ()
_ -> return ()
return $ All True
-- | insert a window as focused into the current stack, moving the previously focused window down the stack
insertIntoStack :: a -> W.StackSet i l a sid sd -> W.StackSet i l a sid sd
insertIntoStack win = W.modify
(Just $ W.Stack win [] [])
(\s -> Just $ s { W.focus = win, W.down = W.focus s : W.down s })
-- | run a pure transformation on the Stack of the currently focused workspace.
updateCurrentStack
:: (Maybe (W.Stack a) -> Maybe (W.Stack a))
-> W.StackSet i l a sid sd
-> W.StackSet i l a sid sd
updateCurrentStack f = W.modify (f Nothing) (f . Just)
currentStack :: W.StackSet i l a sid sd -> Maybe (W.Stack a)
currentStack = W.stack . W.workspace . W.current
-- | move the floating state from one window to another, sinking the original window
moveFloatingState
:: Ord a
=> a -- ^ window to move from
-> a -- ^ window to move to
-> W.StackSet i l a s sd
-> W.StackSet i l a s sd
moveFloatingState from to ws = ws
{ W.floating = M.delete from $ maybe (M.delete to (W.floating ws))
(\r -> M.insert to r (W.floating ws))
(M.lookup from (W.floating ws))
}
-- | check if a given process is a child of another process. This depends on "pstree" being in the PATH
-- NOTE: this does not work if the child process does any kind of process-sharing.
isChildOf
:: Int -- ^ child PID
-> Int -- ^ parent PID
-> IO Bool
isChildOf child parent = do
output <- runProcessWithInput "pstree" ["-T", "-p", show parent] ""
return $ any (show child `isInfixOf`) $ lines output
data SwallowingState =
SwallowingState
{ currentlySwallowed :: M.Map Window Window -- ^ mapping from child window window to the currently swallowed parent window
, stackBeforeWindowClosing :: Maybe (W.Stack Window) -- ^ current stack state right before DestroyWindowEvent is sent
, floatingBeforeClosing :: M.Map Window W.RationalRect -- ^ floating map of the stackset right before DestroyWindowEvent is sent
} deriving (Typeable, Show)
getSwallowedParent :: Window -> SwallowingState -> Maybe Window
getSwallowedParent win SwallowingState { currentlySwallowed } =
M.lookup win currentlySwallowed
addSwallowedParent :: Window -> Window -> SwallowingState -> SwallowingState
addSwallowedParent parent child s@SwallowingState { currentlySwallowed } =
s { currentlySwallowed = M.insert child parent currentlySwallowed }
removeSwallowed :: Window -> SwallowingState -> SwallowingState
removeSwallowed child s@SwallowingState { currentlySwallowed } =
s { currentlySwallowed = M.delete child currentlySwallowed }
setStackBeforeWindowClosing
:: Maybe (W.Stack Window) -> SwallowingState -> SwallowingState
setStackBeforeWindowClosing stack s = s { stackBeforeWindowClosing = stack }
setFloatingBeforeWindowClosing
:: M.Map Window W.RationalRect -> SwallowingState -> SwallowingState
setFloatingBeforeWindowClosing x s = s { floatingBeforeClosing = x }
instance ExtensionClass SwallowingState where
initialValue = SwallowingState { currentlySwallowed = mempty
, stackBeforeWindowClosing = Nothing
, floatingBeforeClosing = mempty
}
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral

1
XMonad/Hooks/WorkspaceByPos.hs
View File

@ -25,7 +25,6 @@ import qualified XMonad.StackSet as W
import XMonad.Util.XUtils (fi)
import Data.Maybe
import Control.Applicative((<$>))
import Control.Monad.Error ((<=<),guard,lift,runErrorT,throwError)
-- $usage

5
XMonad/Hooks/WorkspaceHistory.hs
View File

@ -25,6 +25,7 @@ module XMonad.Hooks.WorkspaceHistory (
, workspaceHistoryWithScreen
-- * Handling edits
, workspaceHistoryTransaction
, workspaceHistoryModify
) where
import Control.Applicative
@ -101,3 +102,7 @@ updateLastActiveOnEachScreen StackSet {current = cur, visible = vis} wh =
let newEntry = (sid, wid)
alreadyCurrent = maybe False (== newEntry) $ firstOnScreen sid curr
in if alreadyCurrent then curr else newEntry:delete newEntry curr
-- | Modify a the workspace history with a given pure function.
workspaceHistoryModify :: ([(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]) -> X ()
workspaceHistoryModify action = XS.modify $ WorkspaceHistory . action . history

2
XMonad/Layout/AutoMaster.hs
View File

@ -73,7 +73,7 @@ autoLayout k bias wksp rect = do
let n = length ws
if null ws then
runLayout wksp rect
else do
else
if (n<=k) then
return ((divideRow rect ws),Nothing)
else do

6
XMonad/Layout/AvoidFloats.hs
View File

@ -108,10 +108,10 @@ instance LayoutModifier AvoidFloats Window where
modifyLayoutWithUpdate lm w r = withDisplay $ \d -> do
floating <- gets $ W.floating . windowset
case cache lm of
Just (key, mer) | key == (floating,r) -> flip (,) Nothing `fmap` runLayout w mer
_ -> do rs <- io $ map toRect `fmap` mapM (getWindowAttributes d) (filter shouldAvoid $ M.keys floating)
Just (key, mer) | key == (floating,r) -> flip (,) Nothing <$> runLayout w mer
_ -> do rs <- io $ map toRect <$> mapM (getWindowAttributes d) (filter shouldAvoid $ M.keys floating)
let mer = maximumBy (comparing area) $ filter bigEnough $ maxEmptyRectangles r rs
flip (,) (Just $ pruneWindows $ lm { cache = Just ((floating,r),mer) }) `fmap` runLayout w mer
flip (,) (Just $ pruneWindows $ lm { cache = Just ((floating,r),mer) }) <$> runLayout w mer
where
toRect :: WindowAttributes -> Rectangle
toRect wa = let b = fi $ wa_border_width wa

139
XMonad/Layout/BinaryColumn.hs Normal file
View File

@ -0,0 +1,139 @@
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.BinaryColumn
-- Copyright : (c) 2009 Ilya Portnov, (c) 2018 Campbell Barton
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Campbell Barton <ideasman42@gmail.com>
-- Stability : unstable
-- Portability : unportable
--
-- Provides Column layout that places all windows in one column.
-- Each window is half the height of the previous,
-- except for the last pair of windows.
--
-- Note: Originally based on 'XMonad.Layout.Column' with changes:
--
-- * Adding/removing windows doesn't resize all other windows.
-- (last window pair exception).
-- * Minimum window height option.
--
-----------------------------------------------------------------------------
module XMonad.Layout.BinaryColumn (
-- * Usage
-- $usage
BinaryColumn (..)
) where
import XMonad
import qualified XMonad.StackSet
import qualified Data.List
-- $usage
-- This module defines layout named BinaryColumn.
-- It places all windows in one column.
-- Windows heights are calculated to prevent window resizing whenever
-- a window is added or removed.
-- This is done by keeping the last two windows in the stack the same height.
--
-- You can use this module by adding following in your @xmonad.hs@:
--
-- > import XMonad.Layout.BinaryColumn
--
-- Then add layouts to your layoutHook:
--
-- > myLayoutHook = BinaryColumn 1.0 32 ||| ...
--
-- The first value causes the master window to take exactly half of the screen,
-- the second ensures that windows are no less than 32 pixels tall.
--
-- Shrink/Expand can be used to adjust the first value by increments of 0.1.
--
-- * 2.0 uses all space for the master window
-- (minus the space for windows which get their fixed height).
-- * 0.0 gives an evenly spaced grid.
-- Negative values reverse the sizes so the last
-- window in the stack becomes larger.
--
data BinaryColumn a = BinaryColumn Float Int
deriving (Read, Show)
instance XMonad.LayoutClass BinaryColumn a where
pureLayout = columnLayout
pureMessage = columnMessage
columnMessage :: BinaryColumn a -> SomeMessage -> Maybe (BinaryColumn a)
columnMessage (BinaryColumn q min_size) m = fmap resize (fromMessage m)
where
resize Shrink = BinaryColumn (max (-2.0) (q - 0.1)) min_size
resize Expand = BinaryColumn (min 2.0 (q + 0.1)) min_size
columnLayout :: BinaryColumn a
-> XMonad.Rectangle
-> XMonad.StackSet.Stack a
-> [(a, XMonad.Rectangle)]
columnLayout (BinaryColumn scale min_size) rect stack = zip ws rects
where
ws = XMonad.StackSet.integrate stack
n = length ws
scale_abs = abs scale
heights_noflip =
let
-- Regular case: check for min size.
f n size div False = let
n_fl = (fromIntegral n)
n_prev_fl = (fromIntegral (n + 1))
div_test = min (div) (n_prev_fl)
value_test = (toInteger (round ((fromIntegral size) / div_test)))
value_max = size - (toInteger (min_size * n))
(value, divide_next, no_room) =
if value_test < value_max then
(value_test, div, False)
else
(value_max, n_fl, True)
size_next = size - value
n_next = n - 1
in value
: f n_next size_next divide_next no_room
-- Fallback case: when windows have reached min size
-- simply create an even grid with the remaining space.
f n size div True = let
n_fl = (fromIntegral n)
value_even = ((fromIntegral size) / div)
value = (toInteger (round value_even))
n_next = n - 1
size_next = size - value
divide_next = n_fl
in value
: f n_next size_next n_fl True
-- Last item: included twice.
f 0 size div no_room_prev =
[size];
in f
n_init size_init divide_init False
where
n_init = n - 1
size_init = (toInteger (rect_height rect))
divide_init =
if scale_abs == 0.0 then
(fromIntegral n)
else
(1.0 / (0.5 * scale_abs))
heights =
if (scale < 0.0) then
Data.List.reverse (take n heights_noflip)
else
heights_noflip
ys = [fromIntegral $ sum $ take k heights | k <- [0..n - 1]]
rects = map (mkRect rect) $ zip heights ys
mkRect :: XMonad.Rectangle
-> (Integer,XMonad.Position)
-> XMonad.Rectangle
mkRect (XMonad.Rectangle xs ys ws _) (h, y) =
XMonad.Rectangle xs (ys + fromIntegral y) ws (fromInteger h)

82
XMonad/Layout/BinarySpacePartition.hs
View File

@ -6,6 +6,7 @@
-- Module : XMonad.Layout.BinarySpacePartition
-- Copyright : (c) 2013 Ben Weitzman <benweitzman@gmail.com>
-- 2015 Anton Pirogov <anton.pirogov@gmail.com>
-- 2019 Mateusz Karbowy <obszczymucha@gmail.com
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Ben Weitzman <benweitzman@gmail.com>
@ -29,6 +30,7 @@ module XMonad.Layout.BinarySpacePartition (
, FocusParent(..)
, SelectMoveNode(..)
, Direction2D(..)
, SplitShiftDirectional(..)
) where
import XMonad
@ -66,19 +68,21 @@ import Data.Ratio ((%))
--
-- If you don't want to use the mouse, add the following key bindings to resize the splits with the keyboard:
--
-- > , ((modm .|. altMask, xK_l ), sendMessage $ ExpandTowards R)
-- > , ((modm .|. altMask, xK_h ), sendMessage $ ExpandTowards L)
-- > , ((modm .|. altMask, xK_j ), sendMessage $ ExpandTowards D)
-- > , ((modm .|. altMask, xK_k ), sendMessage $ ExpandTowards U)
-- > , ((modm .|. altMask .|. ctrlMask , xK_l ), sendMessage $ ShrinkFrom R)
-- > , ((modm .|. altMask .|. ctrlMask , xK_h ), sendMessage $ ShrinkFrom L)
-- > , ((modm .|. altMask .|. ctrlMask , xK_j ), sendMessage $ ShrinkFrom D)
-- > , ((modm .|. altMask .|. ctrlMask , xK_k ), sendMessage $ ShrinkFrom U)
-- > , ((modm, xK_r ), sendMessage Rotate)
-- > , ((modm, xK_s ), sendMessage Swap)
-- > , ((modm, xK_n ), sendMessage FocusParent)
-- > , ((modm .|. ctrlMask, xK_n ), sendMessage SelectNode)
-- > , ((modm .|. shiftMask, xK_n ), sendMessage MoveNode)
-- > , ((modm .|. altMask, xK_l ), sendMessage $ ExpandTowards R)
-- > , ((modm .|. altMask, xK_h ), sendMessage $ ExpandTowards L)
-- > , ((modm .|. altMask, xK_j ), sendMessage $ ExpandTowards D)
-- > , ((modm .|. altMask, xK_k ), sendMessage $ ExpandTowards U)
-- > , ((modm .|. altMask .|. ctrlMask , xK_l ), sendMessage $ ShrinkFrom R)
-- > , ((modm .|. altMask .|. ctrlMask , xK_h ), sendMessage $ ShrinkFrom L)
-- > , ((modm .|. altMask .|. ctrlMask , xK_j ), sendMessage $ ShrinkFrom D)
-- > , ((modm .|. altMask .|. ctrlMask , xK_k ), sendMessage $ ShrinkFrom U)
-- > , ((modm, xK_r ), sendMessage Rotate)
-- > , ((modm, xK_s ), sendMessage Swap)
-- > , ((modm, xK_n ), sendMessage FocusParent)
-- > , ((modm .|. ctrlMask, xK_n ), sendMessage SelectNode)
-- > , ((modm .|. shiftMask, xK_n ), sendMessage MoveNode)
-- > , ((modm .|. shiftMask .|. ctrlMask , xK_j ), sendMessage $ SplitShift Prev)
-- > , ((modm .|. shiftMask .|. ctrlMask , xK_k ), sendMessage $ SplitShift Next)
--
-- Here's an alternative key mapping, this time using additionalKeysP,
-- arrow keys, and slightly different behavior when resizing windows
@ -92,7 +96,9 @@ import Data.Ratio ((%))
-- > , ("M-M1-C-<Up>", sendMessage $ ShrinkFrom D)
-- > , ("M-M1-C-<Down>", sendMessage $ ExpandTowards D)
-- > , ("M-s", sendMessage $ BSP.Swap)
-- > , ("M-M1-s", sendMessage $ Rotate) ]
-- > , ("M-M1-s", sendMessage $ Rotate)
-- > , ("M-S-C-j", sendMessage $ SplitShift Prev)
-- > , ("M-S-C-k", sendMessage $ SplitShift Next)
--
-- If you have many windows open and the layout begins to look too hard to manage, you can 'Balance'
-- the layout, so that the current splittings are discarded and windows are tiled freshly in a way that
@ -133,6 +139,10 @@ instance Message SelectMoveNode
data Axis = Horizontal | Vertical deriving (Show, Read, Eq)
-- |Message for shifting window by splitting its neighbour
data SplitShiftDirectional = SplitShift Direction1D deriving Typeable
instance Message SplitShiftDirectional
oppositeDirection :: Direction2D -> Direction2D
oppositeDirection U = D
oppositeDirection D = U
@ -273,6 +283,42 @@ swapCurrent :: Zipper a -> Maybe (Zipper a)
swapCurrent l@(_, []) = Just l
swapCurrent (n, c:cs) = Just (n, swapCrumb c:cs)
insertLeftLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertLeftLeaf (Leaf n) ((Node x l r), crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Node x l r), crumb:cs)
insertLeftLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Leaf x), crumb:cs)
insertLeftLeaf (Node _ _ _) z = Just z
insertRightLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertRightLeaf (Leaf n) ((Node x l r), crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Node x l r) (Leaf n), crumb:cs)
insertRightLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf x) (Leaf n), crumb:cs)
insertRightLeaf (Node _ _ _) z = Just z
findRightLeaf :: Zipper Split -> Maybe (Zipper Split)
findRightLeaf n@(Node _ _ _, _) = goRight n >>= findRightLeaf
findRightLeaf l@(Leaf _, _) = Just l
findLeftLeaf :: Zipper Split -> Maybe (Zipper Split)
findLeftLeaf n@(Node _ _ _, _) = goLeft n
findLeftLeaf l@(Leaf _, _) = Just l
findTheClosestLeftmostLeaf :: Zipper Split -> Maybe (Zipper Split)
findTheClosestLeftmostLeaf s@(_, (RightCrumb _ _):_) = goUp s >>= goLeft >>= findRightLeaf
findTheClosestLeftmostLeaf s@(_, (LeftCrumb _ _):_) = goUp s >>= findTheClosestLeftmostLeaf
findTheClosestRightmostLeaf :: Zipper Split -> Maybe (Zipper Split)
findTheClosestRightmostLeaf s@(_, (RightCrumb _ _):_) = goUp s >>= findTheClosestRightmostLeaf
findTheClosestRightmostLeaf s@(_, (LeftCrumb _ _):_) = goUp s >>= goRight >>= findLeftLeaf
splitShiftLeftCurrent :: Zipper Split -> Maybe (Zipper Split)
splitShiftLeftCurrent l@(_, []) = Just l
splitShiftLeftCurrent l@(_, (RightCrumb _ _):_) = Just l -- Do nothing. We can swap windows instead.
splitShiftLeftCurrent l@(n, c:cs) = removeCurrent l >>= findTheClosestLeftmostLeaf >>= insertRightLeaf n
splitShiftRightCurrent :: Zipper Split -> Maybe (Zipper Split)
splitShiftRightCurrent l@(_, []) = Just l
splitShiftRightCurrent l@(_, (LeftCrumb _ _):_) = Just l -- Do nothing. We can swap windows instead.
splitShiftRightCurrent l@(n, c:cs) = removeCurrent l >>= findTheClosestRightmostLeaf >>= insertLeftLeaf n
isAllTheWay :: Direction2D -> Zipper Split -> Bool
isAllTheWay _ (_, []) = True
isAllTheWay R (_, LeftCrumb s _:_)
@ -513,6 +559,12 @@ swapNth (BinarySpacePartition _ _ _ Nothing) = emptyBSP
swapNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
swapNth b = doToNth swapCurrent b
splitShiftNth :: Direction1D -> BinarySpacePartition a -> BinarySpacePartition a
splitShiftNth _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP
splitShiftNth _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
splitShiftNth Prev b = doToNth splitShiftLeftCurrent b
splitShiftNth Next b = doToNth splitShiftRightCurrent b
growNthTowards :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
growNthTowards _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP
growNthTowards _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
@ -687,6 +739,7 @@ instance LayoutClass BinarySpacePartition Window where
, fmap rotateTr (fromMessage m)
, fmap (balanceTr r) (fromMessage m)
, fmap move (fromMessage m)
, fmap splitShift (fromMessage m)
]
resize (ExpandTowards dir) = growNthTowards dir b
resize (ShrinkFrom dir) = shrinkNthFrom dir b
@ -699,6 +752,7 @@ instance LayoutClass BinarySpacePartition Window where
balanceTr r Balance = resetFoc $ rebalanceNth b r
move MoveNode = resetFoc $ moveNode b
move SelectNode = b --should not happen here, is done above, as we need X monad
splitShift (SplitShift dir) = resetFoc $ splitShiftNth dir b
b = numerateLeaves b_orig
resetFoc bsp = bsp{getFocusedNode=(getFocusedNode bsp){refLeaf=(-1)}

63
XMonad/Layout/BoringWindows.hs
View File

@ -18,8 +18,10 @@ module XMonad.Layout.BoringWindows (
-- * Usage
-- $usage
boringWindows, boringAuto,
markBoring, clearBoring,
focusUp, focusDown, focusMaster,
markBoring, markBoringEverywhere,
clearBoring, focusUp, focusDown,
focusMaster, swapUp, swapDown,
siftUp, siftDown,
UpdateBoring(UpdateBoring),
BoringMessage(Replace,Merge),
@ -33,8 +35,7 @@ module XMonad.Layout.BoringWindows (
import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
LayoutModifier(handleMessOrMaybeModifyIt, redoLayout))
import XMonad(Typeable, LayoutClass, Message, X, fromMessage,
sendMessage, windows, withFocused, Window)
import Control.Applicative((<$>))
broadcastMessage, sendMessage, windows, withFocused, Window)
import Data.List((\\), union)
import Data.Maybe(fromMaybe, listToMaybe, maybeToList)
import qualified Data.Map as M
@ -65,6 +66,10 @@ import qualified XMonad.StackSet as W
data BoringMessage = FocusUp | FocusDown | FocusMaster | IsBoring Window | ClearBoring
| Replace String [Window]
| Merge String [Window]
| SwapUp
| SwapDown
| SiftUp
| SiftDown
deriving ( Read, Show, Typeable )
instance Message BoringMessage
@ -75,12 +80,21 @@ data UpdateBoring = UpdateBoring
deriving (Typeable)
instance Message UpdateBoring
markBoring, clearBoring, focusUp, focusDown, focusMaster :: X ()
markBoring, clearBoring, focusUp, focusDown, focusMaster, swapUp, swapDown, siftUp, siftDown :: X ()
markBoring = withFocused (sendMessage . IsBoring)
clearBoring = sendMessage ClearBoring
focusUp = sendMessage UpdateBoring >> sendMessage FocusUp
focusDown = sendMessage UpdateBoring >> sendMessage FocusDown
focusMaster = sendMessage UpdateBoring >> sendMessage FocusMaster
swapUp = sendMessage UpdateBoring >> sendMessage SwapUp
swapDown = sendMessage UpdateBoring >> sendMessage SwapDown
siftUp = sendMessage UpdateBoring >> sendMessage SiftUp
siftDown = sendMessage UpdateBoring >> sendMessage SiftDown
-- | Mark current focused window boring for all layouts.
-- This is useful in combination with the 'XMonad.Actions.CopyWindow' module.
markBoringEverywhere :: X ()
markBoringEverywhere = withFocused (broadcastMessage . IsBoring)
data BoringWindows a = BoringWindows
{ namedBoring :: M.Map String [a] -- ^ store borings with a specific source
@ -125,12 +139,30 @@ instance LayoutModifier BoringWindows Window where
. skipBoring W.focusUp' -- no boring window gets the focus
. focusMaster'
return Nothing
where skipBoring f st = fromMaybe st $ listToMaybe
$ filter ((`notElem` W.focus st:bs) . W.focus)
$ take (length $ W.integrate st)
$ iterate f st
| Just SwapUp <- fromMessage m =
do windows $ W.modify' skipBoringSwapUp
return Nothing
| Just SwapDown <- fromMessage m =
do windows $ W.modify' (reverseStack . skipBoringSwapUp . reverseStack)
return Nothing
| Just SiftUp <- fromMessage m =
do windows $ W.modify' (siftUpSkipping bs)
return Nothing
| Just SiftDown <- fromMessage m =
do windows $ W.modify' (reverseStack . siftUpSkipping bs . reverseStack)
return Nothing
where skipBoring = skipBoring' ((`notElem` bs) . W.focus)
skipBoringSwapUp = skipBoring'
(maybe True (`notElem` bs) . listToMaybe . W.down)
swapUp'
skipBoring' p f st = fromMaybe st $ listToMaybe
$ filter p
$ drop 1
$ take (length $ W.integrate st)
$ iterate f st
bs = concat $ cbs:maybeToList lbs ++ M.elems nbs
rjl = return . Just . Left
reverseStack (W.Stack t ls rs) = W.Stack t rs ls
handleMessOrMaybeModifyIt _ _ = return Nothing
-- | Variant of 'focusMaster' that works on a
@ -139,6 +171,19 @@ focusMaster' :: W.Stack a -> W.Stack a
focusMaster' c@(W.Stack _ [] _) = c
focusMaster' (W.Stack t ls rs) = W.Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls
swapUp' :: W.Stack a -> W.Stack a
swapUp' (W.Stack t (l:ls) rs) = W.Stack t ls (l:rs)
swapUp' (W.Stack t [] rs) = W.Stack t (reverse rs) []
siftUpSkipping :: Eq a => [a] -> W.Stack a -> W.Stack a
siftUpSkipping bs (W.Stack t ls rs)
| (skips, l:ls') <- spanLeft = W.Stack t ls' (reverse skips ++ l : rs)
| (skips, r:rs') <- spanRight = W.Stack t (rs' ++ r : ls) (reverse skips)
| otherwise = W.Stack t ls rs
where
spanLeft = span (`elem` bs) ls
spanRight = span (`elem` bs) (reverse rs)
{- $simplest
An alternative to 'Full' is "XMonad.Layout.Simplest". Less windows are

20
XMonad/Layout/Combo.hs
View File

@ -77,14 +77,14 @@ combineTwo = C2 [] []
instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a)
=> LayoutClass (CombineTwo (l ()) l1 l2) a where
runLayout (Workspace _ (C2 f w2 super l1 l2) s) rinput = arrange (integrate' s)
where arrange [] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)
l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)
super' <- maybe super id `fmap`
where arrange [] = do l1' <- maybe l1 id <$> handleMessage l1 (SomeMessage ReleaseResources)
l2' <- maybe l2 id <$> handleMessage l2 (SomeMessage ReleaseResources)
super' <- maybe super id <$>
handleMessage super (SomeMessage ReleaseResources)
return ([], Just $ C2 [] [] super' l1' l2')
arrange [w] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)
l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)
super' <- maybe super id `fmap`
arrange [w] = do l1' <- maybe l1 id <$> handleMessage l1 (SomeMessage ReleaseResources)
l2' <- maybe l2 id <$> handleMessage l2 (SomeMessage ReleaseResources)
super' <- maybe super id <$>
handleMessage super (SomeMessage ReleaseResources)
return ([(w,rinput)], Just $ C2 [w] [w] super' l1' l2')
arrange origws =
@ -106,13 +106,13 @@ instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a,
handleMessage (C2 f ws2 super l1 l2) m
| Just (MoveWindowToWindow w1 w2) <- fromMessage m,
w1 `notElem` ws2,
w2 `elem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m
l2' <- maybe l2 id `fmap` handleMessage l2 m
w2 `elem` ws2 = do l1' <- maybe l1 id <$> handleMessage l1 m
l2' <- maybe l2 id <$> handleMessage l2 m
return $ Just $ C2 f (w1:ws2) super l1' l2'
| Just (MoveWindowToWindow w1 w2) <- fromMessage m,
w1 `elem` ws2,
w2 `notElem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m
l2' <- maybe l2 id `fmap` handleMessage l2 m
w2 `notElem` ws2 = do l1' <- maybe l1 id <$> handleMessage l1 m
l2' <- maybe l2 id <$> handleMessage l2 m
let ws2' = case delete w1 ws2 of [] -> [w2]
x -> x
return $ Just $ C2 f ws2' super l1' l2'

51
XMonad/Layout/Decoration.hs
View File

@ -17,7 +17,7 @@ module XMonad.Layout.Decoration
( -- * Usage:
-- $usage
decoration
, Theme (..), defaultTheme, def
, Theme (..), def
, Decoration
, DecorationMsg (..)
, DecorationStyle (..)
@ -68,24 +68,28 @@ decoration s t ds = ModifiedLayout (Decoration (I Nothing) s t ds)
--
-- For a collection of 'Theme's see "XMonad.Util.Themes"
data Theme =
Theme { activeColor :: String -- ^ Color of the active window
, inactiveColor :: String -- ^ Color of the inactive window
, urgentColor :: String -- ^ Color of the urgent window
, activeBorderColor :: String -- ^ Color of the border of the active window
, inactiveBorderColor :: String -- ^ Color of the border of the inactive window
, urgentBorderColor :: String -- ^ Color of the border of the urgent window
, activeTextColor :: String -- ^ Color of the text of the active window
, inactiveTextColor :: String -- ^ Color of the text of the inactive window
, urgentTextColor :: String -- ^ Color of the text of the urgent window
, fontName :: String -- ^ Font name
, decoWidth :: Dimension -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle')
, decoHeight :: Dimension -- ^ Height of the decorations
Theme { activeColor :: String -- ^ Color of the active window
, inactiveColor :: String -- ^ Color of the inactive window
, urgentColor :: String -- ^ Color of the urgent window
, activeBorderColor :: String -- ^ Color of the border of the active window
, inactiveBorderColor :: String -- ^ Color of the border of the inactive window
, urgentBorderColor :: String -- ^ Color of the border of the urgent window
, activeBorderWidth :: Dimension -- ^ Width of the border of the active window
, inactiveBorderWidth :: Dimension -- ^ Width of the border of the inactive window
, urgentBorderWidth :: Dimension -- ^ Width of the border of the urgent window
, activeTextColor :: String -- ^ Color of the text of the active window
, inactiveTextColor :: String -- ^ Color of the text of the inactive window
, urgentTextColor :: String -- ^ Color of the text of the urgent window
, fontName :: String -- ^ Font name
, decoWidth :: Dimension -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle')
, decoHeight :: Dimension -- ^ Height of the decorations
, windowTitleAddons :: [(String, Align)] -- ^ Extra text to appear in a window's title bar.
-- Refer to for a use "XMonad.Layout.ImageButtonDecoration"
, windowTitleIcons :: [([[Bool]], Placement)] -- ^ Extra icons to appear in a window's title bar.
-- Inner @[Bool]@ is a row in a icon bitmap.
} deriving (Show, Read)
-- | The default xmonad 'Theme'.
instance Default Theme where
def =
Theme { activeColor = "#999999"
@ -94,6 +98,9 @@ instance Default Theme where
, activeBorderColor = "#FFFFFF"
, inactiveBorderColor = "#BBBBBB"
, urgentBorderColor = "##00FF00"
, activeBorderWidth = 1
, inactiveBorderWidth = 1
, urgentBorderWidth = 1
, activeTextColor = "#FFFFFF"
, inactiveTextColor = "#BFBFBF"
, urgentTextColor = "#FF0000"
@ -104,11 +111,6 @@ instance Default Theme where
, windowTitleIcons = []
}
{-# DEPRECATED defaultTheme "Use def (from Data.Default, and re-exported by XMonad.Layout.Decoration) instead." #-}
-- | The default xmonad 'Theme'.
defaultTheme :: Theme
defaultTheme = def
-- | A 'Decoration' layout modifier will handle 'SetTheme', a message
-- to dynamically change the decoration 'Theme'.
data DecorationMsg = SetTheme Theme deriving ( Typeable )
@ -313,7 +315,7 @@ handleMouseFocusDrag ds (DS dwrs _) ButtonEvent { ev_window = ew
distFromLeft = ex - fi dx
distFromRight = fi dwh - (ex - fi dx)
dealtWith <- decorationCatchClicksHook ds mainw (fi distFromLeft) (fi distFromRight)
when (not dealtWith) $ do
when (not dealtWith) $
mouseDrag (\x y -> focus mainw >> decorationWhileDraggingHook ds ex ey (mainw, r) x y)
(decorationAfterDraggingHook ds (mainw, r) ew)
handleMouseFocusDrag _ _ _ = return ()
@ -394,10 +396,11 @@ updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do
_ | focusw == win -> ac
| win `elem` ur -> uc
| otherwise -> ic) . W.peek)
`fmap` gets windowset
(bc,borderc,tc) <- focusColor w (inactiveColor t, inactiveBorderColor t, inactiveTextColor t)
(activeColor t, activeBorderColor t, activeTextColor t)
(urgentColor t, urgentBorderColor t, urgentTextColor t)
<$> gets windowset
(bc,borderc,borderw,tc) <-
focusColor w (inactiveColor t, inactiveBorderColor t, inactiveBorderWidth t, inactiveTextColor t)
(activeColor t, activeBorderColor t, activeBorderWidth t, activeTextColor t)
(urgentColor t, urgentBorderColor t, urgentBorderWidth t, urgentTextColor t)
let s = shrinkIt sh
name <- shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy fs n
return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw)
@ -405,7 +408,7 @@ updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do
strs = name : map fst (windowTitleAddons t)
i_als = map snd (windowTitleIcons t)
icons = map fst (windowTitleIcons t)
paintTextAndIcons dw fs wh ht 1 bc borderc tc bc als strs i_als icons
paintTextAndIcons dw fs wh ht borderw bc borderc tc bc als strs i_als icons
updateDeco _ _ _ (_,(Just w,Nothing)) = hideWindow w
updateDeco _ _ _ _ = return ()

1
XMonad/Layout/DecorationAddons.hs
View File

@ -30,7 +30,6 @@ import XMonad.Hooks.ManageDocks
import XMonad.Util.Font
import XMonad.Util.PositionStore
import Control.Applicative((<$>))
import Data.Maybe
import qualified Data.Set as S

2
XMonad/Layout/DecorationMadness.hs
View File

@ -82,7 +82,7 @@ module XMonad.Layout.DecorationMadness
, floatDwmStyle
, floatSimpleTabbed
, floatTabbed
, def, defaultTheme, shrinkText
, def, shrinkText
) where
import XMonad

4
XMonad/Layout/DragPane.hs
View File

@ -81,14 +81,14 @@ handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x
-- layout specific messages
| Just Shrink <- fromMessage x = return $ Just (DragPane mb ty delta (split - delta))
| Just Expand <- fromMessage x = return $ Just (DragPane mb ty delta (split + delta))
| Just (SetFrac ident' frac) <- fromMessage x, ident' == ident = do
| Just (SetFrac ident' frac) <- fromMessage x, ident' == ident =
return $ Just (DragPane mb ty delta frac)
handleMess _ _ = return Nothing
handleEvent :: DragPane a -> Event -> X ()
handleEvent (DragPane (I (Just (win,r,ident))) ty _ _)
(ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t })
| t == buttonPress && thisw == win || thisbw == win = do
| t == buttonPress && thisw == win || thisbw == win =
mouseDrag (\ex ey -> do
let frac = case ty of
Vertical -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r)

1
XMonad/Layout/DwmStyle.hs
View File

@ -18,7 +18,6 @@ module XMonad.Layout.DwmStyle
dwmStyle
, Theme (..)
, def
, defaultTheme
, DwmStyle (..)
, shrinkText, CustomShrink(CustomShrink)
, Shrinker(..)

2
XMonad/Layout/FixedColumn.hs
View File

@ -84,7 +84,7 @@ instance LayoutClass FixedColumn Window where
widthCols :: Int -> Int -> Window -> X Int
widthCols inc n w = withDisplay $ \d -> io $ do
sh <- getWMNormalHints d w
bw <- fmap (fromIntegral . wa_border_width) $ getWindowAttributes d w
bw <- fromIntegral . wa_border_width <$> getWindowAttributes d w
let widthHint f = f sh >>= return . fromIntegral . fst
oneCol = fromMaybe inc $ widthHint sh_resize_inc
base = fromMaybe 0 $ widthHint sh_base_size

53
XMonad/Layout/Fullscreen.hs
View File

@ -30,17 +30,20 @@ module XMonad.Layout.Fullscreen
,FullscreenFloat, FullscreenFocus, FullscreenFull
) where
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Util.WindowProperties
import XMonad.Hooks.ManageHelpers (isFullscreen)
import qualified XMonad.StackSet as W
import Data.List
import Data.Maybe
import Data.Monoid
import qualified Data.Map as M
import Control.Monad
import Control.Arrow (second)
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Hooks.EwmhDesktops (fullscreenStartup)
import XMonad.Hooks.ManageHelpers (isFullscreen)
import XMonad.Util.WindowProperties
import qualified XMonad.Util.Rectangle as R
import qualified XMonad.StackSet as W
import Data.List
import Data.Maybe
import Data.Monoid
import qualified Data.Map as M
import Control.Monad
import Control.Arrow (second)
-- $usage
-- Provides a ManageHook and an EventHook that sends layout messages
@ -75,7 +78,8 @@ fullscreenSupport :: LayoutClass l Window =>
fullscreenSupport c = c {
layoutHook = fullscreenFull $ layoutHook c,
handleEventHook = handleEventHook c <+> fullscreenEventHook,
manageHook = manageHook c <+> fullscreenManageHook
manageHook = manageHook c <+> fullscreenManageHook,
startupHook = startupHook c <+> fullscreenStartup
}
-- | Messages that control the fullscreen state of the window.
@ -107,9 +111,12 @@ instance LayoutModifier FullscreenFull Window where
_ -> Nothing
pureModifier (FullscreenFull frect fulls) rect _ list =
(map (flip (,) rect') visfulls ++ rest, Nothing)
where visfulls = intersect fulls $ map fst list
rest = filter (flip notElem visfulls . fst) list
(visfulls' ++ rest', Nothing)
where (visfulls,rest) = partition (flip elem fulls . fst) list
visfulls' = map (second $ const rect') visfulls
rest' = if null visfulls'
then rest
else filter (not . R.supersetOf rect' . snd) rest
rect' = scaleRationalRect rect frect
instance LayoutModifier FullscreenFocus Window where
@ -122,14 +129,14 @@ instance LayoutModifier FullscreenFocus Window where
pureModifier (FullscreenFocus frect fulls) rect (Just (W.Stack {W.focus = f})) list
| f `elem` fulls = ((f, rect') : rest, Nothing)
| otherwise = (list, Nothing)
where rest = filter ((/= f) . fst) list
where rest = filter (not . orP (== f) (R.supersetOf rect')) list
rect' = scaleRationalRect rect frect
pureModifier _ _ Nothing list = (list, Nothing)
instance LayoutModifier FullscreenFloat Window where
handleMess (FullscreenFloat frect fulls) m = case fromMessage m of
Just (AddFullscreen win) -> do
mrect <- (M.lookup win . W.floating) `fmap` gets windowset
mrect <- (M.lookup win . W.floating) <$> gets windowset
return $ case mrect of
Just rect -> Just $ FullscreenFloat frect $ M.insert win (rect,True) fulls
Nothing -> Nothing
@ -191,15 +198,14 @@ fullscreenEventHook :: Event -> X All
fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
wmstate <- getAtom "_NET_WM_STATE"
fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
wstate <- fromMaybe [] `fmap` getProp32 wmstate win
wstate <- fromMaybe [] <$> getProp32 wmstate win
let fi :: (Integral i, Num n) => i -> n
fi = fromIntegral
isFull = fi fullsc `elem` wstate
remove = 0
add = 1
toggle = 2
ptype = 4
chWState f = io $ changeProperty32 dpy win wmstate ptype propModeReplace (f wstate)
chWState f = io $ changeProperty32 dpy win wmstate aTOM propModeReplace (f wstate)
when (typ == wmstate && fi fullsc `elem` dats) $ do
when (action == add || (action == toggle && not isFull)) $ do
chWState (fi fullsc:)
@ -215,7 +221,7 @@ fullscreenEventHook (DestroyWindowEvent {ev_window = w}) = do
-- When a window is destroyed, the layouts should remove that window
-- from their states.
broadcastMessage $ RemoveFullscreen w
cw <- (W.workspace . W.current) `fmap` gets windowset
cw <- (W.workspace . W.current) <$> gets windowset
sendMessageWithNoRefresh FullscreenChanged cw
return $ All True
@ -236,7 +242,10 @@ fullscreenManageHook' isFull = isFull --> do
w <- ask
liftX $ do
broadcastMessage $ AddFullscreen w
cw <- (W.workspace . W.current) `fmap` gets windowset
cw <- (W.workspace . W.current) <$> gets windowset
sendMessageWithNoRefresh FullscreenChanged cw
idHook
-- | Applies a pair of predicates to a pair of operands, combining them with ||.
orP :: (a -> Bool) -> (b -> Bool) -> (a, b) -> Bool
orP f g (x, y) = f x || g y

72
XMonad/Layout/Gaps.hs
View File

@ -14,7 +14,9 @@
-- be used for tiling, along with support for toggling gaps on and
-- off.
--
-- Note that "XMonad.Hooks.ManageDocks" is the preferred solution for
-- Note 1: For gaps\/space around /windows/ see "XMonad.Layout.Spacing".
--
-- Note 2: "XMonad.Hooks.ManageDocks" is the preferred solution for
-- leaving space for your dock-type applications (status bars,
-- toolbars, docks, etc.), since it automatically sets up appropriate
-- gaps, allows them to be toggled, etc. However, this module may
@ -29,8 +31,8 @@ module XMonad.Layout.Gaps (
-- * Usage
-- $usage
Direction2D(..), Gaps,
GapSpec, gaps, gaps', GapMessage(..)
GapSpec, gaps, gaps', GapMessage(..),
weakModifyGaps, modifyGap, setGaps, setGap
) where
import XMonad.Core
@ -55,10 +57,23 @@ import Data.List (delete)
-- You can additionally add some keybindings to toggle or modify the gaps,
-- for example:
--
-- > , ((modm .|. controlMask, xK_g), sendMessage $ ToggleGaps) -- toggle all gaps
-- > , ((modm .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap
-- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap 5 R) -- increment the right-hand gap
-- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap 5 R) -- decrement the right-hand gap
-- > , ((modm .|. controlMask, xK_g), sendMessage $ ToggleGaps) -- toggle all gaps
-- > , ((modm .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap
-- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap 5 R) -- increment the right-hand gap
-- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap 5 R) -- decrement the right-hand gap
-- > , ((modm .|. controlMask, xK_r), sendMessage $ ModifyGaps rotateGaps) -- rotate gaps 90 degrees clockwise
-- > , ((modm .|. controlMask, xK_h), sendMessage $ weakModifyGaps halveHor) -- halve the left and right-hand gaps
-- > , ((modm .|. controlMask, xK_d), sendMessage $ modifyGap (*2) L) -- double the left-hand gap
-- > , ((modm .|. controlMask, xK_s), sendMessage $ setGaps [(U,18), (R,23)]) -- reset the GapSpec
-- > , ((modm .|. controlMask, xK_b), sendMessage $ setGap 30 D) -- set the bottom gap to 30
-- > ]
-- > where rotateGaps gs = zip (map (rotate . fst) gs) (map snd gs)
-- > rotate U = R
-- > rotate R = D
-- > rotate D = L
-- > rotate L = U
-- > halveHor d i | d `elem` [L, R] = i `div` 2
-- > | otherwise = i
--
-- If you want complete control over all gaps, you could include
-- something like this in your keybindings, assuming in this case you
@ -93,6 +108,7 @@ data GapMessage = ToggleGaps -- ^ Toggle all gaps.
| ToggleGap !Direction2D -- ^ Toggle a single gap.
| IncGap !Int !Direction2D -- ^ Increase a gap by a certain number of pixels.
| DecGap !Int !Direction2D -- ^ Decrease a gap.
| ModifyGaps (GapSpec -> GapSpec) -- ^ Modify arbitrarily.
deriving (Typeable)
instance Message GapMessage
@ -106,11 +122,46 @@ instance LayoutModifier Gaps a where
| Just (ToggleGap d) <- fromMessage m
= Just $ Gaps conf (toggleGap conf cur d)
| Just (IncGap i d) <- fromMessage m
= Just $ Gaps (incGap conf d i) cur
= Just $ Gaps (limit . continuation (+ i ) d $ conf) cur
| Just (DecGap i d) <- fromMessage m
= Just $ Gaps (incGap conf d (-i)) cur
= Just $ Gaps (limit . continuation (+(-i)) d $ conf) cur
| Just (ModifyGaps f) <- fromMessage m
= Just $ Gaps (limit . f $ conf) cur
| otherwise = Nothing
-- | Modifies gaps weakly, for convenience.
weakModifyGaps :: (Direction2D -> Int -> Int) -> GapMessage
weakModifyGaps = ModifyGaps . weakToStrong
-- | Arbitrarily modify a single gap with the given function.
modifyGap :: (Int -> Int) -> Direction2D -> GapMessage
modifyGap f d = ModifyGaps $ continuation f d
-- | Set the GapSpec.
setGaps :: GapSpec -> GapMessage
setGaps = ModifyGaps . const
-- | Set a gap to the given value.
setGap :: Int -> Direction2D -> GapMessage
setGap = modifyGap . const
-- | Imposes limits upon a GapSpec, ensuring gaps are at least 0. Not exposed.
limit :: GapSpec -> GapSpec
limit = weakToStrong $ \_ -> max 0
-- | Takes a weak gaps-modifying function f and returns a GapSpec modifying
-- function. Not exposed.
weakToStrong :: (Direction2D -> Int -> Int) -> GapSpec -> GapSpec
weakToStrong f gs = zip (map fst gs) (map (uncurry f) gs)
-- | Given f as a definition for the behaviour of a gaps modifying function in
-- one direction d, produces a continuation of the function to the other
-- directions using the identity. Not exposed.
continuation :: (Int -> Int) -> Direction2D -> GapSpec -> GapSpec
continuation f d1 = weakToStrong h
where h d2 | d2 == d1 = f
| otherwise = id
applyGaps :: Gaps a -> Rectangle -> Rectangle
applyGaps gs r = foldr applyGap r (activeGaps gs)
where
@ -131,9 +182,6 @@ toggleGap conf cur d | d `elem` cur = delete d cur
| d `elem` (map fst conf) = d:cur
| otherwise = cur
incGap :: GapSpec -> Direction2D -> Int -> GapSpec
incGap gs d i = map (\(dir,j) -> if dir == d then (dir,max (j+i) 0) else (dir,j)) gs
-- | Add togglable manual gaps to a layout.
gaps :: GapSpec -- ^ The gaps to allow, paired with their initial sizes.
-> l a -- ^ The layout to modify.

2
XMonad/Layout/Grid.hs
View File

@ -56,7 +56,7 @@ arrange :: Double -> Rectangle -> [a] -> [(a, Rectangle)]
arrange aspectRatio (Rectangle rx ry rw rh) st = zip st rectangles
where
nwins = length st
ncols = max 1 . round . sqrt $ fromIntegral nwins * fromIntegral rw / (fromIntegral rh * aspectRatio)
ncols = max 1 . min nwins . round . sqrt $ fromIntegral nwins * fromIntegral rw / (fromIntegral rh * aspectRatio)
mincs = max 1 $ nwins `div` ncols
extrs = nwins - ncols * mincs
chop :: Int -> Dimension -> [(Position, Dimension)]

92
XMonad/Layout/Groups.hs
View File

@ -1,6 +1,6 @@
{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-}
{-# LANGUAGE StandaloneDeriving, FlexibleContexts, DeriveDataTypeable
, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses
, UndecidableInstances, FlexibleInstances, LambdaCase, MultiParamTypeClasses
, PatternGuards, Rank2Types, TypeSynonymInstances #-}
-----------------------------------------------------------------------------
@ -25,6 +25,7 @@ module XMonad.Layout.Groups ( -- * Usage
-- * Messages
, GroupsMessage(..)
, ModifySpec
, ModifySpecX
-- ** Useful 'ModifySpec's
, swapUp
, swapDown
@ -60,8 +61,8 @@ import XMonad.Util.Stack
import Data.Maybe (isJust, isNothing, fromMaybe, catMaybes, fromJust)
import Data.List ((\\))
import Control.Arrow ((>>>))
import Control.Applicative ((<$>))
import Control.Monad (forM)
import Control.Applicative ((<|>))
import Control.Monad (forM,void)
-- $usage
-- This module provides a layout combinator that allows you
@ -99,7 +100,6 @@ group :: l Window -> l2 (Group l Window) -> Groups l l2 Window
group l l2 = Groups l l2 startingGroups (U 1 0)
where startingGroups = fromJust $ singletonZ $ G (ID (U 0 0) l) emptyZ
-- * Stuff with unique keys
data Uniq = U Integer Integer
@ -187,6 +187,7 @@ data GroupsMessage = ToEnclosing SomeMessage -- ^ Send a message to the enclosin
-- to the layout.
| Modify ModifySpec -- ^ Modify the ordering\/grouping\/focusing
-- of windows according to a 'ModifySpec'
| ModifyX ModifySpecX -- ^ Same as 'Modify', but within the 'X' monad
deriving Typeable
instance Show GroupsMessage where
@ -206,6 +207,13 @@ modifyGroups f g = let (seed', id:_) = gen (seed g)
in g { groups = fromMaybe defaultGroups . f . Just $ groups g
, seed = seed' }
modifyGroupsX :: (Zipper (Group l a) -> X (Zipper (Group l a)))
-> Groups l l2 a -> X (Groups l l2 a)
modifyGroupsX f g = do
let (seed', id:_) = gen (seed g)
defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ
g' <- f . Just $ groups g
return g { groups = fromMaybe defaultGroups g', seed = seed' }
-- ** Readaptation
@ -303,9 +311,12 @@ instance (LayoutClass l Window, LayoutClass l2 (Group l Window))
Just (ToGroup i sm') -> do mg's <- handleOnIndex i sm' z
return $ maybeMakeNew l Nothing mg's
Just (Modify spec) -> case applySpec spec l of
Just l' -> refocus l' >> return (Just l')
Nothing -> return $ Just l
Just Refocus -> refocus l >> return (Just l)
Just l' -> refocus l'
Nothing -> return Nothing
Just (ModifyX spec) -> do ml' <- applySpecX spec l
whenJust ml' (void . refocus)
return (ml' <|> Just l)
Just Refocus -> refocus l
Just _ -> return Nothing
Nothing -> handleMessage l $ SomeMessage (ToFocused sm)
where handleOnFocused sm z = mapZM step $ Just z
@ -332,10 +343,10 @@ maybeMakeNew :: Groups l l2 a -> Maybe (l2 (Group l a)) -> [Maybe (WithID l a)]
maybeMakeNew _ Nothing ml's | all isNothing ml's = Nothing
maybeMakeNew g mpart' ml's = justMakeNew g mpart' ml's
refocus :: Groups l l2 Window -> X ()
refocus g = case getFocusZ $ gZipper $ W.focus $ groups g
of Just w -> focus w
Nothing -> return ()
refocus :: Groups l l2 Window -> X (Maybe (Groups l l2 Window))
refocus g =
let mw = (getFocusZ . gZipper . W.focus . groups) g
in g <$ mw <$ whenJust mw (modifyWindowSet . W.focusWindow)
-- ** ModifySpec type
@ -361,29 +372,50 @@ type ModifySpec = forall l. WithID l Window
-> Zipper (Group l Window)
-> Zipper (Group l Window)
-- ** ModifierSpecX type
-- | This is the same as 'ModifySpec', but it allows the function to use
-- actions inside the 'X' monad. This is useful, for example, if the function
-- has to make decisions based on the results of a 'runQuery'.
type ModifySpecX = forall l. WithID l Window
-> Zipper (Group l Window)
-> X (Zipper (Group l Window))
-- | Apply a ModifySpec.
applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window)
applySpec f g = let (seed', id:ids) = gen $ seed g
g' = flip modifyGroups g $ f (ID id $ baseLayout g)
>>> toTags
>>> foldr reID ((ids, []), [])
>>> snd
>>> fromTags
in case groups g == groups g' of
True -> Nothing
False -> Just g' { seed = seed' }
where reID eg ((id:ids, seen), egs)
= let myID = getID $ gLayout $ fromE eg
in case elem myID seen of
False -> ((id:ids, myID:seen), eg:egs)
True -> ((ids, seen), mapE_ (setID id) eg:egs)
where setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z
reID _ (([], _), _) = undefined -- The list of ids is infinite
applySpec f g =
let (seed', id:ids) = gen $ seed g
g' = flip modifyGroups g $ f (ID id $ baseLayout g)
>>> toTags
>>> foldr (reID g) ((ids, []), [])
>>> snd
>>> fromTags
in case groups g == groups g' of
True -> Nothing
False -> Just g' { seed = seed' }
applySpecX :: ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window))
applySpecX f g = do
let (seed', id:ids) = gen $ seed g
g' <- flip modifyGroupsX g $ f (ID id $ baseLayout g)
>>> fmap toTags
>>> fmap (foldr (reID g) ((ids, []), []))
>>> fmap snd
>>> fmap fromTags
return $ case groups g == groups g' of
True -> Nothing
False -> Just g' { seed = seed' }
reID :: Groups l l2 Window
-> Either (Group l Window) (Group l Window)
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
reID _ _ (([], _), _) = undefined -- The list of ids is infinite
reID g eg ((id:ids, seen), egs) = case elem myID seen of
False -> ((id:ids, myID:seen), eg:egs)
True -> ((ids, seen), mapE_ (setID id) eg:egs)
where myID = getID $ gLayout $ fromE eg
setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z
-- ** Misc. ModifySpecs

6
XMonad/Layout/Groups/Examples.hs
View File

@ -37,7 +37,6 @@ module XMonad.Layout.Groups.Examples ( -- * Usage
, fullTabs
, TiledTabsConfig(..)
, def
, defaultTiledTabsConfig
, increaseNMasterGroups
, decreaseNMasterGroups
, shrinkMasterGroups
@ -48,7 +47,6 @@ module XMonad.Layout.Groups.Examples ( -- * Usage
-- * Useful re-exports and utils
, module XMonad.Layout.Groups.Helpers
, shrinkText
, defaultTheme
, GroupEQ(..)
, zoomRowG
) where
@ -205,10 +203,6 @@ data TiledTabsConfig s = TTC { vNMaster :: Int
instance s ~ DefaultShrinker => Default (TiledTabsConfig s) where
def = TTC 1 0.5 (3/100) 1 0.5 (3/100) shrinkText def
{-# DEPRECATED defaultTiledTabsConfig "Use def (from Data.Default, and re-exported by XMonad.Layout.Groups) instead." #-}
defaultTiledTabsConfig :: TiledTabsConfig DefaultShrinker
defaultTiledTabsConfig = def
fullTabs c = _tab c $ G.group _tabs $ Full ||| _vert c ||| _horiz c
tallTabs c = _tab c $ G.group _tabs $ _vert c ||| _horiz c ||| Full

4
XMonad/Layout/Groups/Helpers.hs
View File

@ -45,7 +45,7 @@ import qualified XMonad.StackSet as W
import qualified XMonad.Layout.Groups as G
import XMonad.Actions.MessageFeedback
import XMonad.Actions.MessageFeedback (sendMessageB)
import Control.Monad (unless)
import qualified Data.Map as M
@ -92,7 +92,7 @@ alt :: G.ModifySpec -> (WindowSet -> WindowSet) -> X ()
alt f g = alt2 (G.Modify f) $ windows g
alt2 :: G.GroupsMessage -> X () -> X ()
alt2 m x = do b <- send m
alt2 m x = do b <- sendMessageB m
unless b x
-- | Swap the focused window with the previous one

1
XMonad/Layout/Groups/Wmii.hs
View File

@ -31,7 +31,6 @@ module XMonad.Layout.Groups.Wmii ( -- * Usage
-- * Useful re-exports
, shrinkText
, def
, defaultTheme
, module XMonad.Layout.Groups.Helpers ) where
import XMonad hiding ((|||))

36
XMonad/Layout/Hidden.hs
View File

@ -20,11 +20,13 @@
module XMonad.Layout.Hidden
( -- * Usage
-- $usage
HiddenMsg (..)
HiddenWindows
, HiddenMsg (..)
, hiddenWindows
, hideWindow
, popOldestHiddenWindow
, popNewestHiddenWindow
, popHiddenWindow
) where
--------------------------------------------------------------------------------
@ -62,9 +64,10 @@ data HiddenWindows a = HiddenWindows [Window] deriving (Show, Read)
--------------------------------------------------------------------------------
-- | Messages for the @HiddenWindows@ layout modifier.
data HiddenMsg = HideWindow Window -- ^ Hide a window.
| PopNewestHiddenWindow -- ^ Restore window (FILO).
| PopOldestHiddenWindow -- ^ Restore window (FIFO).
data HiddenMsg = HideWindow Window -- ^ Hide a window.
| PopNewestHiddenWindow -- ^ Restore window (FILO).
| PopOldestHiddenWindow -- ^ Restore window (FIFO).
| PopSpecificHiddenWindow Window -- ^ Restore specific window.
deriving (Typeable, Eq)
instance Message HiddenMsg
@ -72,10 +75,11 @@ instance Message HiddenMsg
--------------------------------------------------------------------------------
instance LayoutModifier HiddenWindows Window where
handleMess h@(HiddenWindows hidden) mess
| Just (HideWindow win) <- fromMessage mess = hideWindowMsg h win
| Just (PopNewestHiddenWindow) <- fromMessage mess = popNewestMsg h
| Just (PopOldestHiddenWindow) <- fromMessage mess = popOldestMsg h
| Just ReleaseResources <- fromMessage mess = doUnhook
| Just (HideWindow win) <- fromMessage mess = hideWindowMsg h win
| Just (PopNewestHiddenWindow) <- fromMessage mess = popNewestMsg h
| Just (PopOldestHiddenWindow) <- fromMessage mess = popOldestMsg h
| Just (PopSpecificHiddenWindow win) <- fromMessage mess = popSpecificMsg win h
| Just ReleaseResources <- fromMessage mess = doUnhook
| otherwise = return Nothing
where doUnhook = do mapM_ restoreWindow hidden
return Nothing
@ -107,6 +111,9 @@ popOldestHiddenWindow = sendMessage PopOldestHiddenWindow
popNewestHiddenWindow :: X ()
popNewestHiddenWindow = sendMessage PopNewestHiddenWindow
popHiddenWindow :: Window -> X ()
popHiddenWindow = sendMessage . PopSpecificHiddenWindow
--------------------------------------------------------------------------------
hideWindowMsg :: HiddenWindows a -> Window -> X (Maybe (HiddenWindows a))
hideWindowMsg (HiddenWindows hidden) win = do
@ -128,7 +135,16 @@ popOldestMsg (HiddenWindows (win:rest)) = do
restoreWindow win
return . Just . HiddenWindows $ rest
--------------------------------------------------------------------------------
popSpecificMsg :: Window -> HiddenWindows a -> X (Maybe (HiddenWindows a))
popSpecificMsg _ (HiddenWindows []) = return Nothing
popSpecificMsg win (HiddenWindows hiddenWins) = if win `elem` hiddenWins
then do
restoreWindow win
return . Just . HiddenWindows $ filter (/= win) hiddenWins
else
return . Just . HiddenWindows $ hiddenWins
--------------------------------------------------------------------------------
restoreWindow :: Window -> X ()
restoreWindow win =
modify (\s -> s { windowset = W.insertUp win $ windowset s })
restoreWindow = windows . W.insertUp

1
XMonad/Layout/IfMax.hs
View File

@ -23,7 +23,6 @@ module XMonad.Layout.IfMax
, ifMax
) where
import Control.Applicative((<$>))
import Control.Arrow
import qualified Data.List as L
import qualified Data.Map as M

8
XMonad/Layout/IndependentScreens.hs
View File

@ -29,7 +29,7 @@ module XMonad.Layout.IndependentScreens (
) where
-- for the screen stuff
import Control.Applicative((<*), liftA2)
import Control.Applicative(liftA2)
import Control.Arrow hiding ((|||))
import Control.Monad
import Data.List (nub, genericLength)
@ -54,7 +54,7 @@ import XMonad.Hooks.DynamicLog
-- to specific workspace names. In the default configuration, only
-- the keybindings for changing workspace do this:
--
-- > keyBindings conf = let m = modMask conf in fromList $
-- > keyBindings conf = let modm = modMask conf in fromList $
-- > {- lots of other keybindings -}
-- > [((m .|. modm, k), windows $ f i)
-- > | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]
@ -62,7 +62,7 @@ import XMonad.Hooks.DynamicLog
--
-- This should change to
--
-- > keyBindings conf = let m = modMask conf in fromList $
-- > keyBindings conf = let modm = modMask conf in fromList $
-- > {- lots of other keybindings -}
-- > [((m .|. modm, k), windows $ onCurrentScreen f i)
-- > | (i, k) <- zip (workspaces' conf) [xK_1 .. xK_9]
@ -121,7 +121,7 @@ onCurrentScreen f vws = screen . current >>= f . flip marshall vws
-- > }
--
countScreens :: (MonadIO m, Integral i) => m i
countScreens = liftM genericLength . liftIO $ openDisplay "" >>= liftA2 (<*) getScreenInfo closeDisplay
countScreens = fmap genericLength . liftIO $ openDisplay "" >>= liftA2 (<*) getScreenInfo closeDisplay
-- | This turns a naive pretty-printer into one that is aware of the
-- independent screens. That is, you can write your pretty printer to behave

4
XMonad/Layout/LayoutBuilder.hs
View File

@ -259,7 +259,7 @@ relBox x y w h = SubBox (Rel x) (Rel y) (Rel w) (Rel h)
--------------------------------------------------------------------------------
instance ( LayoutClass l1 a, LayoutClass l2 a
, Read a, Show a, Show p, Eq a, Typeable a, Predicate p a
, Read a, Show a, Show p, Typeable p, Eq a, Typeable a, Predicate p a
) => LayoutClass (LayoutB l1 l2 p) a where
-- | Update window locations.
@ -370,7 +370,7 @@ sendFocus l@(LayoutB subFocus _ _ _ _ _ _) m = do
-- | Check to see if the given window is currently focused.
isFocus :: (Show a) => Maybe a -> X Bool
isFocus Nothing = return False
isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset
isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) <$> gets windowset
return $ maybe False (\s -> show w == show (W.focus s)) ms
--------------------------------------------------------------------------------

4
XMonad/Layout/LayoutBuilderP.hs
View File

@ -78,7 +78,7 @@ layoutAll box sub =
let a = alwaysTrue (Proxy :: Proxy a)
in LayoutP Nothing Nothing a box Nothing sub Nothing
instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p) =>
instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p, Typeable p) =>
LayoutClass (LayoutP p l1 l2) w where
-- | Update window locations.
@ -147,7 +147,7 @@ sendFocus l@(LayoutP subf _ _ _ _ _ _) m = do foc <- isFocus subf
isFocus :: (Show a) => Maybe a -> X Bool
isFocus Nothing = return False
isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset
isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) <$> gets windowset
return $ maybe False (\s -> show w == (show $ W.focus s)) ms

26
XMonad/Layout/LayoutCombinators.hs
View File

@ -214,7 +214,7 @@ infixr 5 |||
-- layouts, and use those.
--
-- For the ability to select a layout from a prompt, see
-- "Xmonad.Prompt.Layout".
-- "XMonad.Prompt.Layout".
-- | A reimplementation of the combinator of the same name from the
-- xmonad core, providing layout choice, and the ability to support
@ -234,32 +234,32 @@ instance Message JumpToLayout
instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a where
runLayout (Workspace i (NewSelect True l1 l2) ms) r = do (wrs, ml1') <- runLayout (Workspace i l1 ms) r
return (wrs, (\l1' -> NewSelect True l1' l2) `fmap` ml1')
return (wrs, (\l1' -> NewSelect True l1' l2) <$> ml1')
runLayout (Workspace i (NewSelect False l1 l2) ms) r = do (wrs, ml2') <- runLayout (Workspace i l2 ms) r
return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2')
return (wrs, (\l2' -> NewSelect False l1 l2') <$> ml2')
description (NewSelect True l1 _) = description l1
description (NewSelect False _ l2) = description l2
handleMessage l@(NewSelect False _ _) m
| Just Wrap <- fromMessage m = fmap Just $ swap l >>= passOn m
| Just Wrap <- fromMessage m = Just <$> (swap l >>= passOn m)
handleMessage l@(NewSelect amfirst _ _) m
| Just NextLayoutNoWrap <- fromMessage m =
if amfirst then when' isNothing (passOnM m l) $
fmap Just $ swap l >>= passOn (SomeMessage Wrap)
Just <$> (swap l >>= passOn (SomeMessage Wrap))
else passOnM m l
handleMessage l m
| Just NextLayout <- fromMessage m = when' isNothing (passOnM (SomeMessage NextLayoutNoWrap) l) $
fmap Just $ swap l >>= passOn (SomeMessage Wrap)
Just <$> (swap l >>= passOn (SomeMessage Wrap))
handleMessage l@(NewSelect True _ l2) m
| Just (JumpToLayout d) <- fromMessage m, d == description l2 = Just `fmap` swap l
| Just (JumpToLayout d) <- fromMessage m, d == description l2 = Just <$> swap l
handleMessage l@(NewSelect False l1 _) m
| Just (JumpToLayout d) <- fromMessage m, d == description l1 = Just `fmap` swap l
| Just (JumpToLayout d) <- fromMessage m, d == description l1 = Just <$> swap l
handleMessage l m
| Just (JumpToLayout _) <- fromMessage m = when' isNothing (passOnM m l) $
do ml' <- passOnM m $ sw l
case ml' of
Nothing -> return Nothing
Just l' -> Just `fmap` swap (sw l')
Just l' -> Just <$> swap (sw l')
handleMessage (NewSelect b l1 l2) m
| Just ReleaseResources <- fromMessage m =
do ml1' <- handleMessage l1 m
@ -270,21 +270,21 @@ instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a
handleMessage l m = passOnM m l
swap :: (LayoutClass l1 a, LayoutClass l2 a) => NewSelect l1 l2 a -> X (NewSelect l1 l2 a)
swap l = sw `fmap` passOn (SomeMessage Hide) l
swap l = sw <$> passOn (SomeMessage Hide) l
sw :: NewSelect l1 l2 a -> NewSelect l1 l2 a
sw (NewSelect b lt lf) = NewSelect (not b) lt lf
passOn :: (LayoutClass l1 a, LayoutClass l2 a) =>
SomeMessage -> NewSelect l1 l2 a -> X (NewSelect l1 l2 a)
passOn m l = maybe l id `fmap` passOnM m l
passOn m l = maybe l id <$> passOnM m l
passOnM :: (LayoutClass l1 a, LayoutClass l2 a) =>
SomeMessage -> NewSelect l1 l2 a -> X (Maybe (NewSelect l1 l2 a))
passOnM m (NewSelect True lt lf) = do mlt' <- handleMessage lt m
return $ (\lt' -> NewSelect True lt' lf) `fmap` mlt'
return $ (\lt' -> NewSelect True lt' lf) <$> mlt'
passOnM m (NewSelect False lt lf) = do mlf' <- handleMessage lf m
return $ (\lf' -> NewSelect False lt lf') `fmap` mlf'
return $ (\lf' -> NewSelect False lt lf') <$> mlf'
when' :: Monad m => (a -> Bool) -> m a -> m a -> m a
when' f a b = do a1 <- a; if f a1 then b else return a1

1
XMonad/Layout/LayoutHints.hs
View File

@ -35,7 +35,6 @@ import XMonad.Layout.Decoration(isInStack)
import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
LayoutModifier(modifyLayout, redoLayout, modifierDescription))
import XMonad.Util.Types(Direction2D(..))
import Control.Applicative((<$>))
import Control.Arrow(Arrow((***), first, second))
import Control.Monad(join)
import Data.Function(on)

10
XMonad/Layout/LayoutModifier.hs
View File

@ -122,7 +122,7 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
-> Workspace WorkspaceId (l a) a
-> Rectangle
-> X (([(a,Rectangle)], Maybe (l a)), Maybe (m a))
modifyLayoutWithUpdate m w r = flip (,) Nothing `fmap` modifyLayout m w r
modifyLayoutWithUpdate m w r = flip (,) Nothing <$> modifyLayout m w r
-- | 'handleMess' allows you to spy on messages to the underlying
-- layout, in order to have an effect in the X monad, or alter
@ -156,7 +156,7 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
-- simply passes on the message to 'handleMess'.
handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))
handleMessOrMaybeModifyIt m mess = do mm' <- handleMess m mess
return (Left `fmap` mm')
return (Left <$> mm')
-- | 'pureMess' allows you to spy on messages sent to the
-- underlying layout, in order to possibly change the layout
@ -250,13 +250,13 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
-- | The 'LayoutClass' instance for a 'ModifiedLayout' defines the
-- semantics of a 'LayoutModifier' applied to an underlying layout.
instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m l) a where
instance (LayoutModifier m a, LayoutClass l a, Typeable m) => LayoutClass (ModifiedLayout m l) a where
runLayout (Workspace i (ModifiedLayout m l) ms) r =
do ((ws, ml'),mm') <- modifyLayoutWithUpdate m (Workspace i l ms) r
(ws', mm'') <- redoLayout (maybe m id mm') r ms ws
let ml'' = case mm'' `mplus` mm' of
Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
Nothing -> ModifiedLayout m `fmap` ml'
Nothing -> ModifiedLayout m <$> ml'
return (ws', ml'')
handleMessage (ModifiedLayout m l) mess =
@ -266,7 +266,7 @@ instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m
_ -> handleMessage l mess
return $ case mm' of
Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml'
_ -> (ModifiedLayout m) `fmap` ml'
_ -> (ModifiedLayout m) <$> ml'
description (ModifiedLayout m l) = modifyDescription m l
-- | A 'ModifiedLayout' is simply a container for a layout modifier

1
XMonad/Layout/LimitWindows.hs
View File

@ -38,7 +38,6 @@ import XMonad.Layout.LayoutModifier
import XMonad
import qualified XMonad.StackSet as W
import Control.Monad((<=<),guard)
import Control.Applicative((<$>))
import Data.Maybe(fromJust)
-- $usage

2
XMonad/Layout/MagicFocus.hs
View File

@ -105,4 +105,4 @@ followOnlyIf _ _ = return $ All True
-- | Disables focusFollow on the given workspaces:
disableFollowOnWS :: [WorkspaceId] -> X Bool
disableFollowOnWS wses = (`notElem` wses) `fmap` gets (W.currentTag . windowset)
disableFollowOnWS wses = (`notElem` wses) <$> gets (W.currentTag . windowset)

5
XMonad/Layout/Magnifier.hs
View File

@ -23,6 +23,7 @@ module XMonad.Layout.Magnifier
magnifier,
magnifier',
magnifierOff,
maxMagnifierOff,
magnifiercz,
magnifiercz',
maximizeVertical,
@ -98,6 +99,10 @@ magnifier' = ModifiedLayout (Mag 1 (1.5,1.5) On NoMaster)
magnifierOff :: l a -> ModifiedLayout Magnifier l a
magnifierOff = ModifiedLayout (Mag 1 (1.5,1.5) Off All)
-- | A magnifier that greatly magnifies with defaults to Off
maxMagnifierOff :: l a -> ModifiedLayout Magnifier l a
maxMagnifierOff = ModifiedLayout (Mag 1 (1000,1000) Off All)
-- | Increase the size of the window that has focus by a custom zoom,
-- unless if it is one of the the master windows.
magnifiercz' :: Rational -> l a -> ModifiedLayout Magnifier l a

4
XMonad/Layout/Master.hs
View File

@ -90,7 +90,7 @@ data FixMaster a = FixMaster (AddMaster a) deriving (Show, Read)
instance LayoutModifier FixMaster Window where
modifyLayout (FixMaster (AddMaster k d f)) = applyMaster True k d f
modifierDescription (FixMaster a) = "Fix" ++ modifierDescription a
pureMess (FixMaster a) m = liftM FixMaster (pureMess a m)
pureMess (FixMaster a) m = fmap FixMaster (pureMess a m)
fixMastered :: (LayoutClass l a) =>
Rational -- ^ @delta@, the ratio of the screen to resize by
@ -113,7 +113,7 @@ applyMaster f k _ frac wksp rect = do
let st= S.stack wksp
let ws = S.integrate' $ st
let n = length ws + fromEnum f
if n > 1 then do
if n > 1 then
if(n<=k) then
return ((divideCol rect ws), Nothing)
else do

1
XMonad/Layout/MessageControl.hs
View File

@ -32,7 +32,6 @@ import XMonad.StackSet (Workspace(..))
import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
import Data.Typeable (Typeable)
import Control.Applicative ((<$>))
import Control.Arrow (second)
-- $usage

1
XMonad/Layout/Minimize.hs
View File

@ -17,6 +17,7 @@
module XMonad.Layout.Minimize (
-- * Usage
-- $usage
Minimize,
minimize,
) where

8
XMonad/Layout/Mosaic.hs
View File

@ -38,7 +38,8 @@ import Control.Monad(mplus)
import Data.Foldable(Foldable,foldMap, sum)
import Data.Function(on)
import Data.List(sortBy)
import Data.Monoid(Monoid,mempty, mappend)
import Data.Monoid(Monoid,mempty, mappend, (<>))
import Data.Semigroup
-- $usage
@ -117,7 +118,7 @@ instance LayoutClass Mosaic a where
nextIx (ov,ix,mix)
| mix <= 0 || ov = fromIntegral $ nls `div` 2
| otherwise = max 0 $ (*fi (pred nls)) $ min 1 $ ix / fi mix
rect = rects !! maybe (nls `div` 2) round (nextIx `fmap` state)
rect = rects !! maybe (nls `div` 2) round (nextIx <$> state)
state' = fmap (\x@(ov,_,_) -> (ov,nextIx x,pred nls)) state
`mplus` Just (True,fromIntegral nls / 2,pred nls)
ss' = maybe ss (const ss `either` const ssExt) $ zipRemain ss ssExt
@ -202,6 +203,9 @@ instance Monoid (Tree a) where
mappend x Empty = x
mappend x y = Branch x y
instance Semigroup (Tree a) where
(<>) = mappend
makeTree :: (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a
makeTree _ [] = Empty
makeTree _ [x] = Leaf x

13
XMonad/Layout/MouseResizableTile.hs
View File

@ -36,7 +36,7 @@ module XMonad.Layout.MouseResizableTile (
import XMonad hiding (tile, splitVertically, splitHorizontallyBy)
import qualified XMonad.StackSet as W
import XMonad.Util.XUtils
import Control.Applicative((<$>))
import Graphics.X11 as X
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@ -190,9 +190,18 @@ draggerGeometry :: DraggerType -> X DraggerGeometry
draggerGeometry (FixedDragger g d) =
return (fromIntegral $ g `div` 2, g, fromIntegral $ d `div` 2, d)
draggerGeometry BordersDragger = do
w <- asks (borderWidth . config)
wins <- gets windowset
w <- case W.peek wins of
Just win -> getBorderWidth win
_ -> asks (borderWidth . config)
return (0, 0, fromIntegral w, 2*w)
getBorderWidth :: Window -> X Dimension
getBorderWidth win = do
d <- asks display
(_,_,_,_,_,w,_) <- io $ X.getGeometry d win
return w
adjustForMirror :: Bool -> DraggerWithRect -> DraggerWithRect
adjustForMirror False dragger = dragger
adjustForMirror True (draggerRect, draggerCursor, draggerInfo) =

92
XMonad/Layout/MultiDishes.hs Normal file
View File

@ -0,0 +1,92 @@
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.MultiDishes
-- Copyright : (c) Jeremy Apthorp, Nathan Fairhurst
-- License : BSD-style (see LICENSE)
--
-- Maintainer : Nathan Fairhurst <nathan.p3pictures@gmail.com>
-- Stability : unstable
-- Portability : portable
--
-- MultiDishes is a layout that stacks groups of extra windows underneath
-- the master windows.
--
-----------------------------------------------------------------------------
module XMonad.Layout.MultiDishes (
-- * Usage
-- $usage
MultiDishes (..)
) where
import XMonad
import XMonad.StackSet (integrate)
import Control.Monad (ap)
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.MultiDishes
--
-- Then edit your @layoutHook@ by adding the MultiDishes layout:
--
-- > myLayout = MultiDishes 2 3 (1/6) ||| Full ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
-- This is based on the Layout Dishes, but accepts another parameter for
-- the maximum number of dishes allowed within a stack.
--
-- > MultiDishes x 1 y
-- is equivalent to
-- > Dishes x y
--
-- The stack with the fewest dishes is always on top, so 4 windows
-- with the layout `MultiDishes 1 2 (1/5)` would look like this:
--
-- > _________
-- > | |
-- > | M |
-- > |_______|
-- > |_______|
-- > |___|___|
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
data MultiDishes a = MultiDishes Int Int Rational deriving (Show, Read)
instance LayoutClass MultiDishes a where
pureLayout (MultiDishes nmaster dishesPerStack h) r =
ap zip (multiDishes h r nmaster dishesPerStack . length) . integrate
pureMessage (MultiDishes nmaster dishesPerStack h) m = fmap incmastern (fromMessage m)
where incmastern (IncMasterN d) = MultiDishes (max 0 (nmaster+d)) dishesPerStack h
multiDishes :: Rational -> Rectangle -> Int -> Int -> Int -> [Rectangle]
multiDishes h s nmaster dishesPerStack n = if n <= nmaster
then splitHorizontally n s
else ws
where
(filledDishStackCount, remainder) =
(n - nmaster) `quotRem` (max 1 dishesPerStack)
(firstDepth, dishStackCount) =
if remainder == 0 then
(dishesPerStack, filledDishStackCount)
else
(remainder, filledDishStackCount + 1)
(masterRect, dishesRect) =
splitVerticallyBy (1 - (fromIntegral dishStackCount) * h) s
dishStackRects =
splitVertically dishStackCount dishesRect
allDishRects = case dishStackRects of
(firstStack:bottomDishStacks) ->
splitHorizontally firstDepth firstStack ++ (bottomDishStacks >>= splitHorizontally dishesPerStack)
[] -> []
ws =
splitHorizontally nmaster masterRect ++ allDishRects

Some files were not shown because too many files have changed in this diff Show More