Browse Source

Merge branch 'master' into module-MutexScratchpads

master
Brent Yorgey 3 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:
13 13
 
14 14
 matrix:
15 15
   include:
16
-    - env: CABALVER=1.16 GHCVER=7.6.3
17
-      compiler: ": #GHC 7.6.3"
18
-      addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}}
19
-    - env: CABALVER=1.18 GHCVER=7.8.4
20
-      compiler: ": #GHC 7.8.4"
21
-      addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
22
-    - env: CABALVER=1.22 GHCVER=7.10.3
23
-      compiler: ": #GHC 7.10.3"
24
-      addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}
25
-    - env: CABALVER=1.24 GHCVER=8.0.1
16
+    - env: GHCVER=8.6.1  CABALVER=2.4
17
+      compiler: ": #GHC 8.6.1"
18
+      addons: { apt: { packages: [cabal-install-2.4,  ghc-8.6.1,  libxrandr-dev]
19
+                     , sources:  [hvr-ghc]
20
+                     } }
21
+    - env: GHCVER=8.4.3  CABALVER=2.2
22
+      compiler: ": #GHC 8.4.3"
23
+      addons: { apt: { packages: [cabal-install-2.2,  ghc-8.4.3,  libxrandr-dev]
24
+                     , sources:  [hvr-ghc]
25
+                     } }
26
+    - env: GHCVER=8.2.2  CABALVER=2.0
27
+      compiler: ": #GHC 8.2.2"
28
+      addons: { apt: { packages: [cabal-install-2.0,  ghc-8.2.2,  libxrandr-dev]
29
+                     , sources:  [hvr-ghc]
30
+                     } }
31
+    - env: GHCVER=8.0.1  CABALVER=1.24
26 32
       compiler: ": #GHC 8.0.1"
27
-      addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
33
+      addons: { apt: { packages: [cabal-install-1.24, ghc-8.0.1,  libxrandr-dev]
34
+                     , sources:  [hvr-ghc]
35
+                     } }
28 36
 
29 37
 before_install:
30 38
  - unset CC
31 39
  - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
32 40
 
33 41
 install:
34
- # build xmonad from HEAD
35
- - git clone https://github.com/xmonad/xmonad.git
36
-
37 42
  - cabal --version
38 43
  - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
39 44
  - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];
@@ -42,6 +47,11 @@ install:
42 47
           $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
43 48
    fi
44 49
  - travis_retry cabal update -v
50
+
51
+ # build xmonad from HEAD
52
+ - git clone https://github.com/xmonad/xmonad.git
53
+ - cabal install xmonad/
54
+
45 55
  - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
46 56
  - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt
47 57
  - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt
@@ -57,8 +67,8 @@ install:
57 67
      echo "cabal build-cache MISS";
58 68
      rm -rf $HOME/.cabsnap;
59 69
      mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;
60
-     cabal install --only-dependencies --enable-tests --enable-benchmarks;
61 70
    fi
71
+ - cabal install --only-dependencies --enable-tests --enable-benchmarks;
62 72
 
63 73
 # snapshot package-db on cache miss
64 74
  - if [ ! -d $HOME/.cabsnap ];
@@ -69,8 +79,6 @@ install:
69 79
       cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;
70 80
    fi
71 81
 
72
- - cabal install xmonad/
73
-
74 82
 # Here starts the actual work to be performed for the package under test;
75 83
 # any command which exits with a non-zero exit code causes the build to fail.
76 84
 script:

+ 377
- 27
CHANGES.md View File

@@ -1,26 +1,142 @@
1 1
 # Change Log / Release Notes
2 2
 
3
-## 0.14 (Not Yet)
3
+## unknown
4 4
 
5 5
 ### Breaking Changes
6 6
 
7
-  * Adding handling of modifySpacing message in smartSpacing and smartSpacingWithEdge layout modifier
7
+  * `XMonad.Prompt`
8 8
 
9
-  * `XMonad.Actions.GridSelect`
9
+    - Prompt ships a vim-like keymap, see `vimLikeXPKeymap` and
10
+      `vimLikeXPKeymap'`. A reworked event loop supports new vim-like prompt
11
+      actions.
12
+    - Prompt supports dynamic colors. Colors are now specified by the `XPColor`
13
+      type in `XPState` while `XPConfig` colors remain unchanged for backwards
14
+      compatibility.
15
+    - Fixes `showCompletionOnTab`.
16
+    - The behavior of `moveWord` and `moveWord'` has changed; brought in line
17
+      with the documentation and now internally consistent. The old keymaps
18
+      retain the original behavior; see the documentation to do the same your
19
+      XMonad configuration.
10 20
 
11
-    - Added field `gs_bordercolor` to `GSConfig` to specify border color.
21
+### New Modules
22
+
23
+  * `XMonad.Layout.TwoPanePersistent`
24
+
25
+    A layout that is like TwoPane but keeps track of the slave window that is
26
+    currently beside the master. In TwoPane, the default behavior when the master
27
+    is focused is to display the next window in the stack on the slave pane. This
28
+    is a problem when a different slave window is selected without changing the stack
29
+    order.
30
+
31
+  * `XMonad.Util.ExclusiveScratchpads`
32
+
33
+    Named scratchpads that can be mutually exclusive: This new module extends the
34
+    idea of named scratchpads such that you can define "families of scratchpads"
35
+    that are exclusive on the same screen. It also allows to remove this
36
+    constraint of being mutually exclusive with another scratchpad.
37
+
38
+### Bug Fixes and Minor Changes
12 39
 
13
-  * `ewmh` function from `X.H.EwmhDesktops` will use `manageHook` for handling
14
-    activated window. That means, actions, which you don't want to happen on
15
-    activated windows, should be guarded by
40
+  * `XMonad.Prompt`
16 41
 
17
-        not <$> activated
42
+    Added `sorter` to `XPConfig` used to sort the possible completions by how
43
+    well they match the search string (example: `XMonad.Prompt.FuzzyMatch`).
18 44
 
19
-    predicate. By default, with empty `ManageHook`, window activation will do
20
-    nothing.
45
+    Fixes a potential bug where an error during prompt execution would
46
+    leave the window open and keep the keyboard grabbed. See issue
47
+    [#180](https://github.com/xmonad/xmonad-contrib/issues/180).
21 48
 
22
-    Also, you can use regular 'ManageHook' combinators for changing window
23
-    activation behavior.
49
+    Fixes [issue #217](https://github.com/xmonad/xmonad-contrib/issues/217), where
50
+    using tab to wrap around the completion rows would fail when maxComplRows is
51
+    restricting the number of rows of output.
52
+
53
+  * `XMonad.Actions.DynamicProjects`
54
+
55
+    Make the input directory read from the prompt in `DynamicProjects`
56
+    absolute wrt the current directory.
57
+
58
+    Before this, the directory set by the prompt was treated like a relative
59
+    directory. This means that when you switch from a project with directory
60
+    `foo` into a project with directory `bar`, xmonad actually tries to `cd`
61
+    into `foo/bar`, instead of `~/bar` as expected.
62
+
63
+  * `XMonad.Actions.DynamicWorkspaceOrder`
64
+
65
+    Add a version of `withNthWorkspace` that takes a `[WorkspaceId] ->
66
+    [WorkspaceId]` transformation to apply over the list of workspace tags
67
+    resulting from the dynamic order.
68
+
69
+  * `XMonad.Actions.GroupNavigation`
70
+
71
+    Add a utility function `isOnAnyVisibleWS :: Query Bool` to allow easy
72
+    cycling between all windows on all visible workspaces.
73
+
74
+
75
+## 0.15
76
+
77
+### Breaking Changes
78
+
79
+  * `XMonad.Layout.Groups` & `XMonad.Layout.Groups.Helpers`
80
+    The layout will no longer perform refreshes inside of its message handling.
81
+    If you have been relying on it to in your xmonad.hs, you will need to start
82
+    sending its messages in a manner that properly handles refreshing, e.g. with
83
+    `sendMessage`.
84
+
85
+### New Modules
86
+
87
+  * `XMonad.Util.Purex`
88
+
89
+    Unlike the opaque `IO` actions that `X` actions can wrap, regular reads from
90
+    the `XConf` and modifications to the `XState` are fundamentally pure --
91
+    contrary to the current treatment of such actions in most xmonad code. Pure
92
+    modifications to the `WindowSet` can be readily composed, but due to the
93
+    need for those modifications to be properly handled by `windows`, other pure
94
+    changes to the `XState` cannot be interleaved with those changes to the
95
+    `WindowSet` without superfluous refreshes, hence breaking composability.
96
+
97
+    This module aims to rectify that situation by drawing attention to it and
98
+    providing `PureX`: a pure type with the same monadic interface to state as
99
+    `X`. The `XLike` typeclass enables writing actions generic over the two
100
+    monads; if pure, existing `X` actions can be generalised with only a change
101
+    to the type signature. Various other utilities are provided, in particular
102
+    the `defile` function which is needed by end-users.
103
+
104
+### Bug Fixes and Minor Changes
105
+
106
+  * Add support for GHC 8.6.1.
107
+
108
+  * `XMonad.Actions.MessageHandling`
109
+    Refresh-performing functions updated to better reflect the new `sendMessage`.
110
+
111
+## 0.14
112
+
113
+### Breaking Changes
114
+
115
+  * `XMonad.Layout.Spacing`
116
+
117
+    Rewrite `XMonad.Layout.Spacing`. Borders are no longer uniform but composed
118
+    of four sides each with its own border width. The screen and window borders
119
+    are now separate and can be independently toggled on/off. The screen border
120
+    examines the window/rectangle list resulting from 'runLayout' rather than
121
+    the stack, which makes it compatible with layouts such as the builtin
122
+    `Full`. The child layout will always be called with the screen border. If
123
+    only a single window is displayed (and `smartBorder` enabled), it will be
124
+    expanded into the original layout rectangle. Windows that are displayed but
125
+    not part of the stack, such as those created by 'XMonad.Layout.Decoration',
126
+    will be shifted out of the way, but not scaled (not possible for windows
127
+    created by XMonad). This isn't perfect, so you might want to disable
128
+    `Spacing` on such layouts.
129
+
130
+  * `XMonad.Util.SpawnOnce`
131
+
132
+    - Added `spawnOnOnce`, `spawnNOnOnce` and `spawnAndDoOnce`. These are useful in startup hooks
133
+      to shift spawned windows to a specific workspace.
134
+
135
+  * Adding handling of modifySpacing message in smartSpacing and smartSpacingWithEdge layout modifier
136
+
137
+  * `XMonad.Actions.GridSelect`
138
+
139
+    - Added field `gs_bordercolor` to `GSConfig` to specify border color.
24 140
 
25 141
   * `XMonad.Layout.Minimize`
26 142
 
@@ -32,27 +148,105 @@
32 148
      sending messages to `Minimized` layout. `XMonad.Hooks.RestoreMinimized` has
33 149
      been completely deprecated, and its functions have no effect.
34 150
 
151
+  * `XMonad.Prompt.Unicode`
152
+
153
+    - `unicodePrompt :: String -> XPConfig -> X ()` now additionally takes a
154
+      filepath to the `UnicodeData.txt` file containing unicode data.
155
+
156
+  * `XMonad.Actions.PhysicalScreens`
157
+
158
+    `getScreen`, `viewScreen`, `sendToScreen`, `onNextNeighbour`, `onPrevNeighbour` now need a extra parameter
159
+    of type `ScreenComparator`. This allow the user to specify how he want his screen to be ordered default
160
+    value are:
161
+
162
+     - `def`(same as verticalScreenOrderer) will keep previous behavior
163
+     - `verticalScreenOrderer`
164
+     - `horizontalScreenOrderer`
165
+
166
+    One can build his custom ScreenOrderer using:
167
+     - `screenComparatorById` (allow to order by Xinerama id)
168
+     - `screenComparatorByRectangle` (allow to order by screen coordonate)
169
+     - `ScreenComparator` (allow to mix ordering by screen coordonate and xinerama id)
170
+
171
+  * `XMonad.Util.WorkspaceCompare`
172
+
173
+    `getXineramaPhysicalWsCompare` now need a extra argument of type `ScreenComparator` defined in
174
+    `XMonad.Actions.PhysicalScreens` (see changelog of this module for more information)
175
+
176
+  * `XMonad.Hooks.EwmhDesktops`
177
+
178
+    - Simplify ewmhDesktopsLogHookCustom, and remove the gnome-panel specific
179
+      remapping of all visible windows to the active workspace (#216).
180
+    - Handle workspace renames that might be occuring in the custom function
181
+      that is provided to ewmhDesktopsLogHookCustom.
182
+
183
+  * `XMonad.Hooks.DynamicLog`
184
+
185
+    - Support xmobar's \<action> and \<raw> tags; see `xmobarAction` and
186
+      `xmobarRaw`.
187
+
188
+  * `XMonad.Layout.NoBorders`
189
+
190
+    The layout now maintains a list of windows that never have borders, and a
191
+    list of windows that always have borders. Use `BorderMessage` to manage
192
+    these lists and the accompanying event hook (`borderEventHook`) to remove
193
+    destroyed windows from them. Also provides the `hasBorder` manage hook.
194
+
195
+    Two new conditions have been added to `Ambiguity`: `OnlyLayoutFloat` and
196
+    `OnlyLayoutFloatBelow`; `OnlyFloat` was renamed to `OnlyScreenFloat`.  See
197
+    the documentation for more information.
198
+
199
+    The type signature of `hiddens` was changed to accept a new `Rectangle`
200
+    parameter representing the bounds of the parent layout, placed after the
201
+    `WindowSet` parameter. Anyone defining a new instance of `SetsAmbiguous`
202
+    will need to update their configuration. For example, replace "`hiddens amb
203
+    wset mst wrs =`" either with "`hiddens amb wset _ mst wrs =`" or to make
204
+    use of the new parameter with "`hiddens amb wset lr mst wrs =`".
205
+
206
+  * `XMonad.Actions.MessageFeedback`
207
+
208
+    - Follow the naming conventions of `XMonad.Operations`. Functions returning
209
+      `X ()` are named regularly (previously these ended in underscore) while
210
+      those returning `X Bool` are suffixed with an uppercase 'B'.
211
+    - Provide all `X Bool` and `SomeMessage` variations for `sendMessage` and
212
+      `sendMessageWithNoRefresh`, not just `sendMessageWithNoRefreshToCurrent`
213
+      (renamed from `send`).
214
+    - The new `tryInOrderB` and `tryMessageB` functions accept a parameter of
215
+      type `SomeMessage -> X Bool`, which means you are no longer constrained
216
+      to the behavior of the `sendMessageWithNoRefreshToCurrent` dispatcher.
217
+    - The `send*Messages*` family of funtions allows for sequencing arbitrary
218
+      sets of messages with minimal refresh. It makes little sense for these
219
+      functions to support custom message dispatchers.
220
+    - Remain backwards compatible. Maintain deprecated aliases of all renamed
221
+      functions:
222
+      - `send`          -> `sendMessageWithNoRefreshToCurrentB`
223
+      - `sendSM`        -> `sendSomeMessageWithNoRefreshToCurrentB`
224
+      - `sendSM_`       -> `sendSomeMessageWithNoRefreshToCurrent`
225
+      - `tryInOrder`    -> `tryInOrderWithNoRefreshToCurrentB`
226
+      - `tryInOrder_`   -> `tryInOrderWithNoRefreshToCurrent`
227
+      - `tryMessage`    -> `tryMessageWithNoRefreshToCurrentB`
228
+      - `tryMessage_`   -> `tryMessageWithNoRefreshToCurrent`
229
+
35 230
 ### New Modules
36 231
 
37
-  * `XMonad.Util.ExclusiveScratchpads`
232
+  * `XMonad.Layout.MultiToggle.TabBarDecoration`
38 233
 
39
-    Named scratchpads that can be mutually exclusive: This new module extends the
40
-    idea of named scratchpads such that you can define "families of scratchpads"
41
-    that are exclusive on the same screen. It also allows to remove this
42
-    constraint of being mutually exclusive with another scratchpad.
234
+    Provides a simple transformer for use with `XMonad.Layout.MultiToggle` to
235
+    dynamically toggle `XMonad.Layout.TabBarDecoration`.
236
+
237
+  * `XMonad.Layout.StateFull`
43 238
 
44
-  * `XMonad.Hooks.Focus`
239
+    Provides `StateFull`: a stateful form of `Full` that does not misbehave when
240
+    floats are focused, and the `FocusTracking` layout transformer by means of
241
+    which `StateFull` is implemented. `FocusTracking` simply holds onto the last
242
+    true focus it was given and continues to use it as the focus for the
243
+    transformed layout until it sees another. It can be used to improve the
244
+    behaviour of a child layout that has not been given the focused window.
45 245
 
46
-    A new module extending ManageHook EDSL to work on focused windows and
47
-    current workspace.
246
+  * `XMonad.Actions.SwapPromote`
48 247
 
49
-    This module will enable window activation (`_NET_ACTIVE_WINDOW`) and apply
50
-    `manageHook` to activated window too. Thus, it may lead to unexpected
51
-    results, when `manageHook` previously working only for new windows, start
52
-    working for activated windows too. It may be solved, by adding
53
-    `not <$> activated` before those part of `manageHook`, which should not be
54
-    called for activated windows.  But this lifts `manageHook` into
55
-    `FocusHook` and it needs to be converted back later using `manageFocus`.
248
+    Module for tracking master window history per workspace, and associated
249
+    functions for manipulating the stack using such history.
56 250
 
57 251
   * `XMonad.Actions.CycleWorkspaceByScreen`
58 252
 
@@ -63,8 +257,98 @@
63 257
     Also provides the `repeatableAction` helper function which can be used to
64 258
     build actions that can be repeated while a modifier key is held down.
65 259
 
260
+  * `XMonad.Prompt.FuzzyMatch`
261
+
262
+    Provides a predicate `fuzzyMatch` that is much more lenient in matching
263
+    completions in `XMonad.Prompt` than the default prefix match.  Also provides
264
+    a function `fuzzySort` that allows sorting the fuzzy matches by "how well"
265
+    they match.
266
+
267
+  * `XMonad.Utils.SessionStart`
268
+
269
+    A new module that allows to query if this is the first time xmonad is
270
+    started of the session, or a xmonad restart.
271
+
272
+    Currently needs manual setting of the session start flag. This could be
273
+    automated when this moves to the core repository.
274
+
275
+  * `XMonad.Layout.MultiDishes`
276
+
277
+    A new layout based on Dishes, however it accepts additional configuration
278
+    to allow multiple windows within a single stack.
279
+
280
+  * `XMonad.Util.Rectangle`
281
+
282
+    A new module for handling pixel rectangles.
283
+
284
+  * `XMonad.Layout.BinaryColumn`
285
+
286
+    A new module which provides a simple grid layout, halving the window
287
+    sizes of each window after master.
288
+
289
+    This is similar to Column, but splits the window in a way
290
+    that maintains window sizes upon adding & removing windows as well as the
291
+    option to specify a minimum window size.
292
+
66 293
 ### Bug Fixes and Minor Changes
67 294
 
295
+  * `XMonad.Layout.Grid`
296
+
297
+    Fix as per issue #223; Grid will no longer calculate more columns than there
298
+    are windows.
299
+
300
+  * `XMonad.Hooks.FadeWindows`
301
+
302
+    Added support for GHC version 8.4.x by adding a Semigroup instance for
303
+    Monoids
304
+
305
+  * `XMonad.Hooks.WallpaperSetter`
306
+
307
+    Added support for GHC version 8.4.x by adding a Semigroup instance for
308
+    Monoids
309
+
310
+  * `XMonad.Hooks.Mosaic`
311
+
312
+    Added support for GHC version 8.4.x by adding a Semigroup instance for
313
+    Monoids
314
+
315
+  * `XMonad.Actions.Navigation2D`
316
+
317
+    Added `sideNavigation` and a parameterised variant, providing a navigation
318
+    strategy with fewer quirks for tiled layouts using X.L.Spacing.
319
+
320
+  * `XMonad.Layout.Fullscreen`
321
+
322
+    The fullscreen layouts will now not render any window that is totally
323
+    obscured by fullscreen windows.
324
+
325
+  * `XMonad.Layout.Gaps`
326
+
327
+    Extended the sendMessage interface with `ModifyGaps` to allow arbitrary
328
+    modifications to the `GapSpec`.
329
+
330
+  * `XMonad.Layout.Groups`
331
+
332
+    Added a new `ModifyX` message type that allows the modifying
333
+    function to return values in the `X` monad.
334
+
335
+  * `XMonad.Actions.Navigation2D`
336
+
337
+    Generalised (and hence deprecated) hybridNavigation to hybridOf.
338
+
339
+  * `XMonad.Layout.LayoutHints`
340
+
341
+    Preserve the window order of the modified layout, except for the focused
342
+    window that is placed on top. This fixes an issue where the border of the
343
+    focused window in certain situations could be rendered below borders of
344
+    unfocused windows. It also has a lower risk of interfering with the
345
+    modified layout.
346
+
347
+  * `XMonad.Layout.MultiColumns`
348
+
349
+    The focused window is placed above the other windows if they would be made to
350
+    overlap due to a layout modifier. (As long as it preserves the window order.)
351
+
68 352
   * `XMonad.Actions.GridSelect`
69 353
 
70 354
     - The vertical centring of text in each cell has been improved.
@@ -102,6 +386,10 @@
102 386
 
103 387
     Make type of ManageHook combinators more general.
104 388
 
389
+  * `XMonad.Prompt`
390
+
391
+    Export `insertString`.
392
+
105 393
   * `XMonad.Prompt.Window`
106 394
 
107 395
     - New function: `windowMultiPrompt` for using `mkXPromptWithModes`
@@ -118,6 +406,68 @@
118 406
       changed and you want to re-sort windows into the appropriate
119 407
       sub-layout.
120 408
 
409
+  * `XMonad.Actions.Minimize`
410
+
411
+    - Now has `withFirstMinimized` and `withFirstMinimized'` so you can perform
412
+      actions with both the last and first minimized windows easily.
413
+
414
+  * `XMonad.Config.Gnome`
415
+
416
+    - Update logout key combination (modm+shift+Q) to work with modern
417
+
418
+  * `XMonad.Prompt.Pass`
419
+
420
+    - New function `passTypePrompt` which uses `xdotool` to type in a password
421
+      from the store, bypassing the clipboard.
422
+    - New function `passEditPrompt` for editing a password from the
423
+      store.
424
+    - Now handles password labels with spaces and special characters inside
425
+      them.
426
+
427
+  * `XMonad.Prompt.Unicode`
428
+
429
+    - Persist unicode data cache across XMonad instances due to
430
+      `ExtensibleState` now used instead of `unsafePerformIO`.
431
+    - `typeUnicodePrompt :: String -> XPConfig -> X ()` provided to insert the
432
+      Unicode character via `xdotool` instead of copying it to the paste buffer.
433
+    - `mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()`
434
+      acts as a generic function to pass the selected Unicode character to any
435
+      program.
436
+
437
+  * `XMonad.Prompt.AppendFile`
438
+
439
+    - New function `appendFilePrompt'` which allows for transformation of the
440
+      string passed by a user before writing to a file.
441
+
442
+  * `XMonad.Hooks.DynamicLog`
443
+
444
+    - Added a new function `dzenWithFlags` which allows specifying the arguments
445
+    passed to `dzen2` invocation. The behaviour of current `dzen` function is
446
+    unchanged.
447
+
448
+  * `XMonad.Util.Dzen`
449
+
450
+    - Now provides functions `fgColor` and `bgColor` to specify foreground and
451
+    background color, `align` and `slaveAlign` to set text alignment, and
452
+    `lineCount` to enable a second (slave) window that displays lines beyond
453
+    the initial (title) one.
454
+
455
+  * `XMonad.Hooks.DynamicLog`
456
+
457
+    - Added optional `ppVisibleNoWindows` to differentiate between empty
458
+      and non-empty visible workspaces in pretty printing.
459
+
460
+  * `XMonad.Actions.DynamicWorkspaceOrder`
461
+
462
+    - Added `updateName` and `removeName` to better control ordering when
463
+      workspace names are changed or workspaces are removed.
464
+
465
+  * `XMonad.Config.Azerty`
466
+
467
+    * Added `belgianConfig` and `belgianKeys` to support Belgian AZERTY
468
+      keyboards, which are slightly different from the French ones in the top
469
+      row.
470
+
121 471
 ## 0.13 (February 10, 2017)
122 472
 
123 473
 ### Breaking Changes

+ 10
- 9
README.md View File

@@ -1,14 +1,15 @@
1 1
 # xmonad-contrib: Third Party Extensions to the xmonad Window Manager
2 2
 
3 3
 [![Build Status](https://travis-ci.org/xmonad/xmonad-contrib.svg?branch=master)](https://travis-ci.org/xmonad/xmonad-contrib)
4
+[![Open Source Helpers](https://www.codetriage.com/xmonad/xmonad-contrib/badges/users.svg)](https://www.codetriage.com/xmonad/xmonad-contrib)
4 5
 
5 6
 You need the ghc compiler and xmonad window manager installed in
6 7
 order to use these extensions.
7 8
 
8 9
 For installation and configuration instructions, please see the
9
-[xmonad website] [xmonad], the documents included with the
10
-[xmonad source distribution] [xmonad-git], and the
11
-[online haddock documentation] [xmonad-docs].
10
+[xmonad website][xmonad], the documents included with the
11
+[xmonad source distribution][xmonad-git], and the
12
+[online haddock documentation][xmonad-docs].
12 13
 
13 14
 ## Getting or Updating XMonadContrib
14 15
 
@@ -17,7 +18,7 @@ For installation and configuration instructions, please see the
17 18
   * Git version: <https://github.com/xmonad/xmonad-contrib>
18 19
 
19 20
 (To use git xmonad-contrib you must also use the
20
-[git version of xmonad] [xmonad-git].)
21
+[git version of xmonad][xmonad-git].)
21 22
 
22 23
 ## Contributing
23 24
 
@@ -28,15 +29,15 @@ example, to use the Grid layout, one would import:
28 29
 
29 30
     XMonad.Layout.Grid
30 31
 
31
-For further details, see the [documentation] [developing] for the
32
-`XMonad.Doc.Developing` module and the [xmonad website] [xmonad].
32
+For further details, see the [documentation][developing] for the
33
+`XMonad.Doc.Developing` module, XMonad's [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md)  and the [xmonad website][xmonad].
33 34
 
34 35
 ## License
35 36
 
36 37
 Code submitted to the contrib repo is licensed under the same license as
37 38
 xmonad itself, with copyright held by the authors.
38
-
39
+ 
39 40
 [xmonad]: http://xmonad.org
40 41
 [xmonad-git]: https://github.com/xmonad/xmonad
41
-[xmonad-docs]: http://www.xmonad.org/xmonad-docs
42
-[developing]: http://xmonad.org/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html
42
+[xmonad-docs]: http://hackage.haskell.org/package/xmonad
43
+[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 (
19 19
                              -- $usage
20 20
                              commandMap,
21 21
                              runCommand,
22
+                             runCommandConfig,
22 23
                              runCommand',
23 24
                              workspaceCommands,
24 25
                              screenCommands,
@@ -103,11 +104,18 @@ defaultCommands = do
103 104
         ]
104 105
 
105 106
 -- | Given a list of command\/action pairs, prompt the user to choose a
107
+--   command using dmenu and return the corresponding action.
106 108
 runCommand :: [(String, X ())] -> X ()
107
-runCommand cl = do
109
+runCommand = runCommandConfig dmenu
110
+
111
+
112
+-- | Given a list of command\/action pairs, prompt the user to choose a
113
+--   command using dmenu-compatible launcher and return the corresponding action.
114
+--   See X.U.Dmenu for compatible launchers.
115
+runCommandConfig :: ([String] -> X String) -> [(String, X ())] -> X()
116
+runCommandConfig f cl = do
108 117
   let m = commandMap cl
109
-  choice <- dmenu (M.keys m)
118
+  choice <- f (M.keys m)
110 119
   fromMaybe (return ()) (M.lookup choice m)
111 120
 
112 121
 -- | 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)
50 50
 import qualified Data.Map.Strict as Map
51 51
 import Data.Maybe (fromMaybe, isNothing)
52 52
 import Data.Monoid ((<>))
53
-import System.Directory (setCurrentDirectory, getHomeDirectory)
53
+import System.Directory (setCurrentDirectory, getHomeDirectory, makeAbsolute)
54 54
 import XMonad
55 55
 import XMonad.Actions.DynamicWorkspaces
56 56
 import XMonad.Prompt
@@ -182,7 +182,8 @@ instance XPrompt ProjectPrompt where
182 182
       modifyProject (\p -> p { projectName = name })
183 183
 
184 184
   modeAction (ProjectPrompt DirMode _) buf auto = do
185
-    let dir = if null auto then buf else auto
185
+    let dir' = if null auto then buf else auto
186
+    dir <- io $ makeAbsolute dir'
186 187
     modifyProject (\p -> p { projectDirectory = dir })
187 188
 
188 189
 --------------------------------------------------------------------------------

+ 30
- 6
XMonad/Actions/DynamicWorkspaceOrder.hs View File

@@ -23,11 +23,14 @@ module XMonad.Actions.DynamicWorkspaceOrder
23 23
       getWsCompareByOrder
24 24
     , getSortByOrder
25 25
     , swapWith
26
+    , updateName
27
+    , removeName
26 28
 
27 29
     , moveTo
28 30
     , moveToGreedy
29 31
     , shiftTo
30 32
 
33
+    , withNthWorkspace'
31 34
     , withNthWorkspace
32 35
 
33 36
     ) where
@@ -152,6 +155,21 @@ swapOrder w1 w2 = do
152 155
   XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1))
153 156
   windows id  -- force a status bar update
154 157
 
158
+-- | Update the name of a workspace in the stored order.
159
+updateName :: WorkspaceId -> WorkspaceId -> X ()
160
+updateName oldId newId = XS.modify . withWSO $ changeKey oldId newId
161
+
162
+-- | Remove a workspace from the stored order.
163
+removeName :: WorkspaceId -> X ()
164
+removeName = XS.modify . withWSO . M.delete
165
+
166
+-- | Update a key in a Map.
167
+changeKey :: Ord k => k -> k -> M.Map k a -> M.Map k a
168
+changeKey oldKey newKey oldMap =
169
+  case M.updateLookupWithKey (\_ _ -> Nothing) oldKey oldMap of
170
+    (Nothing, _) -> oldMap
171
+    (Just val, newMap) -> M.insert newKey val newMap
172
+
155 173
 -- | View the next workspace of the given type in the given direction,
156 174
 -- where \"next\" is determined using the dynamic workspace order.
157 175
 moveTo :: Direction1D -> WSType -> X ()
@@ -166,13 +184,19 @@ moveToGreedy dir t = doTo dir t getSortByOrder (windows . W.greedyView)
166 184
 shiftTo :: Direction1D -> WSType -> X ()
167 185
 shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift)
168 186
 
187
+-- | Do something with the nth workspace in the dynamic order after
188
+--   transforming it.  The callback is given the workspace's tag as well
189
+--   as the 'WindowSet' of the workspace itself.
190
+withNthWorkspace' :: ([WorkspaceId] -> [WorkspaceId]) -> (String -> WindowSet -> WindowSet) -> Int -> X ()
191
+withNthWorkspace' tr job wnum = do
192
+  sort <- getSortByOrder
193
+  ws <- gets (tr . map W.tag . sort . W.workspaces . windowset)
194
+  case drop wnum ws of
195
+    (w:_) -> windows $ job w
196
+    []    -> return ()
197
+
169 198
 -- | Do something with the nth workspace in the dynamic order.  The
170 199
 --   callback is given the workspace's tag as well as the 'WindowSet'
171 200
 --   of the workspace itself.
172 201
 withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
173
-withNthWorkspace job wnum = do
174
-  sort <- getSortByOrder
175
-  ws <- gets (map W.tag . sort . W.workspaces . windowset)
176
-  case drop wnum ws of
177
-    (w:_) -> windows $ job w
178
-    []    -> return ()
202
+withNthWorkspace = withNthWorkspace' id

+ 27
- 2
XMonad/Actions/GroupNavigation.hs View File

@@ -16,7 +16,7 @@
16 16
 -- query.
17 17
 --
18 18
 -- Also provides a method for jumping back to the most recently used
19
+-- window in any given group, and predefined groups.
19 20
 --
20 21
 ----------------------------------------------------------------------
21 22
 
@@ -27,9 +27,14 @@ module XMonad.Actions.GroupNavigation ( -- * Usage
27 27
                                       , nextMatchOrDo
28 28
                                       , nextMatchWithThis
29 29
                                       , historyHook
30
+
31
+                                        -- * Utilities
32
+                                        -- $utilities
33
+                                      , isOnAnyVisibleWS
30 34
                                       ) where
31 35
 
32 36
 import Control.Monad.Reader
37
+import Control.Monad.State
33 38
 import Data.Foldable as Fold
34 39
 import Data.Map as Map
35 40
 import Data.Sequence as Seq
@@ -142,7 +147,7 @@ orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs'
142 147
     where
143 148
       wspcs      = SS.workspaces ss
144 149
       wspcsMap   = Fold.foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs
145
-      wspcs'     = fmap (\wsid -> wspcsMap ! wsid) wsids
150
+      wspcs'     = fmap (wspcsMap !) wsids
146 151
       isCurWS ws = SS.tag ws == SS.tag (SS.workspace $ SS.current ss)
147 152
 
148 153
 --- History navigation, requires a layout modifier -------------------
@@ -167,7 +172,7 @@ updateHistory :: HistoryDB -> X HistoryDB
167 172
 updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> do
168 173
   let newcur   = SS.peek ss
169 174
       wins     = Set.fromList $ SS.allWindows ss
170
-      newhist  = flt (flip Set.member wins) (ins oldcur oldhist)
175
+      newhist  = flt (`Set.member` wins) (ins oldcur oldhist)
171 176
   return $ HistoryDB newcur (del newcur newhist)
172 177
   where
173 178
     ins x xs = maybe xs (<| xs) x
@@ -216,3 +221,22 @@ findM cond xs = findM' cond (viewl xs)
216 221
       if isMatch
217 222
         then return (Just x')
218 223
         else findM qry xs'
224
+
225
+
226
+-- $utilities
227
+-- #utilities#
228
+-- Below are handy queries for use with 'nextMatch', 'nextMatchOrDo',
229
+-- and 'nextMatchWithThis'.
230
+
231
+-- | A query that matches all windows on visible workspaces. This is
232
+-- useful for configurations with multiple screens, and matches even
233
+-- invisible windows.
234
+isOnAnyVisibleWS :: Query Bool
235
+isOnAnyVisibleWS = do
236
+  w <- ask
237
+  ws <- liftX $ gets windowset
238
+  let allVisible = concat $ maybe [] SS.integrate . SS.stack . SS.workspace <$> SS.current ws:SS.visible ws
239
+      visibleWs = w `elem` allVisible
240
+      unfocused = maybe True (w /=) $ SS.peek ws
241
+  return $ visibleWs && unfocused
242
+

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

@@ -1,7 +1,8 @@
1 1
 -----------------------------------------------------------------------------
2 2
 -- |
3 3
 -- Module       : XMonad.Actions.MessageFeedback
4
+-- Copyright    : (c) --   Quentin Moser <moserq@gmail.com>
5
+--                    2018 Yclept Nemo
4 6
 -- License      : BSD3
5 7
 --
6 8
 -- Maintainer   : orphaned
@@ -13,87 +14,263 @@
13 14
 -- this facility.
14 15
 -----------------------------------------------------------------------------
15 16
 
16
-module XMonad.Actions.MessageFeedback (
17
-                                      -- * Usage
18
-                                      -- $usage
17
+module XMonad.Actions.MessageFeedback
18
+    ( -- * Usage
19
+      -- $usage
19 20
 
20
-                                        send
21
-                                      , tryMessage
22
-                                      , tryMessage_
23
-                                      , tryInOrder
24
-                                      , tryInOrder_
25
-                                      , sm
26
-                                      , sendSM
27
-                                      , sendSM_
28
-                                      ) where
21
+      -- * Messaging variants
29 22
 
30
-import XMonad.Core ( X (), Message, SomeMessage(..), LayoutClass(..), windowset, catchX )
31
-import XMonad.StackSet ( current, workspace, layout, tag )
32
-import XMonad.Operations ( updateLayout )
23
+      -- ** 'SomeMessage'
24
+      sendSomeMessageB, sendSomeMessage
25
+    , sendSomeMessageWithNoRefreshB, sendSomeMessageWithNoRefresh
26
+    , sendSomeMessageWithNoRefreshToCurrentB, sendSomeMessageWithNoRefreshToCurrent
33 27
 
34
-import Control.Monad.State ( gets )
35
-import Data.Maybe ( isJust )
36
-import Control.Applicative ((<$>))
28
+      -- ** 'Message'
29
+    , sendMessageB
30
+    , sendMessageWithNoRefreshB
31
+    , sendMessageWithNoRefreshToCurrentB, sendMessageWithNoRefreshToCurrent
32
+
33
+      -- * Utility Functions
34
+
35
+      -- ** Send All
36
+    , sendSomeMessagesB, sendSomeMessages, sendMessagesB, sendMessages
37
+
38
+      -- ** Send Until
39
+    , tryInOrderB, tryInOrderWithNoRefreshToCurrentB, tryInOrderWithNoRefreshToCurrent
40
+    , tryMessageB, tryMessageWithNoRefreshToCurrentB, tryMessageWithNoRefreshToCurrent
41
+
42
+      -- ** Aliases
43
+    , sm
44
+
45
+      -- * Backwards Compatibility
46
+      -- $backwardsCompatibility
47
+    , send, sendSM, sendSM_
48
+    , tryInOrder, tryInOrder_
49
+    , tryMessage, tryMessage_
50
+    ) where
51
+
52
+import XMonad               ( Window )
53
+import XMonad.Core          ( X(), Message, SomeMessage(..), LayoutClass(..), windowset, catchX, WorkspaceId, Layout, whenJust )
54
+import XMonad.StackSet      ( Workspace, current, workspace, layout, tag )
55
+import XMonad.Operations    ( updateLayout, windowBracket, modifyWindowSet )
56
+
57
+import Data.Maybe           ( isJust )
58
+import Control.Monad        ( void )
59
+import Control.Monad.State  ( gets )
60
+import Control.Applicative  ( (<$>), liftA2 )
37 61
 
38 62
 -- $usage
39 63
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
40 64
 --
41 65
 -- > import XMonad.Actions.MessageFeedback
42 66
 --
67
+-- You can then use this module's functions wherever an action is expected. All
68
+-- feedback variants are supported:
69
+--
70
+-- * message to any workspace with no refresh
71
+-- * message to current workspace with no refresh
72
+-- * message to current workspace with refresh
73
+--
74
+-- Except "message to any workspace with refresh" which makes little sense.
43 75
 --
44 76
 -- Note that most functions in this module have a return type of @X Bool@
77
+-- whereas configuration options will expect a @X ()@ action. For example, the
78
+-- key binding:
45 79
 --
46 80
 -- > -- Shrink the master area of a tiled layout, or move the focused window
47 81
 -- > -- to the left in a WindowArranger-based layout
82
+-- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrentB Shrink (MoveLeft 50))
83
+--
84
+-- is mis-typed. For this reason, this module provides alternatives (not ending
85
+-- with an uppercase \"B\", e.g. 'XMonad.Operations.sendMessage' rather than
86
+-- 'sendMessageB') that discard their boolean result and return an @X ()@. For
87
+-- example, to correct the previous example:
88
+--
89
+-- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrent Shrink (MoveLeft 50))
90
+--
91
+-- This module also provides 'SomeMessage' variants of each 'Message' function
92
+-- for when the messages are of differing types (but still instances of
93
+-- 'Message'). First box each message using 'SomeMessage' or the convenience
94
+-- alias 'sm'. Then, for example, to send each message:
48 95
 --
96
+-- > sendSomeMessages [sm messageOfTypeA, sm messageOfTypeB]
49 97
 --
98
+-- This is /not/ equivalent to the following example, which will not refresh
99
+-- the workspace unless the last message is handled:
50 100
 --
101
+-- > sendMessageWithNoRefreshToCurrent messageOfTypeA >> sendMessage messageOfTypeB
51 102
 
52 103
 
53
-send :: Message a => a -> X Bool
54
-send = sendSM . sm
104
+-- | Variant of 'XMonad.Operations.sendMessage'. Accepts 'SomeMessage'; to use
105
+-- 'Message' see 'sendMessageB'. Returns @True@ if the message was handled,
106
+-- @False@ otherwise. Instead of using 'sendSomeMessageWithNoRefreshToCurrentB'
107
+-- for efficiency this is pretty much an exact copy of the
108
+-- 'XMonad.Operations.sendMessage' code - foregoes the O(n) 'updateLayout'.
109
+sendSomeMessageB :: SomeMessage -> X Bool
110
+sendSomeMessageB m = windowBracket id $ do
111
+    w  <- workspace . current <$> gets windowset
112
+    ml <- handleMessage (layout w) m `catchX` return Nothing
113
+    whenJust ml $ \l ->
114
+        modifyWindowSet $ \ws -> ws { current = (current ws)
115
+                                { workspace = (workspace $ current ws)
116
+                                    { layout = l }}}
117
+    return $ isJust ml
55 118
 
56
-tryMessage :: (Message a, Message b) => a -> b -> X Bool
57
-tryMessage m1 m2 = do b <- send m1
58
-                      if b then return True else send m2
119
+-- | Variant of 'sendSomeMessageB' that discards the result.
120
+sendSomeMessage :: SomeMessage -> X ()
121
+sendSomeMessage = void . sendSomeMessageB
59 122
 
60
-tryMessage_ :: (Message a, Message b) => a -> b -> X ()
61
-tryMessage_ m1 m2 = tryMessage m1 m2 >> return ()
123
+-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh'. Accepts
124
+-- 'SomeMessage'; to use 'Message' see 'sendMessageWithNoRefreshB'. Returns
125
+-- @True@ if the message was handled, @False@ otherwise.
126
+sendSomeMessageWithNoRefreshB :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X Bool
127
+sendSomeMessageWithNoRefreshB m w
128
+    =   handleMessage (layout w) m `catchX` return Nothing
129
+    >>= liftA2 (>>) (updateLayout $ tag w) (return . isJust)
62 130
 
63
-tryInOrder :: [SomeMessage] -> X Bool
64
-tryInOrder [] = return False
65
-tryInOrder (m:ms) = do b <- sendSM m
66
-                       if b then return True else tryInOrder ms
131
+-- | Variant of 'sendSomeMessageWithNoRefreshB' that discards the result.
132
+sendSomeMessageWithNoRefresh :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X ()
133
+sendSomeMessageWithNoRefresh m = void . sendSomeMessageWithNoRefreshB m
134
+
135
+-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh' that sends the
136
+-- message to the current layout. Accepts 'SomeMessage'; to use 'Message' see
137
+-- 'sendMessageWithNoRefreshToCurrentB'. Returns @True@ if the message was
138
+-- handled, @False@ otherwise. This function is somewhat of a cross between
139
+-- 'XMonad.Operations.sendMessage' (sends to the current layout) and
140
+-- 'XMonad.Operations.sendMessageWithNoRefresh' (does not refresh).
141
+sendSomeMessageWithNoRefreshToCurrentB :: SomeMessage -> X Bool
142
+sendSomeMessageWithNoRefreshToCurrentB m
143
+    =   (gets $ workspace . current . windowset)
144
+    >>= sendSomeMessageWithNoRefreshB m
145
+
146
+-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' that discards the
147
+-- result.
148
+sendSomeMessageWithNoRefreshToCurrent :: SomeMessage -> X ()
149
+sendSomeMessageWithNoRefreshToCurrent = void . sendSomeMessageWithNoRefreshToCurrentB
150
+
151
+
152
+-- | Variant of 'sendSomeMessageB' which like 'XMonad.Operations.sendMessage'
153
+-- accepts 'Message' rather than 'SomeMessage'. Returns @True@ if the message
154
+-- was handled, @False@ otherwise.
155
+sendMessageB :: Message a => a -> X Bool
156
+sendMessageB = sendSomeMessageB . SomeMessage
157
+
158
+-- | Variant of 'sendSomeMessageWithNoRefreshB' which like
159
+-- 'XMonad.Operations.sendMessageWithNoRefresh' accepts 'Message' rather than
160
+-- 'SomeMessage'. Returns @True@ if the message was handled, @False@ otherwise.
161
+sendMessageWithNoRefreshB :: Message a => a -> Workspace WorkspaceId (Layout Window) Window -> X Bool
162
+sendMessageWithNoRefreshB = sendSomeMessageWithNoRefreshB . SomeMessage
163
+
164
+-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' which accepts
165
+-- 'Message' rather than 'SomeMessage'. Returns @True@ if the message was
166
+-- handled, @False@ otherwise.
167
+sendMessageWithNoRefreshToCurrentB :: Message a => a -> X Bool
168
+sendMessageWithNoRefreshToCurrentB = sendSomeMessageWithNoRefreshToCurrentB . SomeMessage
169
+
170
+-- | Variant of 'sendMessageWithNoRefreshToCurrentB' that discards the result.
171
+sendMessageWithNoRefreshToCurrent :: Message a => a -> X ()
172
+sendMessageWithNoRefreshToCurrent = void . sendMessageWithNoRefreshToCurrentB
67 173
 
68
-tryInOrder_ :: [SomeMessage] -> X ()
69
-tryInOrder_ ms = tryInOrder ms >> return ()
70 174
 
175
+-- | Send each 'SomeMessage' to the current layout without refresh (using
176
+-- 'sendSomeMessageWithNoRefreshToCurrentB') and collect the results. If any
177
+-- message was handled, refresh. If you want to sequence a series of messages
178
+-- that would have otherwise used 'XMonad.Operations.sendMessage' while
179
+-- minimizing refreshes, use this.
180
+sendSomeMessagesB :: [SomeMessage] -> X [Bool]
181
+sendSomeMessagesB
182
+    = windowBracket or
183
+    . mapM sendSomeMessageWithNoRefreshToCurrentB
71 184
 
185
+-- | Variant of 'sendSomeMessagesB' that discards the results.
186
+sendSomeMessages :: [SomeMessage] -> X ()
187
+sendSomeMessages = void . sendSomeMessagesB
188
+
189
+-- | Variant of 'sendSomeMessagesB' which accepts 'Message' rather than
190
+-- 'SomeMessage'. Use this if all the messages are of the same type.
191
+sendMessagesB :: Message a => [a] -> X [Bool]
192
+sendMessagesB = sendSomeMessagesB . map SomeMessage
193
+
194
+-- | Variant of 'sendMessagesB' that discards the results.
195
+sendMessages :: Message a => [a] -> X ()
196
+sendMessages = void . sendMessagesB
197
+
198
+
199
+-- | Apply the dispatch function in order to each message of the list until one
200
+-- is handled. Returns @True@ if so, @False@ otherwise.
201
+tryInOrderB :: (SomeMessage -> X Bool) -> [SomeMessage] -> X Bool
202
+tryInOrderB _ []     = return False
203
+tryInOrderB f (m:ms) = do b <- f m
204
+                          if b then return True else tryInOrderB f ms
205
+
206
+-- | Variant of 'tryInOrderB' that sends messages to the current layout without
207
+-- refresh using 'sendSomeMessageWithNoRefreshToCurrentB'.
208
+tryInOrderWithNoRefreshToCurrentB :: [SomeMessage] -> X Bool
209
+tryInOrderWithNoRefreshToCurrentB = tryInOrderB sendSomeMessageWithNoRefreshToCurrentB
210
+
211
+-- | Variant of 'tryInOrderWithNoRefreshToCurrent' that discards the results.
212
+tryInOrderWithNoRefreshToCurrent :: [SomeMessage] -> X ()
213
+tryInOrderWithNoRefreshToCurrent = void . tryInOrderWithNoRefreshToCurrentB
214
+
215
+-- | Apply the dispatch function to the first message, and if it was not
216
+-- handled, apply it to the second. Returns @True@ if either message was
217
+-- handled, @False@ otherwise.
218
+tryMessageB :: (Message a, Message b) => (SomeMessage -> X Bool) -> a -> b -> X Bool
219
+tryMessageB f m1 m2 = tryInOrderB f [sm m1,sm m2]
220
+
221
+-- | Variant of 'tryMessageB' that sends messages to the current layout without
222
+-- refresh using 'sendMessageWithNoRefreshToCurrentB'.
223
+tryMessageWithNoRefreshToCurrentB :: (Message a, Message b) => a -> b -> X Bool
224
+tryMessageWithNoRefreshToCurrentB = tryMessageB sendSomeMessageWithNoRefreshToCurrentB
225
+
226
+-- | Variant of 'tryMessage' that discards the results.
227
+tryMessageWithNoRefreshToCurrent :: (Message a, Message b) => a -> b -> X ()
228
+tryMessageWithNoRefreshToCurrent m = void . tryMessageWithNoRefreshToCurrentB m
229
+
230
+
231
+-- | Convenience shorthand for 'SomeMessage'.
72 232
 sm :: Message a => a -> SomeMessage
73 233
 sm = SomeMessage
74 234
 
235
+--------------------------------------------------------------------------------
236
+-- Backwards Compatibility:
237
+--------------------------------------------------------------------------------
238
+{-# DEPRECATED send "Use sendMessageB instead." #-}
239
+{-# DEPRECATED sendSM "Use sendSomeMessageB instead." #-}
240
+{-# DEPRECATED sendSM_ "Use sendSomeMessage instead." #-}
241
+{-# DEPRECATED tryInOrder "Use tryInOrderWithNoRefreshToCurrentB instead." #-}
242
+{-# DEPRECATED tryInOrder_ "Use tryInOrderWithNoRefreshToCurrent instead." #-}
243
+{-# DEPRECATED tryMessage "Use tryMessageWithNoRefreshToCurrentB instead." #-}
244
+{-# DEPRECATED tryMessage_ "Use tryMessageWithNoRefreshToCurrent instead." #-}
75 245
 
76
-sendSM :: SomeMessage -> X Bool
77
-sendSM m = do w <- workspace . current <$> gets windowset
78
-              ml' <- handleMessage (layout w) m `catchX` return Nothing
79
-              updateLayout (tag w) ml'
80
-              return $ isJust ml'
246
+-- $backwardsCompatibility
247
+-- The following functions exist solely for compatibility with pre-0.14
248
+-- releases.
81 249
 
250
+-- | See 'sendMessageWithNoRefreshToCurrentB'.
251
+send :: Message a => a -> X Bool
252
+send = sendMessageWithNoRefreshToCurrentB
253
+
254
+-- | See 'sendSomeMessageWithNoRefreshToCurrentB'.
255
+sendSM :: SomeMessage -> X Bool
256
+sendSM = sendSomeMessageWithNoRefreshToCurrentB
82 257
 
258
+-- | See 'sendSomeMessageWithNoRefreshToCurrent'.
83 259
 sendSM_ :: SomeMessage -> X ()
84
-sendSM_ m = sendSM m >> return ()
260
+sendSM_ = sendSomeMessageWithNoRefreshToCurrent
261
+
262
+-- | See 'tryInOrderWithNoRefreshToCurrentB'.
263
+tryInOrder :: [SomeMessage] -> X Bool
264
+tryInOrder = tryInOrderWithNoRefreshToCurrentB
265
+
266
+-- | See 'tryInOrderWithNoRefreshToCurrent'.
267
+tryInOrder_ :: [SomeMessage] -> X ()
268
+tryInOrder_ = tryInOrderWithNoRefreshToCurrent
269
+
270
+-- | See 'tryMessageWithNoRefreshToCurrentB'.
271
+tryMessage :: (Message a, Message b) => a -> b -> X Bool
272
+tryMessage = tryMessageWithNoRefreshToCurrentB
273
+
274
+-- | See 'tryMessageWithNoRefreshToCurrent'.
275
+tryMessage_ :: (Message a, Message b) => a -> b -> X ()
276
+tryMessage_ = tryMessageWithNoRefreshToCurrent

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

@@ -29,6 +29,8 @@ module XMonad.Actions.Minimize
29 29
   , maximizeWindowAndFocus
30 30
   , withLastMinimized
31 31
   , withLastMinimized'
32
+  , withFirstMinimized
33
+  , withFirstMinimized'
32 34
   , withMinimized
33 35
   ) where
34 36
 
@@ -85,7 +87,7 @@ modified f = XS.modified $
85 87
        in Minimized { rectMap = newRectMap
86 88
                     , minimizedStack = (newWindows L.\\ oldStack)
87 89
                                        ++
88
-                                       (newWindows `L.intersect` oldStack)
90
+                                       (oldStack `L.intersect` newWindows)
89 91
                     }
90 92
 
91 93
 
@@ -115,6 +117,16 @@ maximizeWindow = maximizeWindowAndChangeWSet $ const id
115 117
 maximizeWindowAndFocus :: Window -> X ()
116 118
 maximizeWindowAndFocus = maximizeWindowAndChangeWSet W.focusWindow
117 119
 
120
+-- | Perform an action with first minimized window on current workspace
121
+--   or do nothing if there is no minimized windows on current workspace
122
+withFirstMinimized :: (Window -> X ()) -> X ()
123
+withFirstMinimized action = withFirstMinimized' (flip whenJust action)
124
+
125
+-- | Like withFirstMinimized but the provided action is always invoked with a
126
+--   'Maybe Window', that will be nothing if there is no first minimized window.
127
+withFirstMinimized' :: (Maybe Window -> X ()) -> X ()
128
+withFirstMinimized' action = withMinimized (action . listToMaybe . reverse)
129
+
118 130
 -- | Perform an action with last minimized window on current workspace
119 131
 --   or do nothing if there is no minimized windows on current workspace
120 132
 withLastMinimized :: (Window -> X ()) -> X ()

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

@@ -43,6 +43,9 @@ module XMonad.Actions.Navigation2D ( -- * Usage
43 43
                                    , Navigation2D
44 44
                                    , lineNavigation
45 45
                                    , centerNavigation
46
+                                   , sideNavigation
47
+                                   , sideNavigationWithBias
48
+                                   , hybridOf
46 49
                                    , hybridNavigation
47 50
                                    , fullScreenRect
48 51
                                    , singleWindowRect
@@ -59,6 +62,7 @@ import Control.Applicative
59 62
 import qualified Data.List as L
60 63
 import qualified Data.Map as M
61 64
 import Data.Maybe
65
+import Data.Ord (comparing)
62 66
 import XMonad hiding (Screen)
63 67
 import qualified XMonad.StackSet as W
64 68
 import qualified XMonad.Util.ExtensibleState as XS
@@ -70,16 +74,17 @@ import XMonad.Util.Types
70 74
 -- Navigation2D provides directional navigation (go left, right, up, down) for
71 75
 -- windows and screens.  It treats floating and tiled windows as two separate
72 76
 -- layers and provides mechanisms to navigate within each layer and to switch
77
+-- between layers.  Navigation2D provides three different navigation strategies
78
+-- (see <#Technical_Discussion> for details): /Line navigation/ and
79
+-- /Side navigation/ feel rather natural but may make it impossible to navigate
80
+-- to a given window from the current window, particularly in the floating
81
+-- layer. /Center navigation/ feels less natural in certain situations but
82
+-- ensures that all windows can be reached without the need to involve the
83
+-- mouse. Another option is to use a /Hybrid/ of the three strategies,
84
+-- automatically choosing whichever first provides a suitable target window.
85
+-- Navigation2D allows different navigation strategies to be used in the two
86
+-- layers and allows customization of the navigation strategy for the tiled
87
+-- layer based on the layout currently in effect.
73 88
 --
74 89
 -- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@:
75 90
 --
@@ -318,12 +323,46 @@ lineNavigation = N 1 doLineNavigation
318 323
 centerNavigation :: Navigation2D
319 324
 centerNavigation = N 2 doCenterNavigation
320 325
 
326
+-- | Side navigation. Consider navigating to the right this time. The strategy
327
+-- is to take the line segment forming the right boundary of the current window,
328
+-- and push it to the right until it intersects with at least one other window.
329
+-- Of those windows, one with a point that is the closest to the centre of the
330
+-- line (+1) is selected. This is probably the most intuitive strategy for the
331
+-- tiled layer when using XMonad.Layout.Spacing.
332
+sideNavigation :: Navigation2D
333
+sideNavigation = N 1 (doSideNavigationWithBias 1)
334
+
335
+-- | Side navigation with bias. Consider a case where the screen is divided
336
+-- up into three vertical panes; the side panes occupied by one window each and
337
+-- the central pane split across the middle by two windows. By the criteria
338
+-- of side navigation, the two central windows are equally good choices when
339
+-- navigating inwards from one of the side panes. Hence in order to be
340
+-- equitable, symmetric and pleasant to use, different windows are chosen when
341
+-- navigating from different sides. In particular, the lower is chosen when
342
+-- going left and the higher when going right, causing L, L, R, R, L, L, etc to
343
+-- cycle through the four windows clockwise. This is implemented by using a bias
344
+-- of 1. /Bias/ is how many pixels off centre the vertical split can be before
345
+-- this behaviour is lost and the same window chosen every time. A negative bias
346
+-- swaps the preferred window for each direction. A bias of zero disables the
347
+-- behaviour.
348
+sideNavigationWithBias :: Int -> Navigation2D
349
+sideNavigationWithBias b = N 1 (doSideNavigationWithBias b)
350
+
351
+-- | Hybrid of two modes of navigation, preferring the motions of the first.
352
+-- Use this if you want to fall back on a second strategy whenever the first
353
+-- does not find a candidate window. E.g.
354
+-- @hybridOf lineNavigation centerNavigation@ is a good strategy for the
355
+-- floating layer, and @hybridOf sideNavigation centerNavigation@ will enable
356
+-- you to take advantage of some of the latter strategy's more interesting
357
+-- motions in the tiled layer.
358
+hybridOf :: Navigation2D -> Navigation2D -> Navigation2D
359
+hybridOf (N g1 s1) (N g2 s2) = N (max g1 g2) $ applyToBoth s1 s2
360
+  where
361
+    applyToBoth f g a b c = f a b c <|> g a b c
362
+
363
+{-# DEPRECATED hybridNavigation "Use hybridOf with lineNavigation and centerNavigation as arguments." #-}
321 364
 hybridNavigation :: Navigation2D
322
-hybridNavigation = N 2 doHybridNavigation
365
+hybridNavigation = hybridOf lineNavigation centerNavigation
323 366
 
324 367
 -- | Stores the configuration of directional navigation. The 'Default' instance
325 368
 -- uses line navigation for the tiled layer and for navigation between screens,
@@ -767,12 +806,54 @@ doCenterNavigation dir (cur, rect) winrects
767 806
                                              -- or it has the same distance but comes later
768 807
                                              -- in the window stack
769 808
 
770
-doHybridNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
771
-doHybridNavigation = applyToBoth (<|>) doLineNavigation doCenterNavigation
772
-    where
773
-        applyToBoth f g h a b c = f (g a b c) (h a b c)
809
+-- x -y w h format is a pain. Let's use side coordinates. We assume x1 <= x2 and
810
+-- y1 <= y2, and make the assumption valid by initialising SideRects with the
811
+-- property and carefully preserving it over any individual transformation.
812
+data SideRect = SideRect { x1 :: Int, x2 :: Int, y1 :: Int, y2 :: Int }
813
+  deriving Show
814
+
815
+-- Conversion from Rectangle format to SideRect.
816
+toSR :: Rectangle -> SideRect
817
+toSR (Rectangle x y w h) = SideRect (fi x) (fi x + fi w) (-fi y - fi h) (-fi y)
818
+
819
+-- Implements side navigation with bias.
820
+doSideNavigationWithBias ::
821
+  Eq a => Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a
822
+doSideNavigationWithBias bias dir (cur, rect)
823
+  = fmap fst . listToMaybe
824
+  . L.sortBy (comparing dist) . foldr acClosest []
825
+  . filter (`toRightOf` (cur, transform rect))
826
+  . map (fmap transform)
827
+  where
828
+    -- Getting the center of the current window so we can make it the new origin.
829
+    cOf r = ((x1 r + x2 r) `div` 2, (y1 r + y2 r) `div` 2)
830
+    (x0, y0) = cOf . toSR $ rect
831
+
832
+    -- Translate the given SideRect by (-x0, -y0).
833
+    translate r = SideRect (x1 r - x0) (x2 r - x0) (y1 r - y0) (y2 r - y0)
834
+
835
+    -- Rotate the given SideRect 90 degrees counter-clockwise about the origin.
836
+    rHalfPiCC r = SideRect (-y2 r) (-y1 r) (x1 r) (x2 r)
837
+
838
+    -- Apply the above function until d becomes synonymous with R (wolog).
839
+    rotateToR d = let (_, _:l) = break (d ==) [U, L, D, R]
840
+                  in  foldr (const $ (.) rHalfPiCC) id l
841
+
842
+    transform = rotateToR dir . translate . toSR
843
+
844
+    -- (_, r) `toRightOf` (_, c) iff r has points to the right of c that aren't
845
+    -- below or above c, i.e. iff:
846
+    -- [x1 r, x2 r] x [y1 r, y2 r] intersects (x2 c, infinity) x (y1 c, y2 c)
847
+    toRightOf (_, r) (_, c) = (x2 r > x2 c) && (y2 r > y1 c) && (y1 r < y2 c)
848
+
849
+    -- Greedily accumulate the windows tied for the leftmost left side.
850
+    acClosest (w, r) l@((_, r'):_) | x1 r == x1 r' = (w, r) : l
851
+                                   | x1 r >  x1 r' =          l
852
+    acClosest (w, r) _                             = (w, r) : []
853
+
854
+    -- Given a (_, SideRect), calculate how far it is from the y=bias line.
855
+    dist (_, r) | (y1 r <= bias) && (bias <= y2 r) = 0
856
+                | otherwise = min (abs $ y1 r - bias) (abs $ y2 r - bias)
774 857
 
775 858
 -- | Swaps the current window with the window given as argument
776 859
 swap :: Window -> WindowSet -> WindowSet

+ 79
- 42
XMonad/Actions/PhysicalScreens.hs View File

@@ -21,6 +21,12 @@ module XMonad.Actions.PhysicalScreens (
21 21
                                       , sendToScreen
22 22
                                       , onNextNeighbour
23 23
                                       , onPrevNeighbour
24
+                                      , horizontalScreenOrderer
25
+                                      , verticalScreenOrderer
26
+                                      , ScreenComparator(ScreenComparator)
27
+                                      , getScreenIdAndRectangle
28
+                                      , screenComparatorById
29
+                                      , screenComparatorByRectangle
24 30
                                       ) where
25 31
 
26 32
 import XMonad
@@ -36,17 +42,20 @@ physical location relative to each other (as reported by Xinerama),
36 42
 rather than their @ScreenID@ s, which are arbitrarily determined by
37 43
 your X server and graphics hardware.
38 44
 
39
-Screens are ordered by the upper-left-most corner, from top-to-bottom
45
+You can specify how to order the screen by giving a ScreenComparator.
46
+To create a screen comparator you can use screenComparatorByRectangle or screenComparatorByScreenId.
47
+The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom
40 48
 and then left-to-right.
41 49
 
42 50
 Example usage in your @~\/.xmonad\/xmonad.hs@ file:
43 51
 
44 52
 > import XMonad.Actions.PhysicalScreens
53
+> import Data.Default
45 54
 
46
-> , ((modMask, xK_a), onPrevNeighbour W.view)
47
-> , ((modMask, xK_o), onNextNeighbour W.view)
48
-> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour W.shift)
49
-> , ((modMask .|. shiftMask, xK_o), onNextNeighbour W.shift)
55
+> , ((modMask, xK_a), onPrevNeighbour def W.view)
56
+> , ((modMask, xK_o), onNextNeighbour def W.view)
57
+> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour def W.shift)
58
+> , ((modMask .|. shiftMask, xK_o), onNextNeighbour def W.shift)
50 59
 
51 60
 > --
52 61
 > -- 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:
54 63
 > --
55 64
 > [((modm .|. mask, key), f sc)
56 65
 >     | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
57
->     , (f, mask) <- [(viewScreen, 0), (sendToScreen, shiftMask)]]
66
+>     , (f, mask) <- [(viewScreen def, 0), (sendToScreen def, shiftMask)]]
58 67
 
59 68
 For detailed instructions on editing your key bindings, see
60 69
 "XMonad.Doc.Extending#Editing_key_bindings".
@@ -63,52 +72,78 @@ For detailed instructions on editing your key bindings, see
63 72
 -- | The type of the index of a screen by location
64 73
 newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)
65 74
 
75
+getScreenIdAndRectangle :: (W.Screen i l a ScreenId ScreenDetail) -> (ScreenId, Rectangle)
76
+getScreenIdAndRectangle screen = (W.screen screen, rect) where
77
+  rect = screenRect $ W.screenDetail screen
78
+
66 79
 -- | Translate a physical screen index to a "ScreenId"
67
-getScreen :: PhysicalScreen -> X (Maybe ScreenId)
68
-getScreen (P i) = do w <- gets windowset
69
-                     let screens = W.current w : W.visible w
70
-                     if i<0 || i >= length screens
71
-                      then return Nothing
72
-                      else let ss = sortBy (cmpScreen `on` (screenRect . W.screenDetail)) screens
73
-                           in return $ Just $ W.screen $ ss !! i
80
+getScreen:: ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
81
+getScreen (ScreenComparator cmpScreen) (P i) = do w <- gets windowset
82
+                                                  let screens = W.current w : W.visible w
83
+                                                  if i<0 || i >= length screens
84
+                                                    then return Nothing
85
+                                                    else let ss = sortBy (cmpScreen `on` getScreenIdAndRectangle) screens
86
+                                                    in return $ Just $ W.screen $ ss !! i
74 87
 
75 88
 -- | Switch to a given physical screen
76
-viewScreen :: PhysicalScreen -> X ()
77
-viewScreen p = do i <- getScreen p
78
-                  whenJust i $ \s -> do
79
-                  w <- screenWorkspace s
80
-                  whenJust w $ windows . W.view
89
+viewScreen :: ScreenComparator -> PhysicalScreen -> X ()
90
+viewScreen sc p = do i <- getScreen sc p
91
+                     whenJust i $ \s -> do
92
+                     w <- screenWorkspace s
93
+                     whenJust w $ windows . W.view
81 94
 
82 95
 -- | Send the active window to a given physical screen
83
-sendToScreen :: PhysicalScreen -> X ()
84
-sendToScreen p = do i <- getScreen p
85
-                    whenJust i $ \s -> do
86
-                      w <- screenWorkspace s
87
-                      whenJust w $ windows . W.shift
88
-
89
-cmpScreen :: Rectangle -> Rectangle -> Ordering
90
-cmpScreen (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2)
91
-
96
+sendToScreen :: ScreenComparator -> PhysicalScreen -> X ()
97
+sendToScreen sc p = do i <- getScreen sc p
98
+                       whenJust i $ \s -> do
99
+                         w <- screenWorkspace s
100
+                         whenJust w $ windows . W.shift
101
+
102
+-- | A ScreenComparator allow to compare two screen based on their coordonate and Xinerama Id
103
+newtype ScreenComparator = ScreenComparator ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
104
+
105
+-- | The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom
106
+instance Default ScreenComparator where
107
+  def= verticalScreenOrderer
108
+
109
+-- | Compare screen only by their coordonate
110
+screenComparatorByRectangle :: (Rectangle -> Rectangle -> Ordering) -> ScreenComparator
111
+screenComparatorByRectangle rectComparator = ScreenComparator comparator where
112
+  comparator (_, rec1) (_, rec2) = rectComparator rec1 rec2
113
+
114
+-- | Compare screen only by their Xinerama id
115
+screenComparatorById :: (ScreenId -> ScreenId -> Ordering) -> ScreenComparator
116
+screenComparatorById idComparator = ScreenComparator comparator where
117
+  comparator (id1, _) (id2, _) = idComparator id1 id2
118
+
119
+-- | orders screens by the upper-left-most corner, from top-to-bottom
120
+verticalScreenOrderer :: ScreenComparator
121
+verticalScreenOrderer = screenComparatorByRectangle comparator where
122
+    comparator (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1, x1) (y2, x2)
123
+
124
+-- | orders screens by the upper-left-most corner, from left-to-right
125
+horizontalScreenOrderer :: ScreenComparator
126
+horizontalScreenOrderer = screenComparatorByRectangle comparator where
127
+    comparator (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (x1, y1) (x2, y2)
92 128
 
93 129
 -- | Get ScreenId for neighbours of the current screen based on position offset.
94
-getNeighbour :: Int -> X ScreenId
95
-getNeighbour d = do w <- gets windowset
96
-                    let ss = map W.screen $ sortBy (cmpScreen `on` (screenRect . W.screenDetail)) $ W.current w : W.visible w
97
-                        curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss
98
-                        pos = (curPos + d) `mod` length ss
99
-                    return $ ss !! pos
100
-
101
-neighbourWindows :: Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
102
-neighbourWindows d f = do s <- getNeighbour d
103
-                          w <- screenWorkspace s
104
-                          whenJust w $ windows . f
130
+getNeighbour :: ScreenComparator -> Int -> X ScreenId
131
+getNeighbour (ScreenComparator cmpScreen) d =
132
+  do w <- gets windowset
133
+     let ss = map W.screen $ sortBy (cmpScreen `on` getScreenIdAndRectangle) $ W.current w : W.visible w
134
+         curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss
135
+         pos = (curPos + d) `mod` length ss
136
+     return $ ss !! pos
137
+
138
+neighbourWindows :: ScreenComparator -> Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
139
+neighbourWindows sc d f = do s <- getNeighbour sc d
140
+                             w <- screenWorkspace s
141
+                             whenJust w $ windows . f
105 142
 
106 143
 -- | Apply operation on a WindowSet with the WorkspaceId of the next screen in the physical order as parameter.
107
-onNextNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
108
-onNextNeighbour = neighbourWindows 1
144
+onNextNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
145
+onNextNeighbour sc = neighbourWindows sc 1
109 146
 
110 147
 -- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter.
111
-onPrevNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
112
-onPrevNeighbour = neighbourWindows (-1)
148
+onPrevNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
149
+onPrevNeighbour sc = neighbourWindows sc (-1)

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

@@ -0,0 +1,407 @@
1
+{-# LANGUAGE DeriveDataTypeable #-}
2
+
3
+-----------------------------------------------------------------------------
4
+-- |
5
+-- Module      :  XMonad.Actions.SwapPromote
6
+-- Copyright   :  (c) 2018 Yclept Nemo
7
+-- License     :  BSD-style (see LICENSE)
8
+--
9
+-- Maintainer  :
10
+-- Stability   :  unstable
11
+-- Portability :  unportable
12
+--
13
+-- Module for tracking master window history per workspace, and associated
14
+-- functions for manipulating the stack using such history.
15
+--
16
+-----------------------------------------------------------------------------
17
+
18
+
19
+module XMonad.Actions.SwapPromote
20
+    ( -- * Usage
21
+      -- $usage
22
+      MasterHistory (..)
23
+      -- * State Accessors
24
+    , getMasterHistoryMap
25
+    , getMasterHistoryFromTag
26
+    , getMasterHistoryCurrent
27
+    , getMasterHistoryFromWindow
28
+    , modifyMasterHistoryFromTag
29
+    , modifyMasterHistoryCurrent
30
+      -- * Log Hook
31
+    , masterHistoryHook
32
+      -- * Log Hook Building Blocks
33
+    , masterHistoryHook'
34
+    , updateMasterHistory
35
+      -- * Actions
36
+    , swapPromote
37
+    , swapPromote'
38
+    , swapIn
39
+    , swapIn'
40
+    , swapHybrid
41
+    , swapHybrid'
42
+      -- * Action Building Blocks
43
+    , swapApply
44
+    , swapPromoteStack
45
+    , swapInStack
46
+    , swapHybridStack
47
+      -- * List Utilities
48
+    , cycleN
49
+    , split
50
+    , split'
51
+    , merge
52
+    , merge'
53
+      -- * Stack Utilities
54
+    , stackSplit
55
+    , stackMerge
56
+    ) where
57
+
58
+
59
+import           XMonad
60
+import qualified XMonad.StackSet                as W
61
+import qualified XMonad.Util.ExtensibleState    as XS
62
+
63
+import qualified Data.Map                       as M
64
+import qualified Data.Set                       as S
65
+import           Data.List
66
+import           Data.Maybe
67
+import           Control.Arrow
68
+import           Control.Applicative ((<$>),(<*>))
69
+import           Control.Monad
70
+
71
+
72
+-- $usage
73
+-- Given your configuration file, import this module:
74
+--
75
+-- > import XMonad.Actions.SwapPromote
76
+--
77
+-- First add 'masterHistoryHook' to your 'logHook' to track master windows per
78
+-- workspace:
79
+--
80
+-- > myLogHook = otherHook >> masterHistoryHook
81
+--
82
+-- Then replace xmonad's default promote keybinding with 'swapPromote'':
83
+--
84
+-- > , ((mod1Mask, xK_Return), swapPromote' False)
85
+--
86
+-- Depending on your xmonad configuration or window actions the master history
87
+-- may be empty. If this is the case you can still chain another promotion
88
+-- function:
89
+--
90
+-- > import XMonad.Actions.DwmPromote
91
+-- > , ((mod1Mask, xK_Return), whenX (swapPromote False) dwmpromote)
92
+--
93
+-- To be clear, this is only called when the lack of master history hindered
94
+-- the swap and not other conditions, such as having a only a single window.
95
+--
96
+-- While 'swapPromote' preserves window focus, 'swapIn' preserves the focus
97
+-- position - effectively "swapping" new windows into focus without moving the
98
+-- zipper. A mix of both, 'swapHybrid' promotes focused non-master windows
99
+-- while swapping windows into the focused master. This works well on layouts
100
+-- with large masters. Both come with chainable variants, see 'swapIn'' and
101
+-- 'swapHybrid''.
102
+--
103
+-- So far floating windows have been treated no differently than tiled windows
104
+-- even though their positions are independent of the stack. Often, yanking
105
+-- floating windows in and out of the workspace will obliterate the stack
106
+-- history - particularly frustrating with 'XMonad.Util.Scratchpad' since it is
107
+-- toggled so frequenty and always replaces the master window. That's why the
108
+-- swap functions accept a boolean argument; when @True@ non-focused floating
109
+-- windows will be ignored.
110
+--
111
+-- All together:
112
+--
113
+-- > , ((mod1Mask, xK_Return), whenX (swapHybrid True) dwmpromote)
114
+
115
+
116
+-- | Mapping from workspace tag to master history list. The current master is
117
+-- the head of the list, the previous master the second element, and so on.
118
+-- Without history, the list is empty.
119
+newtype MasterHistory = MasterHistory
120
+    { getMasterHistory :: M.Map WorkspaceId [Window]
121
+    } deriving (Read,Show,Typeable)
122
+
123
+instance ExtensionClass MasterHistory where
124
+    initialValue = MasterHistory M.empty
125
+
126
+-- | Return the master history map from the state.
127
+getMasterHistoryMap :: X (M.Map WorkspaceId [Window])
128
+getMasterHistoryMap = XS.gets getMasterHistory
129
+
130
+-- | Return the master history list of a given tag. The master history list may
131
+-- be empty. An invalid tag will also result in an empty list.
132
+getMasterHistoryFromTag :: WorkspaceId -> X [Window]
133
+getMasterHistoryFromTag t = M.findWithDefault [] t <$> getMasterHistoryMap
134
+
135
+-- | Return the master history list of the current workspace.
136
+getMasterHistoryCurrent :: X [Window]
137
+getMasterHistoryCurrent =   gets (W.currentTag . windowset)
138
+                        >>= getMasterHistoryFromTag
139
+
140
+-- | Return the master history list of the workspace containing the given
141
+-- window. Return an empty list if the window is not in the stackset.
142
+getMasterHistoryFromWindow :: Window -> X [Window]
143
+getMasterHistoryFromWindow w =   gets (W.findTag w . windowset)
144
+                             >>= maybe (return []) getMasterHistoryFromTag
145
+
146
+-- | Modify the master history list of a given workspace, or the empty list of
147
+-- no such workspace is mapped. The result is then re-inserted into the master
148
+-- history map.
149
+modifyMasterHistoryFromTag :: WorkspaceId -> ([Window] -> [Window]) -> X ()
150
+modifyMasterHistoryFromTag t f = XS.modify $ \(MasterHistory m) ->
151
+    let l = M.findWithDefault [] t m
152
+    in  MasterHistory $ M.insert t (f l) m
153
+
154
+-- | Modify the master history list of the current workspace. While the current
155
+-- workspace is guaranteed to exist; its master history may not. For more
156
+-- information see 'modifyMasterHistoryFromTag'.
157
+modifyMasterHistoryCurrent :: ([Window] -> [Window]) -> X ()
158
+modifyMasterHistoryCurrent f =   gets (W.currentTag . windowset)
159
+                             >>= flip modifyMasterHistoryFromTag f
160
+
161
+-- | A 'logHook' to update the master history mapping. Non-existent workspaces
162
+-- are removed, and the master history list for the current workspaces is
163
+-- updated. See 'masterHistoryHook''.
164
+masterHistoryHook :: X ()
165
+masterHistoryHook = masterHistoryHook' True updateMasterHistory
166
+
167
+-- | Backend for 'masterHistoryHook'.
168
+masterHistoryHook' :: Bool
169
+                        -- ^ If @True@, remove non-existent workspaces.
170
+                   -> ([Window] -> [Window] -> [Window])
171
+                        -- ^ Function used to update the master history list of
172
+                        -- the current workspace. First argument is the master
173
+                        -- history, second is the integrated stack.  See
174
+                        -- 'updateMasterHistory' for more details.
175
+                   -> X ()
176
+masterHistoryHook' removeWorkspaces historyModifier = do
177
+    wset <- gets windowset
178
+    let W.Workspace wid _ mst = W.workspace . W.current $ wset
179
+        tags = map W.tag $ W.workspaces wset
180
+        st = W.integrate' mst
181
+    XS.modify $ \(MasterHistory mm) ->
182
+        let mm' = if removeWorkspaces
183
+                  then restrictKeys mm $ S.fromList tags
184
+                  else mm
185
+            ms  = M.findWithDefault [] wid mm'
186
+            ms' = historyModifier ms st
187
+        in  MasterHistory $ M.insert wid ms' mm'
188
+
189
+-- | Less efficient version of 'M.restrictKeys'. Given broader eventual
190
+-- adoption, replace this with 'M.restrictKeys'.
191
+restrictKeys :: Ord k => M.Map k a -> S.Set k -> M.Map k a
192
+restrictKeys m s = M.filterWithKey (\k _ -> k `S.member` s) m
193
+
194
+-- | Given the current master history list and an integrated stack, return the
195
+-- new master history list. The current master is either moved (if it exists
196
+-- within the history) or added to the head of the list, and all missing (i.e.
197
+-- closed) windows are removed.
198
+updateMasterHistory :: [Window] -- ^ The master history list.
199
+                    -> [Window] -- ^ The integrated stack.
200
+                    -> [Window]
201
+updateMasterHistory _  []       = []
202
+updateMasterHistory ms ws@(w:_) = (w : delete w ms) `intersect` ws
203
+
204
+-- | Wrap 'swapPromoteStack'; see also 'swapApply'.
205
+swapPromote :: Bool -> X Bool
206
+swapPromote = flip swapApply swapPromoteStack
207
+
208
+-- | Like 'swapPromote'' but discard the result.
209
+swapPromote' :: Bool -> X ()
210
+swapPromote' = void . swapPromote
211
+
212
+-- | Wrap 'swapInStack'; see also 'swapApply'.
213
+swapIn :: Bool -> X Bool
214
+swapIn = flip swapApply swapInStack
215
+
216
+-- | Like 'swapIn'' but discard the result.
217
+swapIn' :: Bool -> X ()
218
+swapIn' = void . swapIn
219
+
220
+-- | Wrap 'swapHybridStack'; see also 'swapApply'.
221
+swapHybrid :: Bool -> X Bool
222
+swapHybrid = flip swapApply swapHybridStack
223
+
224
+-- | Like 'swapHybrid'' but discard the result.
225
+swapHybrid' :: Bool -> X ()
226
+swapHybrid' = void . swapHybrid
227
+
228
+-- | Apply the given master history stack modifier to the current stack. If
229
+-- given @True@, all non-focused floating windows will be ignored. Return
230
+-- @True@ if insufficient history; if so use 'whenX' to sequence a backup
231
+-- promotion function.
232
+swapApply :: Bool
233
+          -> (Maybe Window -> W.Stack Window -> (Bool,W.Stack Window))
234
+          -> X Bool
235
+swapApply ignoreFloats swapFunction = do
236
+    fl <- gets $ W.floating . windowset
237
+    st <- gets $ W.stack . W.workspace . W.current . windowset
238
+    ch <- getMasterHistoryCurrent
239
+    let swapApply' s1 =
240
+            let fl' = if ignoreFloats then M.keysSet fl else S.empty
241
+                ff = (||) <$> (`S.notMember` fl') <*> (== W.focus s1)
242
+                fh = filter ff ch
243
+                pm = listToMaybe . drop 1 $ fh
244
+                (r,s2) = stackSplit s1 fl' :: ([(Int,Window)],W.Stack Window)
245
+                (b,s3) = swapFunction pm s2
246
+                s4 = stackMerge s3 r
247
+                mh = let w = head . W.integrate $ s3
248
+                     in  const $ w : delete w ch
249
+            in (b,Just s4,mh)
250
+        (x,y,z) = maybe (False,Nothing,id) swapApply' st
251
+    -- Any floating master windows will be added to the history when 'windows'
252
+    -- calls the log hook.
253
+    modifyMasterHistoryCurrent z
254
+    windows $ W.modify Nothing . const $ y
255
+    return x
256
+
257
+-- | If the focused window is the master window and there is no previous
258
+-- master, do nothing. Otherwise swap the master with the previous master. If
259
+-- the focused window is not the master window, swap it with the master window.
260
+-- In either case focus follows the original window, i.e. the focused window
261
+-- does not change, only its position.
262
+--
263
+-- The first argument is the previous master (which may not exist), the second
264
+-- a window stack. Return @True@ if the master history hindered the swap; the
265
+-- history is either empty or out-of-sync. Though the latter shouldn't happen
266
+-- this function never changes the stack under such circumstances.
267
+swapPromoteStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
268
+swapPromoteStack _         st@(W.Stack _x [] []) = (False,st)
269
+swapPromoteStack Nothing   st@(W.Stack _x [] _r) = (True,st)
270
+swapPromoteStack (Just pm)    (W.Stack  x []  r) =
271
+    let (r',l') = (reverse *** cycleN 1) $ span (/= pm) $ reverse r
272
+        st'     = W.Stack x l' r'
273
+        b       = null l'
274
+    in  (b,st')
275
+swapPromoteStack _            (W.Stack  x l   r) =
276
+    let r'  = (++ r) . cycleN 1 . reverse $ l
277
+        st' = W.Stack x [] r'
278
+    in  (False,st')
279
+
280
+-- | Perform the same swap as 'swapPromoteStack'. However the new window
281
+-- receives the focus; it appears to "swap into" the position of the original
282
+-- window. Under this model focus follows stack position and the zipper does
283
+-- not move.
284
+--
285
+-- See 'swapPromoteStack' for more details regarding the parameters.
286
+swapInStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
287
+swapInStack _         st@(W.Stack _x [] []) = (False,st)
288
+swapInStack Nothing   st@(W.Stack _x [] _r) = (True,st)
289
+swapInStack (Just pm)    (W.Stack  x []  r) =
290
+    let (x',r') = case span (/= pm) r of
291
+            (__,[]) -> (x,r)
292
+            (sl,sr) -> (pm,sl ++ x : drop 1 sr)
293
+        st'     = W.Stack x' [] r'
294
+        b       = x' == x
295
+    in  (b,st')
296
+swapInStack _            (W.Stack  x l   r) =
297
+    let l'  = init l ++ [x]
298
+        x'  = last l
299
+        st' = W.Stack x' l' r
300
+    in  (False,st')
301
+
302
+-- | If the focused window is the master window, use 'swapInStack'. Otherwise use
303
+-- 'swapPromoteStack'.
304
+--
305
+-- See 'swapPromoteStack' for more details regarding the parameters.
306
+swapHybridStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
307
+swapHybridStack m st@(W.Stack _ [] _) = swapInStack m st
308
+swapHybridStack m st                  = swapPromoteStack m st
309
+
310
+-- | Cycle a list by the given count. If positive, cycle to the left. If
311
+-- negative, cycle to the right:
312
+--
313
+-- >>> cycleN 2 [1,2,3,4,5]
314
+-- [3,4,5,1,2]
315
+-- >>> cycleN (-2) [1,2,3,4,5]
316
+-- [4,5,1,2,3]
317
+cycleN :: Int -> [a] -> [a]
318
+cycleN n ls =
319
+    let l = length ls
320
+    in  take l $ drop (n `mod` l) $ cycle ls
321
+
322
+-- | Wrap 'split'' with an initial index of @0@, discarding the list's length.
323
+split :: (Num a, Enum a) => (b -> Bool) -> [b] -> ([(a,b)],[b])
324
+split p l =
325
+    let (_,ys,ns) = split' p 0 l
326
+    in  (ys,ns)
327
+
328
+-- | Given a predicate, an initial index and a list, return a tuple containing:
329
+--
330
+--  * List length.
331
+--  * Indexed list of elements which satisfy the predicate. An indexed element
332
+--    is a tuple containing the element index (offset by the initial index) and
333
+--    the element.
334
+--  * List of elements which do not satisfy the predicate.
335
+--
336
+-- The initial index and length of the list simplify chaining calls to this
337
+-- function, such as for zippers of lists.
338
+split' :: (Num a, Enum a) => (b -> Bool) -> a -> [b] -> (a,[(a,b)],[b])
339
+split' p i l =
340
+    let accumulate e (c,ys,ns) = if p (snd e)
341
+            then (c+1,e:ys,ns)
342
+            else (c+1,ys,e:ns)
343
+        (c',ys',ns') = foldr accumulate (0,[],[]) $ zip [i..] l
344
+    in  (c',ys',snd . unzip $ ns')
345
+
346
+-- | Wrap 'merge'' with an initial virtual index of @0@. Return only the
347
+-- unindexed list with elements from the leftover indexed list appended.
348
+merge :: (Ord a, Num a) => [(a,b)] -> [b] -> [b]
349
+merge il ul =
350
+    let (_,il',ul') = merge' 0 il ul
351
+    in  ul' ++ map snd il'
352
+
353
+-- | Inverse of 'split'. Merge an indexed list with an unindexed list (see
354
+-- 'split''). Given a virtual index, an indexed list and an unindexed list,
355
+-- return a tuple containing:
356
+--
357
+--  * Virtual index /after/ the unindexed list
358
+--  * Remainder of the indexed list
359
+--  * Merged unindexed list
360
+--
361
+-- If the indexed list is empty, this functions consumes the entire unindexed
362
+-- list. If the unindexed list is empty, this function consumes only adjacent
363
+-- indexed elements. For example, @[(10,"ten"),(12,"twelve")]@ implies missing
364
+-- unindexed elements and so once @(10,"ten")@ is consumed this function
365
+-- concludes.
366
+--
367
+-- The indexed list is assumed to have been created by 'split'' and not checked
368
+-- for correctness. Indices are assumed to be ascending, i.e.
369
+-- > [(1,"one"),(2,"two"),(4,"four")]
370
+--
371
+-- The initial and final virtual indices simplify chaining calls to the this
372
+-- function, as as for zippers of lists. Positive values shift the unindexed
373
+-- list towards the tail, as if preceded by that many elements.
374
+merge' :: (Ord a, Num a) => a -> [(a,b)] -> [b] -> (a,[(a,b)],[b])
375
+merge' i il@((j,a):ps) ul@(b:bs) = if j <= i
376
+    then let (x,y,z) = merge' (i+1) ps ul
377
+         in  (x,y,a:z)
378
+    else let (x,y,z) = merge' (i+1) il bs
379
+         in  (x,y,b:z)
380
+merge' i [] (b:bs) =
381
+         let (x,y,z) = merge' (i+1) [] bs
382
+         in  (x,y,b:z)
383
+merge' i il@((j,a):ps) [] = if j <= i
384
+    then let (x,y,z) = merge' (i+1) ps []
385
+         in  (x,y,a:z)
386
+    else (i,il,[])
387
+merge' i [] [] =
388
+         (i,[],[])
389
+
390
+-- | Remove all elements of the set from the stack. Skip the currently focused
391
+-- member. Return an indexed list of excluded elements and the modified stack.
392
+-- Use 'stackMerge' to re-insert the elements using this list.
393
+stackSplit :: (Num a, Enum a, Ord b) => W.Stack b -> S.Set b -> ([(a,b)],W.Stack b)
394
+stackSplit (W.Stack x l r) s =
395
+    let (c,fl,tl) = split' (`S.member` s) 0 (reverse l)
396
+        (_,fr,tr) = split' (`S.member` s) (c+1) r
397
+    in  (fl++fr,W.Stack x (reverse tl) tr)
398
+
399
+-- | Inverse of 'stackSplit'. Given a list of elements and their original
400
+-- indices, re-insert the elements into these same positions within the stack.
401
+-- Skip the currently focused member. Works best if the stack's length hasn't
402
+-- changed, though if shorter any leftover elements will be tacked on.
403
+stackMerge :: (Ord a, Num a) => W.Stack b -> [(a,b)] -> W.Stack b
404
+stackMerge (W.Stack x l r) il =
405
+    let (i,il1,l') = merge' 0 il (reverse l)
406
+        (_,il2,r') = merge' (i+1) il1 r
407
+    in  W.Stack x (reverse l') (r' ++ map snd il2)

+ 9
- 3
XMonad/Config/Azerty.hs View File

@@ -17,7 +17,7 @@
17 17
 module XMonad.Config.Azerty (
18 18
     -- * Usage
19 19
     -- $usage
20
-    azertyConfig, azertyKeys
20
+    azertyConfig, azertyKeys, belgianConfig, belgianKeys
21 21
     ) where
22 22
 
23 23
 import XMonad
@@ -40,11 +40,17 @@ import qualified Data.Map as M
40 40
 
41 41
 azertyConfig = def { keys = azertyKeys <+> keys def }
42 42
 
43
-azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $
43
+belgianConfig = def { keys = belgianKeys <+> keys def }
44
+
45
+azertyKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0]
46
+
47
+belgianKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0xa7,0xe8,0x21,0xe7,0xe0]
48
+
49
+azertyKeysTop topRow conf@(XConfig {modMask = modm}) = M.fromList $
44 50
     [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
45 51
     ++
46 52
     [((m .|. modm, k), windows $ f i)
47
-        | (i, k) <- zip (workspaces conf) [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0],
53
+        | (i, k) <- zip (workspaces conf) topRow,
48 54
           (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
49 55
     ++
50 56
     -- 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
47 47
 
48 48
 gnomeKeys (XConfig {modMask = modm}) = M.fromList $
49 49
     [ ((modm, xK_p), gnomeRun)
50
-    , ((modm .|. shiftMask, xK_q), spawn "gnome-session-save --kill") ]
50
+    , ((modm .|. shiftMask, xK_q), spawn "gnome-session-quit --logout") ]
51 51
 
52 52
 -- | Launch the "Run Application" dialog.  gnome-panel must be running for this
53 53
 -- to work.

+ 79
- 0
XMonad/Config/Saegesser.hs View File

@@ -0,0 +1,79 @@
1
+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
2
+{-# LANGUAGE OverloadedStrings #-}
3
+
4
+---------------------------------------------------------------------
5
+-- |
6
+-- A mostly striped down configuration that demonstrates spawnOnOnce
7
+--
8
+---------------------------------------------------------------------
9
+import System.IO
10
+
11
+import XMonad
12
+
13
+import XMonad.Hooks.DynamicLog
14
+import XMonad.Hooks.ManageDocks
15
+import XMonad.Hooks.ManageHelpers
16
+import XMonad.Hooks.UrgencyHook
17
+import XMonad.Hooks.FadeInactive
18
+
19
+import XMonad.Layout.NoBorders
20
+import XMonad.Layout.ResizableTile
21
+import XMonad.Layout.Mosaic
22
+
23
+import XMonad.Util.Run
24
+import XMonad.Util.Cursor
25
+import XMonad.Util.NamedScratchpad
26
+import XMonad.Util.Scratchpad
27
+import XMonad.Util.SpawnOnce
28
+
29
+import XMonad.Actions.CopyWindow
30
+import XMonad.Actions.SpawnOn
31
+
32
+import qualified XMonad.StackSet as W
33
+
34
+main = do
35
+  myStatusBarPipe <- spawnPipe "xmobar"
36
+  xmonad $ docks $ withUrgencyHook NoUrgencyHook $ def
37
+    { terminal          = "xterm"
38
+    , workspaces        = myWorkspaces
39
+    , layoutHook        = myLayoutHook
40
+    , manageHook        = myManageHook <+> manageSpawn
41
+    , startupHook       = myStartupHook
42
+    , logHook           = myLogHook myStatusBarPipe
43
+    , focusFollowsMouse = False
44
+    }
45
+
46
+myManageHook = composeOne
47
+  [ isDialog                     -?> doFloat
48
+  , className =? "trayer"        -?> doIgnore
49
+  , className =? "Skype"         -?> doShift "chat"
50
+  , appName   =? "libreoffice"   -?> doShift "office"
51
+  , return True                  -?> doF W.swapDown
52
+  ]
53
+
54
+myWorkspaces = [ "web", "emacs", "chat", "vm", "office", "media", "xterms", "8", "9", "0"]
55
+
56
+myStartupHook = do
57
+  setDefaultCursor xC_left_ptr
58
+  spawnOnOnce "emacs" "emacs"
59
+  spawnNOnOnce 4 "xterms" "xterm"
60
+
61
+myLayoutHook = smartBorders $ avoidStruts $ standardLayouts
62
+  where standardLayouts = tiled ||| mosaic 2 [3,2]  ||| Mirror tiled ||| Full
63
+        tiled = ResizableTall nmaster delta ratio []
64
+        nmaster = 1
65
+        delta = 0.03
66
+        ratio = 0.6
67
+
68
+myLogHook p =  do
69
+  copies <- wsContainingCopies
70
+  let check ws | ws == "NSP" = ""                               -- Hide the scratchpad workspace
71
+               | ws `elem` copies = xmobarColor "red" "black" $ ws  -- Workspaces with copied windows are red on black
72
+               | otherwise = ws
73
+  dynamicLogWithPP $ xmobarPP { ppHidden = check
74
+                              , ppOutput = hPutStrLn p
75
+                              , ppUrgent = xmobarColor "white" "red"
76
+                              , ppTitle  = xmobarColor "green" "" . shorten 180
77
+                              }
78
+  fadeInactiveLogHook 0.6
79
+

+ 42
- 37
XMonad/Hooks/DebugEvents.hs View File

@@ -34,6 +34,7 @@ import           Control.Exception.Extensible         as E
34 34
 import           Control.Monad.State
35 35
 import           Control.Monad.Reader
36 36
 import           Data.Char                                   (isDigit)
37
+import           Data.Maybe                                  (fromJust)
37 38
 import           Data.List                                   (genericIndex
38 39
                                                              ,genericLength
39 40
                                                              ,unfoldr
@@ -696,30 +697,31 @@ dumpList'' m ((l,p,t):ps) sep = do
696 697
 dumpString :: Decoder Bool
697 698
 dumpString =  do
698 699
   fmt <- asks pType
699
-  [cOMPOUND_TEXT,uTF8_STRING] <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]
700
-  case () of
701
-    () | fmt == cOMPOUND_TEXT -> guardSize 16 (...)
702
-       | fmt == sTRING        -> guardSize  8 $ do
703
-                                   vs <- gets value
704
-                                   modify (\r -> r {value = []})
705
-                                   let ss = flip unfoldr (map twiddle vs) $
706
-                                            \s -> if null s
707
-                                                  then Nothing
708
-                                                  else let (w,s'') = break (== '\NUL') s
709
-                                                           s'      = if null s''
710
-                                                                     then s''
711
-                                                                     else tail s''
712
-                                                        in Just (w,s')
713
-                                   case ss of
714
-                                     [s] -> append $ show s
715
-                                     ss' -> let go (s:ss'') c = append c        >>
716
-                                                                append (show s) >>
717
-                                                                go ss'' ","
718
-                                                go []       _ = append "]"
719
-                                             in append "[" >> go ss' ""
720
-       | fmt == uTF8_STRING   -> dumpUTF -- duplicate type test instead of code :)
721
-       | otherwise            -> (inX $ atomName fmt) >>=
722
-                                 failure . ("unrecognized string type " ++)
700
+  x <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]
701
+  case x of
702
+    [cOMPOUND_TEXT,uTF8_STRING] -> case () of
703
+      () | fmt == cOMPOUND_TEXT -> guardSize 16 (...)
704
+         | fmt == sTRING        -> guardSize  8 $ do
705
+                                     vs <- gets value
706
+                                     modify (\r -> r {value = []})
707
+                                     let ss = flip unfoldr (map twiddle vs) $
708
+                                              \s -> if null s
709
+                                                    then Nothing
710
+                                                    else let (w,s'') = break (== '\NUL') s
711
+                                                             s'      = if null s''
712
+                                                                       then s''
713
+                                                                       else tail s''
714
+                                                          in Just (w,s')
715
+                                     case ss of
716
+                                       [s] -> append $ show s
717
+                                       ss' -> let go (s:ss'') c = append c        >>
718
+                                                                  append (show s) >>
719
+                                                                  go ss'' ","
720
+                                                  go []       _ = append "]"
721
+                                               in append "[" >> go ss' ""
722
+         | fmt == uTF8_STRING   -> dumpUTF -- duplicate type test instead of code :)
723
+         | otherwise            -> (inX $ atomName fmt) >>=
724
+                                   failure . ("unrecognized string type " ++)
723 725
 
724 726
 -- show who owns a selection
725 727
 dumpSelection :: Decoder Bool
@@ -917,7 +919,7 @@ dumpExcept xs item = do
917 919
     let w = (length (value sp) - length vs) * 8
918 920
     -- now we get to reparse again so we get our copy of it
919 921
     put sp
920
-    Just v <- getInt' w
922
+    v <- fmap fromJust (getInt' w)
921 923
     -- and after all that, we can process the exception list
922 924
     dumpExcept' xs that v
923 925
 
@@ -1176,20 +1178,23 @@ getInt w f =  getInt' w >>= maybe (return False) (append . f)
1176 1178
 -- @@@@@@@@@ evil beyond evil.  there *has* to be a better way
1177 1179
 inhale    :: Int -> Decoder Integer
1178 1180
 inhale  8 =  do
1179
-               [b] <- eat 1
1180
-               return $ fromIntegral b
1181
+               x <- eat 1
1182
+               case x of
1183
+                 [b] -> return $ fromIntegral b
1181 1184
 inhale 16 =  do
1182
-               [b0,b1] <- eat 2
1183
-               io $ allocaArray 2 $ \p -> do
1184
-                 pokeArray p [b0,b1]
1185
-                 [v] <- peekArray 1 (castPtr p :: Ptr Word16)
1186
-                 return $ fromIntegral v
1185
+               x <- eat 2
1186
+               case x of
1187
+                 [b0,b1] -> io $ allocaArray 2 $ \p -> do
1188
+                              pokeArray p [b0,b1]
1189
+                              [v] <- peekArray 1 (castPtr p :: Ptr Word16)
1190
+                              return $ fromIntegral v
1187 1191
 inhale 32 =  do
1188
-               [b0,b1,b2,b3] <- eat 4
1189
-               io $ allocaArray 4 $ \p -> do
1190
-                 pokeArray p [b0,b1,b2,b3]
1191
-                 [v] <- peekArray 1 (castPtr p :: Ptr Word32)
1192
-                 return $ fromIntegral v
1192
+               x <- eat 4
1193
+               case x of
1194
+                 [b0,b1,b2,b3] -> io $ allocaArray 4 $ \p -> do
1195
+                                    pokeArray p [b0,b1,b2,b3]
1196
+                                    [v] <- peekArray 1 (castPtr p :: Ptr Word32)
1197
+                                    return $ fromIntegral v
1193 1198
 inhale  b =  error $ "inhale " ++ show b
1194 1199
 
1195 1200
 eat   :: Int -> Decoder Raw

+ 63
- 5
XMonad/Hooks/DynamicLog.hs View File

@@ -24,6 +24,7 @@ module XMonad.Hooks.DynamicLog (
24 24
 
25 25
     -- * Drop-in loggers
26 26
     dzen,
27
+    dzenWithFlags,
27 28
     xmobar,
28 29
     statusBar,
29 30
     dynamicLog,
@@ -42,8 +43,8 @@ module XMonad.Hooks.DynamicLog (
42 43
 
43 44
     -- * Formatting utilities
44 45
     wrap, pad, trim, shorten,
45
-    xmobarColor, xmobarStrip,
46
-    xmobarStripTags,
46
+    xmobarColor, xmobarAction, xmobarRaw,
47
+    xmobarStrip, xmobarStripTags,
47 48
     dzenColor, dzenEscape, dzenStrip,
48 49
 
49 50
     -- * Internal formatting functions
@@ -61,7 +62,7 @@ import Codec.Binary.UTF8.String (encodeString)
61 62
 import Control.Monad (liftM2, msum)
62 63
 import Data.Char ( isSpace, ord )
63 64
 import Data.List (intersperse, stripPrefix, isPrefixOf, sortBy)
64
-import Data.Maybe ( isJust, catMaybes, mapMaybe )
65
+import Data.Maybe ( isJust, catMaybes, mapMaybe, fromMaybe )
65 66
 import Data.Ord ( comparing )
66 67
 import qualified Data.Map as M
67 68
 import qualified XMonad.StackSet as S
@@ -150,14 +151,17 @@ import XMonad.Hooks.ManageDocks
150 151
 
151 152
 ------------------------------------------------------------------------
152 153
 
154
+-- | Run xmonad with a dzen status bar with specified dzen
155
+--   command line arguments.
153 156
 --
157
+-- > main = xmonad =<< dzenWithFlags flags myConfig
154 158
 -- >
155 159
 -- > myConfig = def { ... }
160
+-- >
161
+-- > flags = "-e onstart lower -w 800 -h 24 -ta l -fg #a8a3f7 -bg #3f3c6d"
156 162
 --
163
+-- This function can be used to customize the arguments passed to dzen2.
164
+-- e.g changing the default width and height of dzen2.
157 165
 --
158 166
 -- If you wish to customize the status bar format at all, you'll have to
159 167
 -- use the 'statusBar' function instead.
@@ -166,9 +170,30 @@ import XMonad.Hooks.ManageDocks
166 170
 -- handle screen placement for dzen, and enables 'mod-b' for toggling
167 171
 -- the menu bar.
168 172
 --
173
+-- You should use this function only when the default 'dzen' function does not
174
+-- serve your purpose.
175
+--
176
+dzenWithFlags :: LayoutClass l Window
177
+    => String -> XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
178
+dzenWithFlags flags conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf
179
+
180
+-- | Run xmonad with a dzen status bar set to some nice defaults.
181
+--
182
+-- > main = xmonad =<< dzen myConfig
183
+-- >
184
+-- > myConfig = def { ... }
185
+--
186
+-- The intent is that the above config file should provide a nice
187
+-- status bar with minimal effort.
188
+--
189
+-- The binding uses the XMonad.Hooks.ManageDocks module to automatically
190
+-- handle screen placement for dzen, and enables 'mod-b' for toggling
191
+-- the menu bar. Please refer to 'dzenWithFlags' function for further
192
+-- documentation.
193
+--
169 194
 dzen :: LayoutClass l Window
170 195
      => XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
171
-dzen conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf
196
+dzen conf = dzenWithFlags flags conf
172 197
  where
173 198
     fg      = "'#a8a3f7'" -- n.b quoting
174 199
     bg      = "'#3f3c6d'"
@@ -295,7 +320,8 @@ pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $
295 320
          fmt w = printer pp (S.tag w)
296 321
           where printer | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents  = ppUrgent
297 322
                         | S.tag w == this                                               = ppCurrent
298
-                        | S.tag w `elem` visibles                                       = ppVisible
323
+                        | S.tag w `elem` visibles && isJust (S.stack w)                 = ppVisible
324
+                        | S.tag w `elem` visibles                                       = liftM2 fromMaybe ppVisible ppVisibleNoWindows
299 325
                         | isJust (S.stack w)                                            = ppHidden
300 326
                         | otherwise                                                     = ppHiddenNoWindows
301 327
 
@@ -392,6 +418,31 @@ xmobarColor :: String  -- ^ foreground color: a color name, or #rrggbb format
392 418
 xmobarColor fg bg = wrap t "</fc>"
393 419
  where t = concat ["<fc=", fg, if null bg then "" else "," ++ bg, ">"]
394 420
 
421
+-- | Encapsulate text with an action. The text will be displayed, and the
422
+-- action executed when the displayed text is clicked. Illegal input is not
423
+-- filtered, allowing xmobar to display any parse errors. Uses xmobar's new
424
+-- syntax wherein the command is surrounded by backticks.
425
+xmobarAction :: String
426
+                -- ^ Command. Use of backticks (`) will cause a parse error.
427
+             -> String
428
+                -- ^ Buttons 1-5, such as "145". Other characters will cause a
429
+                -- parse error.
430
+             -> String
431
+                -- ^ Displayed/wrapped text.
432
+             -> String
433
+xmobarAction command button = wrap l r
434
+    where
435
+        l = "<action=`" ++ command ++ "` button=" ++ button ++ ">"
436
+        r = "</action>"
437
+
438
+-- | Encapsulate arbitrary text for display only, i.e. untrusted content if
439
+-- wrapped (perhaps from window titles) will be displayed only, with all tags
440
+-- ignored. Introduced in xmobar 0.21; see their documentation. Be careful not
441
+-- to shorten the result.
442
+xmobarRaw :: String -> String
443
+xmobarRaw "" = ""
444
+xmobarRaw s  = concat ["<raw=", show $ length s, ":", s, "/>"]
445
+
395 446
 -- ??? add an xmobarEscape function?
396 447
 
397 448
 -- | Strip xmobar markup, specifically the <fc>, <icon> and <action> tags and
@@ -435,6 +486,8 @@ data PP = PP { ppCurrent :: WorkspaceId -> String
435 486
                -- contain windows
436 487
              , ppHiddenNoWindows :: WorkspaceId -> String
437 488
                -- ^ how to print tags of empty hidden workspaces
489
+             , ppVisibleNoWindows :: Maybe (WorkspaceId -> String)
490
+               -- ^ how to print tags of empty visible workspaces
438 491
              , ppUrgent :: WorkspaceId -> String
439 492
                -- ^ format to be applied to tags of urgent workspaces.
440 493
              , ppSep :: String
@@ -487,6 +540,7 @@ instance Default PP where
487 540
                , ppVisible         = wrap "<" ">"
488 541
                , ppHidden          = id
489 542
                , ppHiddenNoWindows = const ""
543
+               , ppVisibleNoWindows= Nothing
490 544
                , ppUrgent          = id
491 545
                , ppSep             = " : "
492 546
                , ppWsSep           = " "

+ 83
- 32
XMonad/Hooks/EwmhDesktops.hs View File

@@ -25,15 +25,19 @@ module XMonad.Hooks.EwmhDesktops (
25 25
     ) where
26 26
 
27 27
 import Codec.Binary.UTF8.String (encode)
28
+import Control.Applicative((<$>))
28 29
 import Data.List
29 30
 import Data.Maybe
30 31
 import Data.Monoid
32
+import qualified Data.Map.Strict as M
33
+import System.IO.Unsafe
31 34
 
32 35
 import XMonad
33 36
 import Control.Monad
34 37
 import qualified XMonad.StackSet as W
35 38
 
36 39
 import XMonad.Hooks.SetWMName
40
+import qualified XMonad.Util.ExtensibleState as E
37 41
 import XMonad.Util.XUtils (fi)
38 42
 import XMonad.Util.WorkspaceCompare
39 43
 import XMonad.Util.WindowProperties (getProp32)
@@ -69,46 +73,92 @@ ewmhDesktopsStartup = setSupported
69 73
 -- of the current state of workspaces and windows.
70 74
 ewmhDesktopsLogHook :: X ()
71 75
 ewmhDesktopsLogHook = ewmhDesktopsLogHookCustom id
76
+
72 77
 -- |
73
-ewmhDesktopsLogHookCustom :: ([WindowSpace] -> [WindowSpace]) -> X ()
74
-ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
75
-    sort' <- getSortByIndex
76
-    let ws = f $ sort' $ W.workspaces s
78
+-- Cached desktop names (e.g. @_NET_NUMBER_OF_DESKTOPS@ and
79
+-- @_NET_DESKTOP_NAMES@).
80
+newtype DesktopNames = DesktopNames [String]
81
+                     deriving (Eq)
77 82
 
78
-    -- Number of Workspaces
79
-    setNumberOfDesktops (length ws)
83
+instance ExtensionClass DesktopNames where
84
+    initialValue = DesktopNames []
80 85
 
81
-    -- Names thereof
82
-    setDesktopNames (map W.tag ws)
86
+-- |
87
+-- Cached client list (e.g. @_NET_CLIENT_LIST@).
88
+newtype ClientList = ClientList [Window]
89
+                   deriving (Eq)
83 90
 
84
-    -- all windows, with focused windows last
85
-    let wins =  nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws
86
-    setClientList wins
91
+instance ExtensionClass ClientList where
92
+    initialValue = ClientList []
87 93
 
88
-    -- Current desktop
89
-    case (elemIndex (W.currentTag s) $ map W.tag ws) of
90
-      Nothing -> return ()
91
-      Just curr -> do
92
-        setCurrentDesktop curr
94
+-- |
95
+-- Cached current desktop (e.g. @_NET_CURRENT_DESKTOP@).
96
+newtype CurrentDesktop = CurrentDesktop Int
97
+                       deriving (Eq)
93 98
 
94
-        -- Per window Desktop
95
-        -- To make gnome-panel accept our xinerama stuff, we display
96
-        -- all visible windows on the current desktop.
97
-        forM_ (W.current s : W.visible s) $ \x ->
98
-            forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do
99
-                setWindowDesktop win curr
99
+instance ExtensionClass CurrentDesktop where
100
+    initialValue = CurrentDesktop 0
100 101
 
101
-    forM_ (W.hidden s) $ \w ->
102
-        case elemIndex (W.tag w) (map W.tag ws) of
103
-          Nothing -> return ()
104
-          Just wn -> forM_ (W.integrate' (W.stack w)) $ \win -> do
105
-                         setWindowDesktop win wn
102
+-- |
103
+-- Cached window-desktop assignments (e.g. @_NET_CLIENT_LIST_STACKING@).
104
+newtype WindowDesktops = WindowDesktops (M.Map Window Int)
105
+                       deriving (Eq)
106 106
 
107
-    setActiveWindow
107
+instance ExtensionClass WindowDesktops where
108
+    initialValue = WindowDesktops M.empty
109
+
110
+-- |
111
+-- The value of @_NET_ACTIVE_WINDOW@, cached to avoid unnecessary property
112
+-- updates.
113
+newtype ActiveWindow = ActiveWindow Window
114
+                     deriving (Eq)
115
+
116
+instance ExtensionClass ActiveWindow where
117
+    initialValue = ActiveWindow none
118
+
119
+-- | Compare the given value against the value in the extensible state. Run the
120
+-- action if it has changed.
121
+whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X ()
122
+whenChanged v action = do
123
+    v0 <- E.get
124
+    unless (v == v0) $ do
125
+        action
126
+        E.put v
127
+
128
+-- |
129
+-- Generalized version of ewmhDesktopsLogHook that allows an arbitrary
130
+-- user-specified function to transform the workspace list (post-sorting)
131
+ewmhDesktopsLogHookCustom :: ([WindowSpace] -> [WindowSpace]) -> X ()
132
+ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
133
+    sort' <- getSortByIndex
134
+    let ws = f $ sort' $ W.workspaces s
108 135
 
109
-    return ()
136
+    -- Set number of workspaces and names thereof
137
+    let desktopNames = map W.tag ws
138
+    whenChanged (DesktopNames desktopNames) $ do
139
+        setNumberOfDesktops (length desktopNames)
140
+        setDesktopNames desktopNames
141
+
142
+    -- Set client list; all windows, with focused windows last
143
+    let clientList = nub . concatMap (maybe [] (\(W.Stack x l r) -> reverse l ++ r ++ [x]) . W.stack) $ ws
144
+    whenChanged (ClientList clientList) $ setClientList clientList
145
+
146
+    -- Remap the current workspace to handle any renames that f might be doing.
147
+    let maybeCurrent' = W.tag <$> listToMaybe (f [W.workspace $ W.current s])
148
+        current = join (flip elemIndex (map W.tag ws) <$> maybeCurrent')
149
+    whenChanged (CurrentDesktop $ fromMaybe 0 current) $ do
150
+        mapM_ setCurrentDesktop current
151
+
152
+    -- Set window-desktop mapping
153
+    let windowDesktops =
154
+          let f wsId workspace = M.fromList [ (winId, wsId) | winId <- W.integrate' $ W.stack workspace ]
155
+          in M.unions $ zipWith f [0..] ws
156
+    whenChanged (WindowDesktops windowDesktops) $ do
157
+        mapM_ (uncurry setWindowDesktop) (M.toList windowDesktops)
158
+
159
+    -- Set active window
160
+    let activeWindow' = fromMaybe none (W.peek s)
161
+    whenChanged (ActiveWindow activeWindow') $ setActiveWindow activeWindow'
110 162
 
111 163
 -- |
112 164
 -- Intercepts messages from pagers and similar applications and reacts on them.
@@ -255,9 +305,8 @@ setSupported = withDisplay $ \dpy -> do
255 305
 
256 306
     setWMName "xmonad"
257 307
 
258
-setActiveWindow :: X ()
259
-setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do
260
-    let w = fromMaybe none (W.peek s)
308
+setActiveWindow :: Window -> X ()
309
+setActiveWindow w = withDisplay $ \dpy -> do
261 310
     r <- asks theRoot
262 311
     a <- getAtom "_NET_ACTIVE_WINDOW"
263 312
     c <- getAtom "WINDOW"

+ 5
- 1
XMonad/Hooks/FadeWindows.hs View File

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

+ 5
- 1
XMonad/Hooks/WallpaperSetter.hs View File

@@ -41,7 +41,8 @@ import Data.Ord (comparing)
41 41
 import Control.Monad
42 42
 import Control.Applicative
43 43
 import Data.Maybe
44
-import Data.Monoid
44
+import Data.Monoid hiding ((<>))
45
+import Data.Semigroup
45 46
 
46 47
 -- $usage
47 48
 -- This module requires imagemagick and feh to be installed, as these are utilized
@@ -86,6 +87,9 @@ instance Monoid WallpaperList where
86 87
   mappend (WallpaperList w1) (WallpaperList w2) =
87 88
     WallpaperList $ M.toList $ (M.fromList w2) `M.union` (M.fromList w1)
88 89
 
90
+instance Semigroup WallpaperList where
91
+  (<>) = mappend
92
+
89 93
 -- | Complete wallpaper configuration passed to the hook
90 94
 data WallpaperConf = WallpaperConf {
91 95
     wallpaperBaseDir :: FilePath  -- ^ Where the wallpapers reside (if empty, will look in \~\/.wallpapers/)

+ 139
- 0
XMonad/Layout/BinaryColumn.hs View File

@@ -0,0 +1,139 @@
1
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
2
+-----------------------------------------------------------------------------
3
+-- |
4
+-- Module      :  XMonad.Layout.BinaryColumn
5
+-- Copyright   :  (c) 2009 Ilya Portnov, (c) 2018 Campbell Barton
6
+-- License     :  BSD3-style (see LICENSE)
7
+--
8
+-- Maintainer  :  Campbell Barton <ideasman42@gmail.com>
9
+-- Stability   :  unstable
10
+-- Portability :  unportable
11
+--
12
+-- Provides Column layout that places all windows in one column.
13
+-- Each window is half the height of the previous,
14
+-- except for the last pair of windows.
15
+--
16
+-- Note: Originally based on 'XMonad.Layout.Column' with changes:
17
+--
18
+-- * Adding/removing windows doesn't resize all other windows.
19
+-- (last window pair exception).
20
+-- * Minimum window height option.
21
+--
22
+-----------------------------------------------------------------------------
23
+
24
+module XMonad.Layout.BinaryColumn (
25
+                             -- * Usage
26
+                             -- $usage
27
+                             BinaryColumn (..)
28
+                            ) where
29
+import XMonad
30
+import qualified XMonad.StackSet
31
+import qualified Data.List
32
+
33
+-- $usage
34
+-- This module defines layout named BinaryColumn.
35
+-- It places all windows in one column.
36
+-- Windows heights are calculated to prevent window resizing whenever
37
+-- a window is added or removed.
38
+-- This is done by keeping the last two windows in the stack the same height.
39
+--
40
+-- You can use this module by adding following in your @xmonad.hs@:
41
+--
42
+-- > import XMonad.Layout.BinaryColumn
43
+--
44
+-- Then add layouts to your layoutHook:
45
+--
46
+-- > myLayoutHook = BinaryColumn 1.0 32 ||| ...
47
+--
48
+-- The first value causes the master window to take exactly half of the screen,
49
+-- the second ensures that windows are no less than 32 pixels tall.
50
+--
51
+-- Shrink/Expand can be used to adjust the first value by increments of 0.1.
52
+--
53
+-- * 2.0 uses all space for the master window
54
+-- (minus the space for windows which get their fixed height).
55
+-- * 0.0 gives an evenly spaced grid.
56
+-- Negative values reverse the sizes so the last
57
+-- window in the stack becomes larger.
58
+--
59
+
60
+data BinaryColumn a = BinaryColumn Float Int
61
+  deriving (Read, Show)
62
+
63
+instance XMonad.LayoutClass BinaryColumn a where
64
+  pureLayout = columnLayout
65
+  pureMessage = columnMessage
66
+
67
+columnMessage :: BinaryColumn a -> SomeMessage -> Maybe (BinaryColumn a)
68