Browse Source

Merge branch 'master' into module-MutexScratchpads

master
Brent Yorgey 6 months ago
parent
commit
66c1977c29
No account linked to committer's email address
52 changed files with 4578 additions and 865 deletions
  1. 25
    17
      .travis.yml
  2. 377
    27
      CHANGES.md
  3. 10
    9
      README.md
  4. 11
    2
      XMonad/Actions/Commands.hs
  5. 3
    2
      XMonad/Actions/DynamicProjects.hs
  6. 30
    6
      XMonad/Actions/DynamicWorkspaceOrder.hs
  7. 27
    2
      XMonad/Actions/GroupNavigation.hs
  8. 230
    37
      XMonad/Actions/MessageFeedback.hs
  9. 13
    1
      XMonad/Actions/Minimize.hs
  10. 102
    5
      XMonad/Actions/Navigation2D.hs
  11. 79
    42
      XMonad/Actions/PhysicalScreens.hs
  12. 407
    0
      XMonad/Actions/SwapPromote.hs
  13. 9
    3
      XMonad/Config/Azerty.hs
  14. 1
    1
      XMonad/Config/Gnome.hs
  15. 79
    0
      XMonad/Config/Saegesser.hs
  16. 42
    37
      XMonad/Hooks/DebugEvents.hs
  17. 63
    5
      XMonad/Hooks/DynamicLog.hs
  18. 83
    32
      XMonad/Hooks/EwmhDesktops.hs
  19. 5
    1
      XMonad/Hooks/FadeWindows.hs
  20. 5
    1
      XMonad/Hooks/WallpaperSetter.hs
  21. 139
    0
      XMonad/Layout/BinaryColumn.hs
  22. 23
    15
      XMonad/Layout/Fullscreen.hs
  23. 60
    7
      XMonad/Layout/Gaps.hs
  24. 1
    1
      XMonad/Layout/Grid.hs
  25. 64
    31
      XMonad/Layout/Groups.hs
  26. 2
    2
      XMonad/Layout/Groups/Helpers.hs
  27. 6
    0
      XMonad/Layout/LayoutHints.hs
  28. 5
    1
      XMonad/Layout/Mosaic.hs
  29. 7
    3
      XMonad/Layout/MultiColumns.hs
  30. 92
    0
      XMonad/Layout/MultiDishes.hs
  31. 2
    0
      XMonad/Layout/MultiToggle.hs
  32. 47
    0
      XMonad/Layout/MultiToggle/TabBarDecoration.hs
  33. 200
    61
      XMonad/Layout/NoBorders.hs
  34. 353
    89
      XMonad/Layout/Spacing.hs
  35. 94
    0
      XMonad/Layout/StateFull.hs
  36. 98
    0
      XMonad/Layout/TwoPanePersistent.hs
  37. 786
    320
      XMonad/Prompt.hs
  38. 22
    4
      XMonad/Prompt/AppendFile.hs
  39. 104
    0
      XMonad/Prompt/FuzzyMatch.hs
  40. 65
    10
      XMonad/Prompt/Pass.hs
  41. 67
    40
      XMonad/Prompt/Unicode.hs
  42. 14
    9
      XMonad/Util/Dmenu.hs
  43. 53
    0
      XMonad/Util/Dzen.hs
  44. 13
    10
      XMonad/Util/ExtensibleState.hs
  45. 276
    0
      XMonad/Util/PureX.hs
  46. 214
    0
      XMonad/Util/Rectangle.hs
  47. 64
    0
      XMonad/Util/SessionStart.hs
  48. 29
    6
      XMonad/Util/SpawnOnce.hs
  49. 30
    1
      XMonad/Util/Stack.hs
  50. 18
    0
      XMonad/Util/Themes.hs
  51. 12
    19
      XMonad/Util/WorkspaceCompare.hs
  52. 17
    6
      xmonad-contrib.cabal

+ 25
- 17
.travis.yml View File

@@ -13,27 +13,32 @@ before_cache:

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
- env: GHCVER=8.6.1 CABALVER=2.4
compiler: ": #GHC 8.6.1"
addons: { apt: { packages: [cabal-install-2.4, ghc-8.6.1, libxrandr-dev]
, sources: [hvr-ghc]
} }
- env: GHCVER=8.4.3 CABALVER=2.2
compiler: ": #GHC 8.4.3"
addons: { apt: { packages: [cabal-install-2.2, ghc-8.4.3, libxrandr-dev]
, sources: [hvr-ghc]
} }
- env: GHCVER=8.2.2 CABALVER=2.0
compiler: ": #GHC 8.2.2"
addons: { apt: { packages: [cabal-install-2.0, ghc-8.2.2, libxrandr-dev]
, sources: [hvr-ghc]
} }
- env: GHCVER=8.0.1 CABALVER=1.24
compiler: ": #GHC 8.0.1"
addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
addons: { apt: { packages: [cabal-install-1.24, ghc-8.0.1, libxrandr-dev]
, sources: [hvr-ghc]
} }

before_install:
- unset CC
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH

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 ];
@@ -42,6 +47,11 @@ install:
$HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
fi
- travis_retry cabal update -v

# build xmonad from HEAD
- git clone https://github.com/xmonad/xmonad.git
- cabal install xmonad/

- 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
@@ -57,8 +67,8 @@ install:
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
- cabal install --only-dependencies --enable-tests --enable-benchmarks;

# snapshot package-db on cache miss
- if [ ! -d $HOME/.cabsnap ];
@@ -69,8 +79,6 @@ install:
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.
script:

+ 377
- 27
CHANGES.md View File

@@ -1,26 +1,142 @@
# Change Log / Release Notes

## 0.14 (Not Yet)
## unknown

### Breaking Changes

* Adding handling of modifySpacing message in smartSpacing and smartSpacingWithEdge layout modifier
* `XMonad.Prompt`

* `XMonad.Actions.GridSelect`
- 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.

- Added field `gs_bordercolor` to `GSConfig` to specify border color.
### 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.

### Bug Fixes and Minor Changes

* `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
* `XMonad.Prompt`

not <$> activated
Added `sorter` to `XPConfig` used to sort the possible completions by how
well they match the search string (example: `XMonad.Prompt.FuzzyMatch`).

predicate. By default, with empty `ManageHook`, window activation will do
nothing.
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).

Also, you can use regular 'ManageHook' combinators for changing window
activation behavior.
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.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.


## 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.

* `XMonad.Layout.Minimize`

@@ -32,27 +148,105 @@
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.Util.ExclusiveScratchpads`
* `XMonad.Layout.MultiToggle.TabBarDecoration`

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.
Provides a simple transformer for use with `XMonad.Layout.MultiToggle` to
dynamically toggle `XMonad.Layout.TabBarDecoration`.
* `XMonad.Layout.StateFull`

* `XMonad.Hooks.Focus`
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.

A new module extending ManageHook EDSL to work on focused windows and
current workspace.
* `XMonad.Actions.SwapPromote`

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`.
Module for tracking master window history per workspace, and associated
functions for manipulating the stack using such history.

* `XMonad.Actions.CycleWorkspaceByScreen`

@@ -63,8 +257,98 @@
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
window that is placed on top. This fixes an issue where the border of the
focused window in certain situations could be rendered below borders of
unfocused windows. It also has a lower risk of interfering with the
modified layout.

* `XMonad.Layout.MultiColumns`

The focused window is placed above the other windows if they would be made to
overlap due to a layout modifier. (As long as it preserves the window order.)

* `XMonad.Actions.GridSelect`

- The vertical centring of text in each cell has been improved.
@@ -102,6 +386,10 @@

Make type of ManageHook combinators more general.

* `XMonad.Prompt`

Export `insertString`.

* `XMonad.Prompt.Window`

- New function: `windowMultiPrompt` for using `mkXPromptWithModes`
@@ -118,6 +406,68 @@
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`

- 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)

### Breaking Changes

+ 10
- 9
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

+ 11
- 2
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 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

+ 3
- 2
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
@@ -182,7 +182,8 @@ instance XPrompt ProjectPrompt where
modifyProject (\p -> p { projectName = name })

modeAction (ProjectPrompt DirMode _) buf auto = do
let dir = if null auto then buf else auto
let dir' = if null auto then buf else auto
dir <- io $ makeAbsolute dir'
modifyProject (\p -> p { projectDirectory = dir })

--------------------------------------------------------------------------------

+ 30
- 6
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

+ 27
- 2
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, 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
@@ -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


+ 230
- 37
XMonad/Actions/MessageFeedback.hs View File

@@ -1,7 +1,8 @@
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.MessageFeedback
-- 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. 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:
--
-- > -- Shrink the master area of a tiled layout, or move the focused window
-- > -- to the left in a WindowArranger-based layout
-- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrentB Shrink (MoveLeft 50))
--
-- 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), 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


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

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)

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

-- | 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


-- | 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

tryInOrder_ :: [SomeMessage] -> X ()
tryInOrder_ ms = tryInOrder ms >> return ()

-- | 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." #-}

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'
-- $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 = 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

+ 13
- 1
XMonad/Actions/Minimize.hs View File

@@ -29,6 +29,8 @@ module XMonad.Actions.Minimize
, maximizeWindowAndFocus
, withLastMinimized
, withLastMinimized'
, withFirstMinimized
, withFirstMinimized'
, withMinimized
) where

@@ -85,7 +87,7 @@ modified f = XS.modified $
in Minimized { rectMap = newRectMap
, minimizedStack = (newWindows L.\\ oldStack)
++
(newWindows `L.intersect` oldStack)
(oldStack `L.intersect` newWindows)
}


@@ -115,6 +117,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 ()

+ 102
- 5
XMonad/Actions/Navigation2D.hs View File

@@ -43,6 +43,9 @@ module XMonad.Actions.Navigation2D ( -- * Usage
, Navigation2D
, lineNavigation
, centerNavigation
, sideNavigation
, sideNavigationWithBias
, hybridOf
, hybridNavigation
, fullScreenRect
, singleWindowRect
@@ -59,6 +62,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 +74,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 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 +323,46 @@ lineNavigation = N 1 doLineNavigation
centerNavigation :: Navigation2D
centerNavigation = N 2 doCenterNavigation

-- | 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,
@@ -767,12 +806,54 @@ doCenterNavigation dir (cur, rect) winrects
-- or it has the same distance but comes later
-- in the window stack

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

+ 79
- 42
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

cmpScreen :: Rectangle -> Rectangle -> Ordering
cmpScreen (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2)

sendToScreen :: ScreenComparator -> PhysicalScreen -> X ()
sendToScreen sc p = do i <- getScreen sc p
whenJust i $ \s -> do
w <- screenWorkspace s
whenJust w $ windows . W.shift

-- | 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

neighbourWindows :: Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
neighbourWindows d f = do s <- getNeighbour d
w <- screenWorkspace s
whenJust w $ windows . f
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 :: 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)

+ 407
- 0
XMonad/Actions/SwapPromote.hs View File

@@ -0,0 +1,407 @@
{-# 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.Applicative ((<$>),(<*>))
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)

+ 9
- 3
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

+ 1
- 1
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.

+ 79
- 0
XMonad/Config/Saegesser.hs 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


+ 42
- 37
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
@@ -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
@@ -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

@@ -1176,20 +1178,23 @@ 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